Index: /trunk/lib/Perlbal/SocketSSL.pm
===================================================================
--- /trunk/lib/Perlbal/SocketSSL.pm (revision 708)
+++ /trunk/lib/Perlbal/SocketSSL.pm (revision 708)
@@ -0,0 +1,135 @@
+# Base class for SSL sockets.
+#
+# This is a simple class that extends Danga::Socket and contains an IO::Socket::SSL
+# for the purpose of allowing non-blocking SSL in Perlbal.
+#
+# WARNING: this code will break IO::Socket::SSL if you use it in any plugins or
+# have custom Perlbal modifications that use it.  you will run into issues.  This
+# is because we override the close method to prevent premature closure of the socket,
+# so you will end up with the socket not closing properly.
+#
+# Copyright 2007, Mark Smith <mark@plogs.net>.
+#
+# This file is licensed under the same terms as Perl itself.
+
+package Perlbal::SocketSSL;
+
+use strict;
+use warnings;
+no  warnings qw(deprecated);
+
+use Danga::Socket 1.44;
+use IO::Socket::SSL;
+use Errno qw( EAGAIN );
+
+use base 'Danga::Socket';
+use fields qw( listener create_time );
+
+# magic IO::Socket::SSL crap to make it play nice with us
+{
+    no strict 'refs';
+    no warnings 'redefine';
+
+    # replace IO::Socket::SSL::close with our own code...
+    my $orig = *IO::Socket::SSL::close{CODE};
+    *IO::Socket::SSL::close = sub {
+        my $self = shift()
+            or return IO::Socket::SSL::_invalid_object();
+
+        # if we have args, close ourselves (second call!), else don't
+        if (exists ${*$self}->{__close_args}) {
+            $orig->($self, @{${*$self}->{__close_args}});
+        } else {
+            ${*$self}->{__close_args} = [ @_ ];
+            ${*$self}->{_danga_socket}->close('intercepted_ssl_close');
+        }
+    };
+}
+
+# called: CLASS->new( $sock, $tcplistener )
+sub new {
+    my Perlbal::SocketSSL $self = shift;
+    $self = fields::new( $self ) unless ref $self;
+
+    Perlbal::objctor($self);
+
+    my ($sock, $listener) = @_;
+
+    ${*$sock}->{_danga_socket} = $self;
+    $self->{listener} = $listener;
+    $self->{create_time} = time;
+
+    $self->SUPER::new($sock);
+
+    # TODO: would be good to have an overall timeout so that we can
+    # kill sockets that are open and just sitting ethere.  "ssl_handshake_timeout"
+    # or something like that...
+
+    return $self;
+}
+
+# this is nonblocking, it attempts to setup SSL and if it can't then
+# it returns whether it needs to read or write.  we then setup to wait
+# for the event it indicates and then wait.  when that event fires, we
+# call down again, and repeat the process until we have setup the
+# SSL connection.
+sub try_accept {
+    my Perlbal::SocketSSL $self = shift;
+
+    my $sock = $self->{sock}->accept_SSL;
+
+    if (defined $sock) {
+        # looks like we got it!  let's steal it from ourselves
+        # so Danga::Socket gives up on it and we can send
+        # it out to someone else.  (we discard the return value
+        # as we already have it in $sock)
+        #
+        # of course, life isn't as simple as that.  we have to do
+        # some trickery with the ordering here to ensure that we
+        # don't setup the new class until after the Perlbal::SocketSSL
+        # goes away according to Danga::Socket.
+        # 
+        # if we don't do it this way, we get nasty errors because
+        # we (this object) still exists in the DescriptorMap of
+        # Danga::Socket when the new Perlbal::ClientXX tries to
+        # insert itself there.
+
+        # removes us from the active polling, closes up shop, but
+        # save our fd first!
+        my $fd = $self->{fd};
+        $self->steal_socket;
+
+        # finish blowing us away
+        my $ref = Danga::Socket->DescriptorMap();
+        delete $ref->{$fd};
+
+        # now stick the new one in
+        $self->{listener}->class_new_socket($sock);
+        return;
+    }
+
+    # nope, let's see if we can continue the process
+    if ($! == EAGAIN) {
+        if ($SSL_ERROR == SSL_WANT_READ) {
+            $self->watch_read(1);
+        } elsif ($SSL_ERROR == SSL_WANT_WRITE) {
+            $self->watch_write(1);
+        } else {
+            $self->close('invalid_ssl_state');
+        }
+    } else {
+        $self->close('invalid_ssl_error');
+    }
+}
+
+sub event_read {
+    $_[0]->watch_read(0);
+    $_[0]->try_accept;
+}
+
+sub event_write {
+    $_[0]->watch_write(0);
+    $_[0]->try_accept;
+}
+
+1;
Index: /trunk/lib/Perlbal/TCPListener.pm
===================================================================
--- /trunk/lib/Perlbal/TCPListener.pm (revision 687)
+++ /trunk/lib/Perlbal/TCPListener.pm (revision 708)
@@ -12,6 +12,7 @@
 
 use base "Perlbal::Socket";
