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

[alexmv at bestpractical.com]

Author: alexmv
Date: Fri Oct 19 14:02:28 2007
New Revision: 9359

Modified:
   Net-Server-IMAP/   (props changed)
   Net-Server-IMAP/lib/Net/Server/IMAP.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Authenticate.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Capability.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Command/Login.pm
   Net-Server-IMAP/lib/Net/Server/IMAP/Connection.pm

Log:
 r23736 at zoq-fot-pik:  chmrr | 2007-10-19 14:01:31 -0400
  * Capabiity filtering on connection
  * Actually enforce LOGINDISABLED and AUTH=foo


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	Fri Oct 19 14:02:28 2007
@@ -116,8 +116,6 @@
 
 sub capability {
     my $self = shift;
-    my ($connection) = @_;
-
     return "IMAP4rev1 STARTTLS AUTH=PLAIN CHILDREN";
 }
 

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Authenticate.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Authenticate.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Authenticate.pm	Fri Oct 19 14:02:28 2007
@@ -18,6 +18,9 @@
     return $self->bad_command("Not enough options") if @options < 1;
     return $self->bad_command("Too many options") if @options > 1;
 
+    return $self->no_command("Login is disabled")
+      unless $self->connection->capability =~ /\bAUTH=@options\b/i;
+
     return 1;
 }
 

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Capability.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Capability.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Capability.pm	Fri Oct 19 14:02:28 2007
@@ -16,7 +16,7 @@
 
 sub run {
     my $self = shift;
-    $self->tagged_response( $self->server->capability($self->connection) );
+    $self->tagged_response( $self->connection->capability );
     $self->ok_completed;
 }
 

Modified: Net-Server-IMAP/lib/Net/Server/IMAP/Command/Login.pm
==============================================================================
--- Net-Server-IMAP/lib/Net/Server/IMAP/Command/Login.pm	(original)
+++ Net-Server-IMAP/lib/Net/Server/IMAP/Command/Login.pm	Fri Oct 19 14:02:28 2007
@@ -15,6 +15,9 @@
     return $self->bad_command("Not enough options") if @options < 2;
     return $self->bad_command("Too many options") if @options > 2;
 
+    return $self->no_command("Login is disabled")
+      if $self->connection->capability =~ /\bLOGINDISABLED\b/;
+
     return 1;
 }
 

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	Fri Oct 19 14:02:28 2007
@@ -70,8 +70,8 @@
     my $self = shift;
     my $line = shift;
     $line =~ s/[\r\n]+$//;
-    unless ( $line =~ /^([\w\d]+)\s+(\w+)(?:\s+(.+?))?$/ ) {
-        if ( $line !~ /^([\w\d]+)\s+/ ) {
+    unless ( $line =~ /^([^\(\)\{ \*\%"\\\+}]+)\s+(\w+)(?:\s+(.+?))?$/ ) {
+        if ( $line !~ /^([^\(\)\{ \*\%"\\\+]+)\s+/ ) {
             $self->out("* BAD Invalid tag\r\n");
         } else {
             $self->out("* BAD Null command ('$line')\r\n");
@@ -193,6 +193,18 @@
     return $self->temporary_sequence_map->{$message};
 }
 
+sub capability {
+    my $self = shift;
+
+    my $base = $self->server->capability;
+    if ( $self->is_encrypted ) {
+        $base = join(" ", grep {$_ ne "STARTTLS"} split(' ', $base));
+    } else {
+        $base = join(" ", grep {not /^AUTH=\S+$/} split(' ', $base), "LOGINDISABLED");
+    }
+
+    return $base;
+}
 
 sub log {
     my $self = shift;