[Bps-public-commit] r13342 - in Net-IMAP-Server: lib/Net/IMAP lib/Net/IMAP/Server lib/Net/IMAP/Server/Command

alexmv at bestpractical.com alexmv at bestpractical.com
Mon Jun 16 18:35:05 EDT 2008


Author: alexmv
Date: Mon Jun 16 18:35:04 2008
New Revision: 13342

Modified:
   Net-IMAP-Server/   (props changed)
   Net-IMAP-Server/lib/Net/IMAP/Server.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Command/Id.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/DefaultAuth.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Mailbox.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Message.pm

Log:
 r33091 at kohr-ah:  chmrr | 2008-06-16 18:32:40 -0400
  * Special-case for Zimbra's braindead inability to understand colons
    in mailbox names
 
  * client_id is now a property of a connection, not auth, because
    some clients call 'ID' before they auth.
 
  * Net::IMAP::Server->connection now works as a class method
 
  * Error proofing for when mailboxes and messages don't have an active
    connection
 


Modified: Net-IMAP-Server/lib/Net/IMAP/Server.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server.pm	Mon Jun 16 18:35:04 2008
@@ -252,7 +252,8 @@
 =cut
 
 sub connection {
-    my $self = shift;
+    my $class = shift;
+    my $self  = ref $class ? $class : $Net::IMAP::Server::Server;
     if (@_) {
         if (defined $_[0]) {
             $self->{connection}{$Coro::current . ""} = shift;

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Command/Id.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Command/Id.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Command/Id.pm	Mon Jun 16 18:35:04 2008
@@ -22,8 +22,7 @@
 
     my @options = $self->parsed_options;
     $options[0] = [] if $options[0] eq "NIL";
-    $self->connection->auth->client_id(@{$options[0]})
-      if $self->connection->is_auth;
+    $self->connection->client_id(@{$options[0]});
     $self->untagged_response("ID " . $self->data_out([$self->server->id]));
 
     $self->ok_completed();

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm	Mon Jun 16 18:35:04 2008
@@ -88,6 +88,22 @@
     return $self->{auth};
 }
 
+=head2 client_id
+
+When called with no arguments, returns a hashref of identifying
+information provided by the client.  When key-value pairs are
+provided, sets the client properties.  See RFC 2971.
+
+=cut
+
+sub client_id {
+    my $self = shift;
+    if (@_ > 1) {
+        $self->{client} = {%{$self->{client} || {}}, @_};
+    }
+    return $self->{client} || {};
+}
+
 =head2 selected [MAILBOX]
 
 Gets or sets the currently selected mailbox for this connection.  This

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/DefaultAuth.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/DefaultAuth.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/DefaultAuth.pm	Mon Jun 16 18:35:04 2008
@@ -91,15 +91,6 @@
     };
 }
 
-=head2 client_id
-
-Called when the client provides identifying information via the C<ID>
-command; by default, does nothing.  See RFC 2971.
-
-=cut
-
-sub client_id { }
-
 =head1 IMPLEMENTING NEW SASL METHODS
 
 The L</sasl_plain> method is a simple example of implementing a SASL

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Mailbox.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Mailbox.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Mailbox.pm	Mon Jun 16 18:35:04 2008
@@ -7,7 +7,7 @@
 use base 'Class::Accessor';
 
 __PACKAGE__->mk_accessors(
-    qw(name is_inbox parent children _path uidnext uids uidvalidity messages subscribed is_selectable)
+    qw(is_inbox parent children _path uidnext uids uidvalidity messages subscribed is_selectable)
 );
 
 =head1 NAME
@@ -112,6 +112,34 @@
     }
 }
 
+=head3 name
+
+Gets or sets the name of the mailbox.  This includes a workaround for
+Zimbra, which doesn't understand mailbox names with colons in them --
+so we substitute dashes.
+
+=cut
+
+sub name {
+    my $self = shift;
+    if (@_) {
+        $self->{name} = shift;
+    }
+
+    # Zimbra can't handle mailbox names with colons in them, for no
+    # obvious reason.  Handily, it identifies itself as Zimbra before
+    # login, so we know when to perform a colonoscopy.  We do this on
+    # get, and not on set, because the same model might be used by
+    # other clients.
+    my $name = $self->{name};
+    $name =~ s/:+/-/g
+        if Net::IMAP::Server->connection
+        and exists Net::IMAP::Server->connection->client_id->{vendor}
+        and Net::IMAP::Server->connection->client_id->{vendor} eq "Zimbra";
+
+    return $name;
+}
+
 =head2 Actions
 
 =head3 poll
@@ -209,10 +237,12 @@
         [ grep { $_ ne $self } @{ $self->parent->children } ] );
     push @{ $parent->children }, $self;
     $self->parent($parent);
+    return 1 unless Net::IMAP::Server->connection;
+
     my @uncache = ($self);
     while (@uncache) {
         my $o = shift @uncache;
-        $o->_path(undef);
+        delete Net::IMAP::Server->connection->{path_cache}{$o.""};
         push @uncache, @{ $o->children };
     }
     return 1;
@@ -265,7 +295,8 @@
                 # Except if we find our own connection; if this is
                 # *not* part of a poll, we asked for it, so no need to
                 # set up temporary messages.
-            ( $c eq $Net::IMAP::Server::Server->connection
+            ( Net::IMAP::Server->connection and
+              $c eq Net::IMAP::Server->connection
               and not $c->in_poll
             )
             or $c->temporary_messages
@@ -373,13 +404,17 @@
 
 sub full_path {
     my $self = shift;
-    return $self->_path if defined $self->_path;
-    $self->_path(
+    my $cache
+        = Net::IMAP::Server->connection
+        ? ( Net::IMAP::Server->connection->{path_cache} ||= {} )
+        : {};
+    return $cache->{$self.""}
+      if defined $cache->{$self.""};
+    $cache->{$self.""} =
           !$self->parent         ? ""
         : !$self->parent->parent ? $self->name
-        : $self->parent->full_path . $self->seperator . $self->name
-    );
-    return $self->_path;
+        : $self->parent->full_path . $self->seperator . $self->name;
+    return $cache->{$self.""};
 }
 
 =head3 flags
@@ -417,7 +452,7 @@
 
 sub exists {
     my $self = shift;
-    $Net::IMAP::Server::Server->connection->previous_exists(
+    Net::IMAP::Server->connection->previous_exists(
         scalar @{ $self->messages } )
         if $self->selected;
     return scalar @{ $self->messages };
@@ -478,8 +513,9 @@
 
 sub selected {
     my $self = shift;
-    return $Net::IMAP::Server::Server->connection->selected
-        and $Net::IMAP::Server::Server->connection->selected eq $self;
+    return Net::IMAP::Server->connection
+      and Net::IMAP::Server->connection->selected
+        and Net::IMAP::Server->connection->selected eq $self;
 }
 
 =head3 get_uids STR
@@ -523,7 +559,8 @@
 
 sub get_messages {
     my $self = shift;
-    return $Net::IMAP::Server::Server->connection->get_messages(@_);
+    return () unless Net::IMAP::Server->connection;
+    return Net::IMAP::Server->connection->get_messages(@_);
 }
 
 =head3 prep_for_destroy

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Message.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Message.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Message.pm	Mon Jun 16 18:35:04 2008
@@ -131,7 +131,7 @@
 
 sub _session_flags {
     my $self = shift;
-    my $conn = $Net::IMAP::Server::Server->connection;
+    my $conn = Net::IMAP::Server->connection;
     return {} unless $conn;
     return $conn->session_flags($self) || {};
 }



More information about the Bps-public-commit mailing list