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

[Gilles LAMIRAL <gilles dot lamiral at laposte dot net>]

Hello Phil,

> 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

All fixes applied.
In fact it mostly solves the ssl problem with Mail::IMAPClient v3
so now all my 50 regression tests work with Mail::IMAPClient 2.2.9 and 3.13
(still small problems with gmail solved by --authmech12 LOGIN).

I need more checks to be confident with 3.13 (each time I played
with it, it broke somewhere) but we're on the way to support
officially both and begin to forget the old good one but
very localy patched 2.2.9 !

I thank you very much.


> --- 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;
> 

-- 
Au revoir,                               02 99 64 31 77
Gilles Lamiral. France, Chavagne (35310) 06 20 79 76 06