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

[alexmv at bestpractical.com]

Author: alexmv
Date: Tue Nov 20 18:40:59 2007
New Revision: 9712

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

Log:
 r25001 at zoq-fot-pik:  chmrr | 2007-11-20 18:40:04 -0500
  * Support for RFC 2971 (ID command)


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	Tue Nov 20 18:40:59 2007
@@ -135,7 +135,14 @@
 
 sub capability {
     my $self = shift;
-    return "IMAP4rev1 STARTTLS AUTH=PLAIN CHILDREN LITERAL+ UIDPLUS";
+    return "IMAP4rev1 STARTTLS AUTH=PLAIN CHILDREN LITERAL+ UIDPLUS ID";
+}
+
+sub id {
+    return (
+            name => "Net-IMAP-Server",
+            version => $Net::IMAP::Server::VERSION,
+           );
 }
 
 1;    # Magic true value required at end of module

Added: Net-IMAP-Server/lib/Net/IMAP/Server/Command/Id.pm
==============================================================================
--- (empty file)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Command/Id.pm	Tue Nov 20 18:40:59 2007
@@ -0,0 +1,32 @@
+package Net::IMAP::Server::Command::Id;
+
+use warnings;
+use strict;
+
+use base qw/Net::IMAP::Server::Command/;
+
+sub validate {
+    my $self = shift;
+
+    my @options = $self->parsed_options;
+    return $self->bad_command("Not enough options") if @options < 1;
+    return $self->bad_command("Too many options") if @options > 1;
+    return $self->bad_command("Argument must be a list or NIL") unless $options[0] eq "NIL"
+      or ref $options[0] eq "ARRAY";
+
+    return 1;
+}
+
+sub run {
+    my $self = shift;
+
+    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->untagged_response("ID " . $self->data_out([$self->server->id]));
+
+    $self->ok_completed();
+}
+
+1;

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	Tue Nov 20 18:40:59 2007
@@ -32,4 +32,6 @@
     };
 }
 
+sub client_id {}
+
 1;