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

[alexmv at bestpractical.com]

Author: alexmv
Date: Tue Oct 16 10:09:22 2007
New Revision: 9321

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

Log:
 r23623 at zoq-fot-pik:  chmrr | 2007-10-16 10:08:48 -0400
  * ssl_port option for listening using ssl


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 16 10:09:22 2007
@@ -18,12 +18,13 @@
 our $VERSION = '0.001';
 
 __PACKAGE__->mk_accessors(
-    qw/socket select connections port auth_class model_class/);
+    qw/socket ssl_socket select connections port auth_class model_class ssl_port/);
 
 sub new {
     my $class = shift;
     return $class->SUPER::new(
         {   port        => 8080,
+            ssl_port    => 0,
             auth_class  => "Net::Server::IMAP::DefaultAuth",
             model_class => "Net::Server::IMAP::DefaultModel",
             @_,
@@ -44,11 +45,25 @@
     else      { warn "Listening on " . $self->port . "\n" }
     $self->socket($lsn);
     $self->select( IO::Select->new($lsn) );
+
+    my $ssl;
+    if ($self->ssl_port) {
+        $ssl = IO::Socket::SSL->new(
+            Listen    => 1,
+            LocalPort => $self->ssl_port,
+            ReuseAddr => 1
+        );
+        if   ($@) { die "SSL Listen on port " . $self->ssl_port . " failed: $@"; }
+        else      { warn "SSL Listening on " . $self->ssl_port . "\n" }
+        $self->ssl_socket($ssl);
+        $self->select->add($ssl);
+    }
+
     while ( $self->select ) {
         while ( my @ready = $self->select->can_read ) {
             Module::Refresh->refresh;
             foreach my $fh (@ready) {
-                if ( $fh == $lsn ) {
+                if ( $fh == $lsn or (defined $ssl and $fh == $ssl)) {
 
                     # Create a new socket
                     my $new = $fh->accept;

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 16 10:09:22 2007
@@ -101,6 +101,11 @@
     return defined $self->selected;
 }
 
+sub is_encrypted {
+    my $self = shift;
+    return $self->io_handle->isa("IO::Socket::SSL");
+}
+
 sub auth {
     my $self = shift;
     if (@_) {