> >I'm currently trying to hack TLS support for qpsmtpd. The idea is to use > >IO::Socket::TLS. I implemented a new starttls command, my current code is: > >... > Is your full patch available anywhere? I'd like to have a look.
What was posted was nearly the complete patch. Here is however a complete one: diff -Naur qpsmtpd-0.29/lib/Qpsmtpd/SMTP.pm qpsmtpd-0.29-tls/lib/Qpsmtpd/SMTP.pm --- qpsmtpd-0.29/lib/Qpsmtpd/SMTP.pm 2005-03-01 15:31:25.000000000 +0100 +++ qpsmtpd-0.29-tls/lib/Qpsmtpd/SMTP.pm 2005-05-12 17:19:52.000000000 +0200 @@ -17,6 +17,7 @@ #use Data::Dumper; use POSIX qw(strftime); use Net::DNS; +use IO::Socket::SSL; # this is only good for forkserver # can't set these here, cause forkserver resets them @@ -31,7 +32,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; @@ -150,6 +151,26 @@ } } +sub starttls { + my ($self) = @_; + + $self->respond (220, "Go ahead with TLS"); + + my $tlssocket = IO::Socket::SSL->new_from_fd( + $fd, + '+<>', + SSL_use_cert => 1, + SSL_cert_file => 'mtaca.crt', + SSL_key_file => 'mtaca.key', + SSL_cipher_list => 'HIGH', + SSL_server => 1 ); + + POSIX::dup2(fileno($tlssocket), 0); + POSIX::dup2(fileno($tlssocket), 1); + + return(0); +} + sub ehlo { my ($self, $hello_host, @stuff) = @_; return $self->respond (501, @@ -195,7 +216,7 @@ $self->respond(250, $self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]", "PIPELINING", - "8BITMIME", + "8BITMIME", "STARTTLS", ($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()), @capabilities, );
