[Bps-public-commit] r9419 - in Net-Server-IMAP: . lib/Net/Server/IMAP lib/Net/Server/IMAP/Command
alexmv at bestpractical.com
alexmv at bestpractical.com
Tue Oct 23 14:15:40 EDT 2007
Author: alexmv
Date: Tue Oct 23 14:15:20 2007
New Revision: 9419
Modified:
Net-Server-IMAP/ (props changed)
Net-Server-IMAP/lib/Net/Server/IMAP.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Copy.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm
Log:
r23852 at zoq-fot-pik: chmrr | 2007-10-23 14:12:40 -0400
* UIDPLUS and LITERAL+ extension for better offline support
* ->selectable becomes ->is_selectable, and an accessor
* UID STORE filters flags like normal STORE
* Log peer username and selected mailbox
* Flags are case insensitive (?!?!)
* Don't explode if we get a SIGPIPE
Modified: Net-Server-IMAP/lib/Net/Server/IMAP.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP.pm Tue Oct 23 14:15:20 2007
@@ -75,6 +75,7 @@
local $Net::Server::IMAP::Server = $self;
local $self->{connection} = $self->connections->{ $fh->fileno };
local $self->{auth} = $self->connections->{ $fh->fileno }->auth;
+ local $SIG{PIPE} = sub { warn "Broken pipe\n"; $self->connections->{ $fh->fileno}->close };
$self->connections->{ $fh->fileno }->handle_command;
}
}
@@ -122,7 +123,7 @@
sub capability {
my $self = shift;
- return "IMAP4rev1 STARTTLS AUTH=PLAIN CHILDREN";
+ return "IMAP4rev1 STARTTLS AUTH=PLAIN CHILDREN LITERAL+ UIDPLUS";
}
1; # Magic true value required at end of module
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command.pm Tue Oct 23 14:15:20 2007
@@ -27,14 +27,14 @@
sub has_literal {
my $self = shift;
- unless ($self->options_str =~ /\{(\d+)\}[\r\n]*$/) {
+ unless ($self->options_str =~ /\{(\d+)(\+)?\}[\r\n]*$/) {
$self->parse_options;
return;
}
my $options = $self->options_str;
my $next = $#{$self->_literals} + 1;
- $options =~ s/\{(\d+)\}[\r\n]*$/{{$next}}/;
+ $options =~ s/\{(\d+)(\+)?\}[\r\n]*$/{{$next}}/;
$self->_pending_literal($1);
$self->options_str($options);
@@ -53,7 +53,7 @@
$self->run if $self->validate;
}
});
- $self->out( "+ Continue\r\n" );
+ $self->out( "+ Continue\r\n" ) unless $2;
return 1;
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Append.pm Tue Oct 23 14:15:20 2007
@@ -42,9 +42,9 @@
$msg->internaldate( $parser->format_datetime($dt) );
}
- $self->connection->previous_exists( ($self->connection->previous_exists + 1 )
+ $self->connection->previous_exists( $self->connection->previous_exists + 1 )
if $self->connection->is_selected and $mailbox eq $self->connection->selected;
- $self->ok_completed();
+ $self->ok_command("[APPENDUID @{[$mailbox->uidvalidity]} @{[$msg->uid]}] APPEND COMPLETED");
} else {
$self->no_command("Permission denied");
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Copy.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Copy.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Copy.pm Tue Oct 23 14:15:20 2007
@@ -1,4 +1,4 @@
-package Net::Server::IMAP::Command::Close;
+package Net::Server::IMAP::Command::Copy;
use warnings;
use strict;
@@ -33,9 +33,11 @@
return $self->no_command("Permission denied") if grep {not $_->copy_allowed($mailbox)} @messages;
- $_->copy($mailbox) for @messages;
+ my @new = map {$_->copy($mailbox)} @messages;
- $self->ok_completed();
+ my $sequence = join(",",map {$_->uid} @messages);
+ my $uids = join(",",map {$_->uid} @new);
+ $self->ok_command("[COPYUID @{[$mailbox->uidvalidity]} $sequence $uids] OK COMPLETED");
}
1;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/List.pm Tue Oct 23 14:15:20 2007
@@ -57,7 +57,7 @@
my @props;
push @props, @{$node->children} ? '\HasChildren' : '\HasNoChildren';
- push @props, '\Noselect' unless $node->selectable;
+ push @props, '\Noselect' unless $node->is_selectable;
$self->list_out($node, @props) if $node->parent and $node->full_path =~ $regex;
$self->traverse( $_, $regex ) for @{ $node->children };
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Select.pm Tue Oct 23 14:15:20 2007
@@ -16,7 +16,7 @@
my $mailbox = $self->connection->model->lookup( @options );
return $self->no_command("Mailbox does not exist") unless $mailbox;
- return $self->no_command("Mailbox is not selectable") unless $mailbox->selectable;
+ return $self->no_command("Mailbox is not selectable") unless $mailbox->is_selectable;
return 1;
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Status.pm Tue Oct 23 14:15:20 2007
@@ -19,7 +19,7 @@
my $mailbox = $self->connection->model->lookup( $name );
return $self->no_command("Mailbox does not exist") unless $mailbox;
- return $self->no_command("Mailbox is not selectable") unless $mailbox->selectable;
+ return $self->no_command("Mailbox is not selectable") unless $mailbox->is_selectable;
return 1;
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Uid.pm Tue Oct 23 14:15:20 2007
@@ -23,7 +23,7 @@
my ($subcommand, @rest) = $self->parsed_options;
$subcommand = lc $subcommand;
- if ($subcommand =~ /^(copy|fetch|store|search)$/i ) {
+ if ($subcommand =~ /^(copy|fetch|store|search|expunge)$/i ) {
$self->$subcommand(@rest);
} else {
$self->log(
@@ -63,6 +63,9 @@
my ( $messages, $what, $flags ) = @_;
$flags = ref $flags ? $flags : [$flags];
+
+ return $self->bad_command("Invalid flag $_") for grep {not $self->connection->selected->can_set_flag($_)} @{$flags};
+
my @messages = $self->connection->selected->get_uids($messages);
$self->connection->ignore_flags(1) if $what =~ /\.SILENT$/i;
for my $m (@messages) {
@@ -94,6 +97,21 @@
$self->ok_completed;
}
+sub expunge {
+ my $self = shift;
+
+ return $self->bad_command("Not enough options") if @_ < 1;
+ return $self->bad_command("Too many options") if @_ > 2;
+
+ return $self->bad_command("Mailbox is read-only") if $self->connection->selected->read_only;
+
+ my ( $messages ) = @_;
+ my @messages = $self->connection->selected->get_uids($messages);
+ $self->connection->selected->expunge([map {$_->sequence} @messages]);
+
+ $self->ok_completed;
+}
+
sub search {
my $self = shift;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm Tue Oct 23 14:15:20 2007
@@ -31,7 +31,7 @@
return;
}
- $self->log("C(@{[$self->io_handle->peerport]}): $content");
+ $self->log("C(@{[$self->io_handle->peerport]},@{[$self->auth ? $self->auth->user : '???']},@{[$self->is_selected ? $self->selected->full_path : 'unselected']}): $content");
if ( $self->pending ) {
$self->pending->($content);
@@ -225,7 +225,7 @@
if ($self->io_handle) {
$self->io_handle->print($msg);
- $self->log("S(@{[$self->io_handle->peerport]}): $msg");
+ $self->log("S(@{[$self->io_handle->peerport]},@{[$self->auth ? $self->auth->user : '???']},@{[$self->is_selected ? $self->selected->full_path : 'unselected']}): $msg");
} else {
warn "Connection closed unexpectedly\n";
$self->close;
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Mailbox.pm Tue Oct 23 14:15:20 2007
@@ -7,7 +7,7 @@
use base 'Class::Accessor';
__PACKAGE__->mk_accessors(
- qw(name is_inbox force_read_only parent children _path uidnext uids uidvalidity messages subscribed)
+ qw(name is_inbox force_read_only parent children _path uidnext uids uidvalidity messages subscribed is_selectable)
);
sub new {
@@ -27,6 +27,7 @@
$self->children( [] );
$self->uidvalidity( scalar time );
$self->subscribed( 1 );
+ $self->is_selectable( 1 );
}
sub load_data {
@@ -49,10 +50,6 @@
return "/";
}
-sub selectable {
- return 1;
-}
-
sub selected {
my $self = shift;
return $Net::Server::IMAP::Server->connection->selected
@@ -152,7 +149,7 @@
my $self = shift;
my $flag = shift;
- return 1 if grep {$_ eq $flag} $self->flags;
+ return 1 if grep {lc $_ eq lc $flag} $self->flags;
return;
}
Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm (original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Message.pm Tue Oct 23 14:15:20 2007
@@ -10,6 +10,10 @@
use Regexp::Common qw/balanced/;
use DateTime;
+# Canonical capitalization
+my %FLAGS;
+$FLAGS{lc $_} = $_ for qw(\Answered \Flagged \Deleted \Seen \Draft);
+
use base 'Class::Accessor';
__PACKAGE__->mk_accessors(qw(sequence mailbox uid _flags mime internaldate));
@@ -50,6 +54,7 @@
sub set_flag {
my $self = shift;
my $flag = shift;
+ $flag = $FLAGS{lc $flag} || $flag;
my $old = exists $self->_flags->{$flag};
$self->_flags->{$flag} = 1;
@@ -65,6 +70,7 @@
sub clear_flag {
my $self = shift;
my $flag = shift;
+ $flag = $FLAGS{lc $flag} || $flag;
my $old = exists $self->_flags->{$flag};
delete $self->_flags->{$flag};
@@ -80,6 +86,7 @@
sub has_flag {
my $self = shift;
my $flag = shift;
+ $flag = $FLAGS{lc $flag} || $flag;
return exists $self->_flags->{$flag};
}
@@ -324,7 +331,7 @@
$self->set_flag($_) for grep { not $self->has_flag($_) } @flags;
$self->clear_flag($_) for grep {
$a = $_;
- not grep { $a eq $_ } @flags
+ not grep { lc $a eq lc $_ } @flags
} $self->flags;
}
}
More information about the Bps-public-commit
mailing list