perl-NetxAP/NetxAP-0.02.dif

--- Net/IMAP.pm
+++ Net/IMAP.pm	2004/03/23 14:48:58
@@ -98,6 +98,7 @@
 		     'delete' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
 		     'rename' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
 		     'subscribe' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
+		     'unsubscribe' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
 		     'list' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
 		     'lsub' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
 		     'status' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
@@ -197,7 +198,9 @@
   my $host = shift if @_ % 2;
   my %options = @_;
 
-  my $self = Net::xAP->new($host, 'imap2(143)', Timeout => 10, %options)
+  my $port = defined $options{UseSSL} && $options{UseSSL} ?
+	993 : 143;
+  my $self = Net::xAP->new($host, $port, Timeout => 10, %options)
     or return undef;
 
   bless $self, $class;
@@ -224,6 +227,10 @@
   my $mode = $self->{Options}{Synchronous}; # save current sync mode
   $self->{Options}{Synchronous}++; # force sync mode on
   my $resp = $self->capability;
+
+  # check if server is able to speak IMAP4REV1 
+  return undef if ( ! ${$self->{Capabilities}}{'IMAP4REV1'} );
+
   $self->{Options}{Synchronous} = $mode; # restore previous sync mode
 
   if ($resp->status ne 'ok') {
@@ -263,14 +270,19 @@
   } elsif (($list->[0] ne '*') || ($list->[1] !~ /^ok$/i)) {
     return undef;
   }
-  my $supports_imap4rev1 = 0;
-  for my $item (@{$list}) {
-    $supports_imap4rev1++ if ($item =~ /^imap4rev1$/i);
-  }
-  unless ($supports_imap4rev1) {
-    $self->close_connection;
-    return undef;
-  }
+
+  # with this code fragment we will learn, that
+  # cyrus-imapd is not imap4ref1 ready and that
+  # is not true!
+  #
+  #  my $supports_imap4rev1 = 0;
+  #  for my $item (@{$list}) {
+  #    $supports_imap4rev1++ if ($item =~ /^imap4rev1$/i);
+  #  }
+  #  unless ($supports_imap4rev1) {
+  #    $self->close_connection;
+  #    return undef;
+  #  }
 
   $self->{Banner} = $list;
 
@@ -419,6 +431,7 @@
 
 my %auth_funcs = (
   'LOGIN' => \&authenticate_login,
+  'PLAIN' => \&authenticate_plain,
   'CRAM-MD5' => \&authenticate_cram,
   'ANONYMOUS' => \&authenticate_anonymous,
 );
@@ -430,12 +443,19 @@
   return undef unless defined($auth_funcs{$authtype});
   return undef unless defined($_[0]->has_authtype($authtype));
   my $func = $auth_funcs{$authtype};
