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

[alexmv at bestpractical.com]

Author: alexmv
Date: Fri Mar  6 14:23:20 2009
New Revision: 18733

Modified:
   Net-IMAP-Server/   (props changed)
   Net-IMAP-Server/lib/Net/IMAP/Server/Command/Create.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/DefaultModel.pm

Log:
 r42982 at kohr-ah:  chmrr | 2009-03-06 14:19:24 -0500
  * Move IMAP-UTF-7 handling into model's ->split, so it runs for _all_
    client-given input.  Then adjust ->handle_command to be able to
    send specific messages to the client on some exceptions.  Reported
    by Jan Dvorak <jdvorak at uikt.mendelu.cz>.
 
  * Add a case for the suspected edge case where a timeout or printing error is
    discovered while handling a command


Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Command/Create.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Command/Create.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Command/Create.pm	Fri Mar  6 14:23:20 2009
@@ -17,11 +17,7 @@
     return $self->bad_command("Not enough options") if @options < 1;
     return $self->bad_command("Too many options") if @options > 1;
 
-    my ($name) = @options;
-    $name = eval { Encode::decode('IMAP-UTF-7', $name) };
-    return $self->bad_command("Invalid UTF-7 encoding") unless defined $name;
-
-    my $mailbox = $self->connection->model->lookup( $name );
+    my $mailbox = $self->connection->model->lookup( @options );
     return $self->no_command("Mailbox already exists") if $mailbox;
 
     return 1;
@@ -30,9 +26,7 @@
 sub run {
     my $self = shift;
 
-    my($name) = $self->parsed_options;
-    $name = Encode::decode('IMAP-UTF-7',$name);
-    my @parts = $self->connection->model->split($name);
+    my @parts = $self->connection->model->split( $self->parsed_options );
 
     my $base = $self->connection->model->root;
     for my $n (0.. $#parts) {

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	Fri Mar  6 14:23:20 2009
@@ -242,8 +242,16 @@
 
     eval { $handler->run() if $handler->validate; };
     if ( my $error = $@ ) {
-        $handler->no_command("Server error");
-        $self->log($error);
+        if ($error eq "Timeout\n" or $error eq "Error printing\n") {
+            die $error;
+        } elsif ($error =~ /^NO (.*)/) {
+            $handler->no_command($1);
+        } elsif ($error =~ /^BAD (.*)/) {
+            $handler->bad_command($1);
+        } else {
+            $handler->no_command("Server error");
+            $self->log($error);
+        }
     }
 }
 

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/DefaultModel.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/DefaultModel.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/DefaultModel.pm	Fri Mar  6 14:23:20 2009
@@ -92,13 +92,18 @@
 
 Utility method which splits a given C<PATH> according to the mailbox
 separator, as determinded by the
-L<Net::IMAP::Server::Mailbox/separator> of the L</root>.
+L<Net::IMAP::Server::Mailbox/separator> of the L</root>.  May C<die>
+if the path (which is expected to be encoded using IMAP-UTF-7) is
+invalid.  See L<Encode::IMAPUTF7>.
 
 =cut
 
 sub split {
     my $self = shift;
-    return grep {length} split quotemeta $self->root->separator, shift;
+    my $name = shift;
+    $name = eval { Encode::decode('IMAP-UTF-7', $name) };
+    die "BAD Invalid UTF-7 encoding\n" unless defined $name;
+    return grep {length} split quotemeta $self->root->separator, $name;
 }
 
 =head2 lookup PATH