-use fields qw(service hostport);
+use fields qw(service hostport sslopts);
 use Socket qw(IPPROTO_TCP SOL_SOCKET SO_SNDBUF);
+use Perlbal::SocketSSL;
 
 # TCPListener
@@ -20,14 +21,10 @@
     $opts ||= {};
 
-    my $sockclass = $opts->{ssl} ? "IO::Socket::SSL" : "IO::Socket::INET";
-    my $sock = eval {
-        $sockclass->new(
-                        LocalAddr => $hostport,
-                        Proto => IPPROTO_TCP,
-                        Listen => 1024,
-                        ReuseAddr => 1,
-                        ($opts->{ssl} ? %{$opts->{ssl}} : ()),
-                        );
-    };
+    my $sock = IO::Socket::INET->new(
+                                     LocalAddr => $hostport,
+                                     Proto => IPPROTO_TCP,
+                                     Listen => 1024,
+                                     ReuseAddr => 1,
+                                     );
 
     return Perlbal::error("Error creating listening socket: " . ($@ || $!))
@@ -49,4 +46,5 @@
     $self->{service} = $service;
     $self->{hostport} = $hostport;
+    $self->{sslopts} = $opts->{ssl};
     bless $self, ref $class || $class;
     $self->watch_read(1);
@@ -60,12 +58,4 @@
     # accept as many connections as we can
     while (my ($psock, $peeraddr) = $self->{sock}->accept) {
-        my $service_role = $self->{service}->role;
-
-        if (Perlbal::DEBUG >= 1) {
-            my ($pport, $pipr) = Socket::sockaddr_in($peeraddr);
-            my $pip = Socket::inet_ntoa($pipr);
-            print "Got new conn: $psock ($pip:$pport) for $service_role\n";
-        }
-
         IO::Handle::blocking($psock, 0);
 
@@ -74,18 +64,56 @@
         }
 
-        if ($service_role eq "reverse_proxy") {
-            Perlbal::ClientProxy->new($self->{service}, $psock);
-        } elsif ($service_role eq "management") {
-            Perlbal::ClientManage->new($self->{service}, $psock);
-        } elsif ($service_role eq "web_server") {
-            Perlbal::ClientHTTP->new($self->{service}, $psock);
-        } elsif ($service_role eq "selector") {
-            # will be cast to a more specific class later...
-            Perlbal::ClientHTTPBase->new($self->{service}, $psock, $self->{service});
-        } elsif (my $creator = Perlbal::Service::get_role_creator($service_role)) {
-            # was defined by a plugin, so we want to return one of these
-            $creator->($self->{service}, $psock);
+        if (Perlbal::DEBUG >= 1) {
+            my ($pport, $pipr) = Socket::sockaddr_in($peeraddr);
+            my $pip = Socket::inet_ntoa($pipr);
+            print "Got new conn: $psock ($pip:$pport) for " . $self->{service}->role . "\n";
         }
 
+        # SSL promotion if necessary
+        if ($self->{sslopts}) {
+            # try to upgrade to SSL, this does no IO it just reblesses
+            # and prepares the SSL engine for handling us later
+            IO::Socket::SSL->start_SSL(
+                                       $psock,
+                                       SSL_server => 1,
+                                       SSL_startHandshake => 0,
+                                       %{ $self->{sslopts} },
+                                       );
+            print "  .. socket upgraded to SSL!\n" if Perlbal::DEBUG >= 1;
+
+            # safety checking to ensure we got upgraded
+            return $psock->close
+                unless ref $psock eq 'IO::Socket::SSL';
+
+            # class into new package and run with it
+            my $sslsock = new Perlbal::SocketSSL($psock, $self);
+            $sslsock->try_accept;
+
+            # all done from our point of view
+            next;
+        }
+
+        # puts this socket into the right class
+        $self->class_new_socket($psock);
+    }
+}
+
+sub class_new_socket {
+    my Perlbal::TCPListener $self = shift;
+    my $psock = shift;
+
+    my $service_role = $self->{service}->role;
+    if ($service_role eq "reverse_proxy") {
+        Perlbal::ClientProxy->new($self->{service}, $psock);
+    } elsif ($service_role eq "management") {
+        Perlbal::ClientManage->new($self->{service}, $psock);
+    } elsif ($service_role eq "web_server") {
+        Perlbal::ClientHTTP->new($self->{service}, $psock);
+    } elsif ($service_role eq "selector") {
+        # will be cast to a more specific class later...
+        Perlbal::ClientHTTPBase->new($self->{service}, $psock, $self->{service});
+    } elsif (my $creator = Perlbal::Service::get_role_creator($service_role)) {
+        # was defined by a plugin, so we want to return one of these
+        $creator->($self->{service}, $psock);
     }
 }
@@ -113,5 +141,4 @@
 }
 
-
 1;
 
Index: /trunk/CHANGES
===================================================================
--- /trunk/CHANGES (revision 707)
+++ /trunk/CHANGES (revision 708)
@@ -1,2 +1,4 @@
+    -- make SSL non-blocking
+
     -- make persist_client_timeout service tunable apply to the max_idle_time
        value used to kill sockets that are idle