-  @auth_strings = @_[2..$#_];
+  @auth_strings = $authtype eq "plain" ? @_ : @_[2..$#_];
   $_[0]->imap_command('authenticate',
 		      ATOM, $authtype,
 		      SASLRESP, $func);
 }
 
+sub authenticate_plain {
+  my $i = shift;
+
+  return undef unless defined($auth_strings[$i]);
+  return encode_base64(join("\0", @auth_strings), '');
+}
+
 sub authenticate_login {
   my $i = shift;
 
@@ -1257,13 +1277,13 @@
 
 sub _encode_mailbox {
   my $str = $_[0];
-  $str =~ s/&/&-/g;
+  #$str =~ s/&/&-/g;
   return $str;
 }
 
 sub _decode_mailbox {
   my $str = $_[0];
-  $str =~ s/&-/&/g;
+  #$str =~ s/&-/&/g;
   return $str;
 }
 
@@ -2091,7 +2111,7 @@
   my %hash = @{Net::xAP->parse_fields($str)->[0]};
   for my $key (keys %hash) {
     my $lckey = lc($key);
-    print "$lckey $hash{$key}\n";
+    #print "$lckey $hash{$key}\n";
     if ($lckey eq 'envelope') {
       $self->{Items}{$lckey} = Net::IMAP::Envelope->new($hash{$key});
     } elsif (($lckey eq 'bodystructure') || ($lckey eq 'body')) {
@@ -2460,7 +2480,7 @@
   $self->{Mailbox} = shift(@fields);
   my %hash = @fields;
   for my $key (keys %hash) {
-    $self->{Identifiers}{lc{$key}} = $hash{$key};
+    $self->{Identifiers}{lc($key)} = $hash{$key};
   }
 
   return $self;
@@ -2610,18 +2630,20 @@
 
   my @fields = @{Net::xAP->parse_fields($str)};
   $self->{QuotaRoot} = shift(@fields);
-  while (@fields) {
-    my ($resource, $usage, $limit) = splice(@fields, 0, 3);
-    $self->{Quota}{lc($resource)} = [$usage, $limit];
+  foreach my $aref ( @fields ) {
+      while ( @$aref ) {
+	  my ($resource, $usage, $limit) = splice(@$aref, 0, 3);
+	  $self->{Quota}{lc($resource)} = [$usage, $limit];
+      }
   }
 
   return $self;
 }
 
 sub quotaroot { $_[0]->{QuotaRoot} }
-sub quotas { keys %{$_[0]->{Quotas}} }
-sub usage { $_[0]->{Quotas}{lc($_[1])}->[0] }
-sub limit { $_[0]->{Quotas}{lc($_[1])}->[1] }
+sub quotas { keys %{$_[0]->{Quota}} }
+sub usage { $_[0]->{Quota}{lc($_[1])}->[0] }
+sub limit { $_[0]->{Quota}{lc($_[1])}->[1] }
 
 ###############################################################################
 
--- Net/xAP.pm
+++ Net/xAP.pm	2004/03/23 10:48:48
@@ -147,6 +147,7 @@
   $self->{Options}{Synchronous} ||= 1;
   $self->{Options}{Debug} ||= 0;
   $self->{Options}{NonSyncLits} ||= 0;
+  $self->{Options}{UseSSL} ||= 0;
 
   if (substr($host, 0, 1) eq '/') {
     my ($child, $parent) = IO::Socket->socketpair(AF_UNIX,
@@ -169,10 +170,18 @@
       exec($host) or croak "can't exec $host: $!\n";
     }
   } else {
-    $self->{Connection} = IO::Socket::INET->new(PeerAddr => $host,
-						PeerPort => $peerport,
-						Proto => 'tcp',
-						%options) or return undef;
+    if( $self->{Options}{UseSSL} ) {
+      require IO::Socket::SSL;
+      $self->{Connection} = IO::Socket::SSL->new(PeerAddr => $host,
+						 PeerPort => $peerport,
+						 Proto => 'tcp',
+						 %options) or return undef;
+    } else {
+      $self->{Connection} = IO::Socket::INET->new(PeerAddr => $host,
+						  PeerPort => $peerport,
+						  Proto => 'tcp',
+						  %options) or return undef;
+    }
     $self->{Connection}->autoflush(1);
   }
 
@@ -352,6 +361,16 @@
     } elsif ($c eq ')') {
       pop(@stack);
       $pos++;
+    } elsif ( substr($str, $pos, 3) eq "NIL" ) {
+      $pos+=3;
+      push @{$stack[-1]}, [];
+      push @stack, $stack[-1]->[-1];
+      push @{$stack[-1]}, [];
+      push @stack, $stack[-1]->[-1];
+      push @{$stack[-1]}, "nil";
+      push @{$stack[-1]}, "nil";
+      pop(@stack);
+      pop(@stack);
     } elsif (substr($str, $pos) =~ /^(\"(?:[^\\\"]|\\\")*\")/) { # qstring
       my $str = substr($1, 1, -1);
       $pos += length $1;