Howdy all,
In the previous thread, I noticed that the socket upgrading that I had
hacked in defeated the purpose of TLS in -async, as it blocked while the
socket upgrade was in progress.
So I came up with a far uglier patch! [grin]
It borrows heavily from Perlbal::SocketSSL. The bad news is that I
don't yet understand the code base well enough to implement this
cleanly, and I had to special case the SSL negotiation events inside of
Danga::Client::event_read, which pains me to admit.
In fact, the entire patch seems to operate outside of Qpsmtpd's
wonderful plugin system, but I'm not smart enough to figure out how to
avoid that right now.
With apologies, here is take two on my tls -async hacking, which seems
to work in that it can upgrade a socket without blocking.
-- Douglas
diff -ur qpsmtpd/lib/Danga/Client.pm qpsmtpd.tls-async/lib/Danga/Client.pm
--- qpsmtpd/lib/Danga/Client.pm 2008-05-03 11:37:29.000000000 -0400
+++ qpsmtpd.tls-async/lib/Danga/Client.pm 2008-05-04 12:48:23.000000000 -0400
@@ -98,6 +98,11 @@
sub event_read {
my Danga::Client $self = shift;
+ if ( $self->connection->notes('tls_upgrading') ) {
+ warn "TLS is upgrading, using upgrader";
+ $self->watch_read( 0 );
+ return $self->connection->notes( 'tls_upgrader' )->upgrade_socket();
+ }
if ($self->{callback}) {
$self->{alive_time} = time;
if ($self->{get_chunks}) {
diff -ur qpsmtpd/plugins/tls qpsmtpd.tls-async/plugins/tls
--- qpsmtpd/plugins/tls 2008-05-04 12:35:47.000000000 -0400
+++ qpsmtpd.tls-async/plugins/tls 2008-05-04 12:52:41.000000000 -0400
@@ -159,6 +159,10 @@
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_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,76 @@
$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;
+
+ $self->{_stashed_qp}->connection->notes( "tls_upgrading", 1 );
+
+ 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;
+ }
+
+ my $sock = $self->{_stashed_qp}->{sock}->accept_SSL;
+
+ if (defined $sock) {
+ $self->{_stashed_qp}->connection->notes( "tls_upgrading", 0 );
+ $self->{_stashed_qp}->connection(
+ $self->{_stashed_qp}->connection->clone );
+ $self->{_stashed_qp}->reset_transaction;
+ $self->{_stashed_qp}->connection->notes('tls_socket', $sock);
+ $self->{_stashed_qp}->connection->notes('tls_enabled', 1);
+ $self->{_stashed_qp}->watch_read(1);
+ return 1;
+ }
+
+ # nope, let's see if we can continue the process
+ if ($! == EAGAIN) {
+ if ($SSL_ERROR == SSL_WANT_READ) {
+ $self->{_stashed_qp}->watch_read(1);
+ } elsif ($SSL_ERROR == SSL_WANT_WRITE) {
+ $self->{_stashed_qp}->watch_write(1);
+ } else {
+ $self->{_stashed_qp}->disconnect();
+ }
+ } else {
+ $self->{_stashed_qp}->disconnect();
+ }
+}
+
+1;
+
