[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