develooper Front page | perl.qpsmtpd | Postings from July 2005

[Patch] STARTTLS support (forkserver only)

Thread Next
From:
Charlie Brady
Date:
July 7, 2005 17:11
Subject:
[Patch] STARTTLS support (forkserver only)
Message ID:
Pine.LNX.4.61.0507072005560.16651@e-smith.charlieb.ott.istop.com

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); @commands{@commands} = ('') 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();


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About