Make tls work on async

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@884 958fd67b-6ff1-0310-b445-bb7760255be9

lib/Danga/Client.pm

@@ -2,7 +2,15 @@
 
 package Danga::Client;
 use base 'Danga::TimeoutSocket';
-use fields qw(line pause_count read_bytes data_bytes callback get_chunks);
+use fields qw(
+    line
+    pause_count
+    read_bytes
+    data_bytes
+    callback
+    get_chunks
+    reader_object
+    );
 use Time::HiRes ();
 
 use bytes;
@@ -26,6 +34,7 @@ sub reset_for_next_message {
     $self->{pause_count} = 0;
     $self->{read_bytes} = 0;
     $self->{callback} = undef;
+    $self->{reader_object} = undef;
     $self->{data_bytes} = '';
     $self->{get_chunks} = 0;
     return $self;
@@ -96,9 +105,18 @@ sub end_get_chunks {
     }
 }
 
+sub set_reader_object {
+    my Danga::Client $self = shift;
+    $self->{reader_object} = shift;
+}
+
 sub event_read {
     my Danga::Client $self = shift;
-    if ($self->{callback}) {
+    if (my $obj = $self->{reader_object}) {
+        $self->{reader_object} = undef;
+        $obj->event_read($self);
+    }
+    elsif ($self->{callback}) {
         $self->{alive_time} = time;
         if ($self->{get_chunks}) {
             my $bref = $self->read($self->{read_bytes});

plugins/tls

@@ -159,6 +159,10 @@ sub hook_connect {
 sub _convert_to_ssl {
     my ($self) = @_;
 
+    if ($self->qp->isa('Qpsmtpd::PollServer')) {
+        return _convert_to_ssl_async($self);
+    }
+
     eval {
         my $tlssocket = IO::Socket::SSL->new_from_fd(
             fileno(STDIN), '+>',
@@ -185,6 +189,14 @@ sub _convert_to_ssl {
     }
 }
 
+sub _convert_to_ssl_async {
+    my ($self) = @_;
+    my $upgrader = $self->connection
+                        ->notes( 'tls_upgrader', UpgradeClientSSL->new($self) );
+    $upgrader->upgrade_socket();
+    return 1;
+}
+
 sub can_do_tls {
     my ($self) = @_;
     $self->tls_cert && -r $self->tls_cert;
@@ -238,3 +250,81 @@ sub prefork_workaround {
     $self->log(LOGWARN, "Exiting because 'tls_enabled' was true.");
     exit;
 }
+
+package UpgradeClientSSL;
+
+# borrowed heavily from Perlbal::SocketSSL
+
+use strict;
+use warnings;
+no  warnings qw(deprecated);
+
+use Danga::Socket 1.44;
+use IO::Socket::SSL 0.98;
+use Errno qw( EAGAIN );
+
+use fields qw( _stashed_qp _stashed_plugin _ssl_started );
+
+sub new {
+    my UpgradeClientSSL $self = shift;
+    $self = fields::new($self) unless ref $self;
+    $self->{_stashed_plugin} = shift;
+    $self->{_stashed_qp} = $self->{_stashed_plugin}->qp;
+    return $self;
+}
+
+sub upgrade_socket {
+    my UpgradeClientSSL $self = shift;
+
+    unless ( $self->{_ssl_started} ) {
+        IO::Socket::SSL->start_SSL(
+            $self->{_stashed_qp}->{sock}, {
+                SSL_use_cert => 1,
+                SSL_cert_file => $self->{_stashed_plugin}->tls_cert,
+                SSL_key_file => $self->{_stashed_plugin}->tls_key,
+                SSL_ca_file => $self->{_stashed_plugin}->tls_ca,
+                SSL_cipher_list => $self->{_stashed_plugin}->tls_ciphers,
+                SSL_startHandshake => 0,
+                SSL_server => 1,
+                SSL_reuse_ctx => $self->{_stashed_plugin}->ssl_context,
+            } 
+        ) or die "Could not upgrade socket to SSL: $!";
+        $self->{_ssl_started} = 1;
+    }
+    
+    $self->event_read($self->{_stashed_qp});
+}
+
+sub event_read {
+    my UpgradeClientSSL $self = shift;
+    my $qp = shift;
+    
+    $qp->watch_read( 0 );
+
+    my $sock = $qp->{sock}->accept_SSL;
+
+    if (defined $sock) {
+        $qp->connection( $qp->connection->clone );
+        $qp->reset_transaction;
+        $qp->connection->notes('tls_socket', $sock);
+        $qp->connection->notes('tls_enabled', 1);
+        $qp->watch_read(1);
+        return 1;
+    }
+
+    # nope, let's see if we can continue the process
+    if ($! == EAGAIN) {
+        $qp->set_reader_object($self);
+        if ($SSL_ERROR == SSL_WANT_READ) {
+            $qp->watch_read(1);
+        } elsif ($SSL_ERROR == SSL_WANT_WRITE) {
+            $qp->watch_write(1);
+        } else {
+            $qp->disconnect();
+        }
+    } else {
+        $qp->disconnect();
+    }
+}
+
+1;