Re: [imapsync] patch for 1.267: untrapped eval errors, bad matchvars and more

[Phil Lobbes <plobbes at zimbra dot com>]

Here's additional cleanup on login() error handling and better logging (tested with Mail::IMAPClient 3.13):

  - if login fails log last response from server if LastError is not set
  - do not fallback to LOGIN Auth if login fails when using --authuser*

Phil

$ diff -u imapsync.ORIG imapsync
--- imapsync.ORIG       2009-02-13 20:30:07.234375000 -0500
+++ imapsync    2009-02-13 20:39:31.156250000 -0500
@@ -789,9 +789,12 @@
        $imap->Authuser($authuser);
        $imap->Password($password);
        unless ($imap->login()) {
-               print "Error login : [$host] with user [$user] auth [$authmech]: $ at \n";
-               die if ($authmech eq 'LOGIN');
-               die if $imap->IsUnconnected();
+               my $info  = "Error login : [$host] with user [$user] auth";
+               my $einfo = $imap->LastError || @{$imap->History}[-1];
+               chomp($einfo);
+               my $error = "$info [$authmech]: $einfo\n";
+               print $error; # note: duplicating error on stdout/stderr
+               die $error if ($authmech eq 'LOGIN' or $imap->IsUnconnected() or $authuser);
                print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n";
                $imap->Authmechanism("");
                $imap->login() or

----- Original Message -----
From: "Phil Lobbes" <plobbes at zimbra dot com>
To: imapsync at linux-france dot org
Sent: Saturday, January 31, 2009 3:45:44 PM GMT -05:00 US/Canada Eastern
Subject: [imapsync] patch for 1.267: untrapped eval errors, bad matchvars and more

Hi,

There are a few issues that I've found and tried to cleanup with imapsync 1.267.  I hope you find this useful!

The included diff addresses the following issues:
- catch (what should be) fatal eval errors for regextrans2,
  $regexflag, $regexmess, instead of silently ignoring them
  and letting the user think they are working/OK
- fix login_imap() Died at .../imapsync line 780 when IsUnconnected()
  and log some more useful into to stderr than just 'Died at...'
- check_lib_version() contains a bad use of unset match/capture variables
- added and now use new function myconnect() and myconnect_v2()
  does not require hack/override of Mail::IMAPClient::connect
  and is backwards compatible with Mail::IMAPClient v2.x
- redo $Mail::IMAPClient::Authuser hack since only
  Mail::IMAPClient v2 does not have Authuser()

Phil

--- imapsync.ORIG	2009-01-21 16:35:22.286250000 -0500
+++ imapsync	2009-01-31 15:31:00.628625000 -0500
@@ -505,7 +505,7 @@
 
 
 sub check_lib_version {
-	$debug and print "VERSION_IMAPClient $1 $2 $3\n";
+	$debug and print "VERSION_IMAPClient $VERSION_IMAPClient\n";
 	if ($VERSION_IMAPClient eq '2.2.9') {
 		override_imapclient();
 		return(1);
@@ -597,7 +597,7 @@
 	$imap->Port($port);
 	$imap->Debug($debugimap);
 	$imap->Ssl($ssl) if ($ssl);
-	$imap->connect()
+	myconnect($imap)
 	  or die "Can not open imap connection on [$host] : $ at \n";	
 }
 
@@ -762,7 +762,7 @@
 	$imap->Debug($debugimap);
 	$timeout and $imap->Timeout($timeout);
 	
-	$imap->connect()
+	myconnect($imap)
 	  or die "Can not open imap connection on [$host] with user [$user] : $ at \n";
 	
 	print "Banner : ", server_banner($imap);
@@ -789,13 +789,14 @@
 	$imap->Authuser($authuser);
 	$imap->Password($password);
 	unless ($imap->login()) {
-		print "Error login : [$host] with user [$user] auth [$authmech]: $ at \n";
-		die if ($authmech eq 'LOGIN');
-		die if $imap->IsUnconnected();
+                my $info  = "Error login : [$host] with user [$user] auth";
+		my $error = "$info [$authmech]: " . $imap->LastError . "\n";
+		print $error; # note: duplicating error on stdout/stderr
+		die $error if ($authmech eq 'LOGIN' or $imap->IsUnconnected());
 		print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n";
 		$imap->Authmechanism("");
 		$imap->login() or
-		  die "Error login : [$host] with user [$user] auth [LOGIN] : $@";
+		  die "$info [LOGIN]: ", $imap->LastError, "\n";
 	}
 	print "Success login on [$host] with user [$user] auth [$authmech]\n";
 	return($imap);
@@ -1236,6 +1237,7 @@
 	foreach my $regextrans2 (@regextrans2) {
 		$debug and print "eval \$t_fold =~ $regextrans2\n";
 		eval("\$t_fold =~ $regextrans2");
+		die("error: eval regextrans2 '$regextrans2': $ at \n") if $@;
 	}
 	return($t_fold);
 }
@@ -1245,6 +1247,7 @@
 	foreach my $regexflag (@regexflag) {
 		$debug and print "eval \$flags_f =~ $regexflag\n";
 		eval("\$flags_f =~ $regexflag");
+		die("error: eval regexflag '$regexflag': $ at \n") if $@;
 	}
 	return($flags_f);
 }
@@ -1459,6 +1462,7 @@
 				foreach my $regexmess (@regexmess) {
 					$debug and print "eval \$string =~ $regexmess\n";
 					eval("\$string =~ $regexmess");
+					die("error: eval regexmess '$regexmess': $ at \n") if $@;
 				}
 				return($string);
 			}
@@ -2613,8 +2617,9 @@
 	return $self->{SSL};
 };
 
+}
 
-*Mail::IMAPClient::connect = sub {
+sub myconnect {
 	my $self = shift;
 	
 	$self->Port(143) 
@@ -2641,8 +2646,21 @@
 		return undef;
 	}
 	$self->Socket($sock);
+	if ( $Mail::IMAPClient::VERSION =~ /^2/ ) {
+	    return undef unless myconnect_v2($self);
+	}
+	if ($self->User and $self->Password) {
+		return $self->login ;
+	} 
+	else {
+		return $self;	
+	}
+}
+
+sub myconnect_v2 {
+	my $self = shift;
 	$self->State(Connected);
-	$sock->autoflush(1)				;
+	$self->Socket->autoflush(1);
 	my ($code, $output);
         $output = "";
         until ( $code ) {
@@ -2662,30 +2680,19 @@
 		$self->State(Unconnected);
 		return undef ;
 	}
-
-	if ($self->User and $self->Password) {
-		return $self->login ;
-	} 
-	else {
-		return $self;	
-	}
-}
-	
-
-
+	return $self;
 }
 
-package Mail::IMAPClient;
-
-
-sub Authuser {
+# HACK: Mail::IMAPClient 2.2.9 does not have Authuser, but 3.x does
+# - avoid warning: "Mail::IMAPClient::Authuser" used only once w/2.x too
+$Mail::IMAPClient::Authuser = $Mail::IMAPClient::Authuser = sub {
 	my $self = shift;
 	
 	if (@_) { $self->{AUTHUSER} = shift }
 	return $self->{AUTHUSER};
-}
-
+} if ( $Mail::IMAPClient::VERSION =~ /^2/ );
 
+package Mail::IMAPClient;
 sub Split {
 	my $self = shift;
 	

---- imapsync mailing-list ----
unsubscribe, mailto:imapsync-unsubscribe at listes dot linux-france dot org
imapsync,    http://linux-france.org/prj/imapsync/