Michael Holtz was close with his attempt, but the key line he missed was:
*STDIN = *STDOUT = $socket;
This allows us to use tied file handles for the SSL communication, rather
than writing directly to file descriptors which are connected to the
socket.
Something I know which is missing from what I have so far is carrying
notes over from before switching form plaintext to SSL. I'm sure there'll
be plenty of more things found too.
diff -ru ../qpsmtpd-0.29.orig/lib/Qpsmtpd/Connection.pm
./lib/Qpsmtpd/Connection.pm
--- ../qpsmtpd-0.29.orig/lib/Qpsmtpd/Connection.pm Wed Sep 22 12:01:16 2004
+++ ./lib/Qpsmtpd/Connection.pm Thu Jul 7 20:00:40 2005
@@ -15,7 +15,7 @@
my %args = @_;
for my $f (qw(remote_host remote_ip remote_info remote_port
- local_ip local_port)) {
+ local_ip local_port tls_cert)) {
$self->$f($args{$f}) if $args{$f};
}
@@ -77,6 +77,23 @@
$self->{_hello_host};
}
+sub tls_cert {
+ my $self = shift;
+ @_ and $self->{_tls_cert} = shift;
+ $self->{_tls_cert};
+}
+
+sub socket {
+ my $self = shift;
+ @_ and $self->{_socket} = shift;
+ $self->{_socket};
+}
+
+sub can_do_tls {
+ my $self = shift;
+ $self->tls_cert && -r $self->tls_cert && $self->hello eq "ehlo";
+}
+
sub notes {
my $self = shift;
my $key = shift;
Only in ./lib/Qpsmtpd: Connection.pm.new
diff -ru ../qpsmtpd-0.29.orig/lib/Qpsmtpd/SMTP.pm ./lib/Qpsmtpd/SMTP.pm
--- ../qpsmtpd-0.29.orig/lib/Qpsmtpd/SMTP.pm Tue Mar 1 09:31:25 2005
+++ ./lib/Qpsmtpd/SMTP.pm Thu Jul 7 19:59:35 2005
@@ -13,10 +13,12 @@
use Qpsmtpd::Auth;
use Qpsmtpd::Address ();
+
use Mail::Header ();
#use Data::Dumper;
use POSIX qw(strftime);
use Net::DNS;
+use IO::Socket::SSL qw(debug1 debug2 debug3 debug4);
# this is only good for forkserver
# can't set these here, cause forkserver resets them
@@ -31,7 +33,7 @@
my $self = bless ({ args => \%args }, $class);
- my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit);
+ my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit
starttls);
my (%commands); @[EMAIL PROTECTED] = ('') x @commands;
# this list of valid commands should probably be a method or a set of methods
$self->{_commands} = \%commands;
@@ -124,6 +126,7 @@
sub connection {
my $self = shift;
+ @_ and $self->{_connection} = shift;
return $self->{_connection} || ($self->{_connection} =
Qpsmtpd::Connection->new());
}
@@ -150,6 +153,49 @@
}
}
+sub starttls
+{
+ my ($self) = @_;
+
+ unless ($self->connection->can_do_tls)
+ {
+ $self->respond(500, "Unrecognized command");
+ return(0);
+ }
+ if (shift)
+ {
+ $self->respond(501, "Syntax error (no parameters allowed)");
+ return(0);
+ }
+
+ $self->respond (220, "Go ahead with TLS");
+
+ my $tlssocket = IO::Socket::SSL->new_from_fd(
+ fileno(STDIN), '+>',
+ SSL_use_cert => 1,
+ SSL_cert_file => $self->connection->tls_cert,
+ SSL_key_file => $self->connection->tls_cert,
+ SSL_cipher_list => 'HIGH',
+ SSL_server => 1 ) or die "Could not create SSL socket: $!";
+
+ my $conn = $self->connection;
+ # Create a new connection object with subset of information collected thus
far
+ $self->connection(Qpsmtpd::Connection->new(
+ map { $_ => $conn->$_ }
+ qw(
+ local_ip
+ local_port
+ remote_ip
+ remote_port
+ remote_host
+ remote_info
+ ),
+ ));
+ $self->reset_transaction;
+ *STDIN = *STDOUT = $self->connection->socket($tlssocket);
+ return(0);
+}
+
sub ehlo {
my ($self, $hello_host, @stuff) = @_;
return $self->respond (501,
@@ -194,6 +240,7 @@
$self->respond(250,
$self->config("me") . " Hi " . $conn->remote_info . " [" .
$conn->remote_ip ."]",
+ $self->connection->can_do_tls ? "STARTTLS" : (),
"PIPELINING",
"8BITMIME",
($self->config('databytes') ? "SIZE ".
($self->config('databytes'))[0] : ()),
diff -ru ../qpsmtpd-0.29.orig/qpsmtpd-forkserver ./qpsmtpd-forkserver
--- ../qpsmtpd-0.29.orig/qpsmtpd-forkserver Sun Nov 28 22:37:38 2004
+++ ./qpsmtpd-forkserver Thu Jul 7 18:16:02 2005
@@ -181,6 +181,7 @@
local_port => $lport,
remote_ip => $ENV{TCPREMOTEIP},
remote_port => $port,
+ tls_cert => "ssl/cert.pem",
);
$qpsmtpd->run();
