[svn:qpsmtpd] r597 - in branches/0.3x: lib/Qpsmtpd plugins

Author: jpeacock
Date: Wed Jan  4 18:12:46 2006
New Revision: 597

Added:
   branches/0.3x/plugins/tls_cert   (contents, props changed)
Modified:
   branches/0.3x/lib/Qpsmtpd/Connection.pm
   branches/0.3x/plugins/tls
Log:
Fix problems with tls and relay_client.

* lib/Qpsmtpd/Connection.pm
    Abstract out parameters which can be reused (e.g. TLS) or can be
    set when creating the Connection object via start().

* plugins/tls
    Simplify code to use $self->clone() construct and also suppress
    IO::Socket::SSL debug noise, now that this is working.

* plugins/tls_cert
    New file to automate creating self-signed certificates for TLS.

Modified: branches/0.3x/lib/Qpsmtpd/Connection.pm
==============================================================================
--- branches/0.3x/lib/Qpsmtpd/Connection.pm	(original)
+++ branches/0.3x/lib/Qpsmtpd/Connection.pm	Wed Jan  4 18:12:46 2006
@@ -1,6 +1,20 @@
 package Qpsmtpd::Connection;
 use strict;
 
+# All of these parameters depend only on the physical connection, 
+# i.e. not on anything sent from the remote machine.  Hence, they
+# are an appropriate set to use for either start() or clone().  Do
+# not add parameters here unless they also meet that criteria.
+my @parameters = qw(
+        remote_host
+        remote_ip 
+        remote_info 
+        remote_port
+        local_ip
+        local_port
+        relay_client
+);
+
 sub new {
   my $proto = shift;
   my $class = ref($proto) || $proto;
@@ -14,14 +28,22 @@ sub start {
 
   my %args = @_;
 
-  for my $f (qw(remote_host remote_ip remote_info remote_port
-               local_ip local_port)) {
+  foreach my $f ( @parameters ) {
     $self->$f($args{$f}) if $args{$f};
   }
 
   return $self;
 }
 
+sub clone {
+  my $self = shift;
+  my $new = $self->new();
+  foreach my $f ( @parameters ) {
+    $new->$f($self->$f()) if $self->$f();
+  }
+  return $new;
+}
+
 sub remote_host {
   my $self = shift;
   @_ and $self->{_remote_host} = shift;

Modified: branches/0.3x/plugins/tls
==============================================================================
--- branches/0.3x/plugins/tls	(original)
+++ branches/0.3x/plugins/tls	Wed Jan  4 18:12:46 2006
@@ -21,12 +21,16 @@ MAIL FROM onwards.
 
 =cut
 
-use IO::Socket::SSL qw(debug1 debug2 debug3 debug4);
+use IO::Socket::SSL;# qw(debug1 debug2 debug3 debug4);
 
 sub init {
     my ($self, $qp, $cert, $key) = @_;
-    $cert ||= 'ssl/cert.pem';
-    $key  ||= 'ssl/privkey.pem';
+    $cert ||= 'ssl/qpsmtpd-server.crt';
+    $key  ||= 'ssl/qpsmtpd-server.key';
+    unless ( -f $cert && -f $key ) {
+	$self->log(LOGERROR, "Cannot locate cert/key!  Run plugins/tls_cert to generate");
+	return;
+    }
     $self->tls_cert($cert);
     $self->tls_key($key);
     
@@ -92,19 +96,8 @@ sub hook_unrecognized_command {
             SSL_reuse_ctx => $self->ssl_context,
         ) or die "Could not create SSL socket: $!";
     
-        my $conn = $self->connection;
-        # Create a new connection object with subset of information collected thus far
-        $self->qp->connection(Qpsmtpd::Connection->new(
-           map { $_ => $conn->$_ }
-                qw(
-                    local_ip
-                    local_port
-                    remote_ip
-                    remote_port
-                    remote_host
-                    remote_info
-                ),
-            ));
+        # Clone connection object (without data received from client)
+        $self->qp->connection($self->connection->clone());
         $self->qp->reset_transaction;
         *STDIN = *STDOUT = $self->connection->notes('tls_socket', $tlssocket);
         $self->connection->notes('tls_enabled', 1);
@@ -116,7 +109,7 @@ sub hook_unrecognized_command {
         return DENY, "TLS Negotiation Failed";
     }
     
-    warn("TLS setup returning\n");
+    $self->log(LOGWARN, "TLS setup returning");
     return DONE;
 }
 

Added: branches/0.3x/plugins/tls_cert
==============================================================================
--- (empty file)
+++ branches/0.3x/plugins/tls_cert	Wed Jan  4 18:12:46 2006
@@ -0,0 +1,138 @@
+#!/usr/bin/perl -w
+# Very basic script to create TLS certificates for qpsmtpd
+use File::Temp qw/ tempfile tempdir /;
+use Getopt::Long;
+
+my %opts = ();
+chomp (my $hostname = `hostname --fqdn`);
+my %defaults = (
+    C  => 'XY',
+    ST => 'unknown',
+    L  => 'unknown',
+    O  => 'QSMTPD',
+    OU => 'Server',
+    CN => $hostname,
+);
+
+GetOptions(\%opts, 
+    'C|Country:s',
+    'ST|State:s',
+    'L|Locality|City:s',
+    'O|Organization:s',
+    'OU|OrganizationalUnit|U:s',
+    'CN|CommonName|N:s',
+    'emailAddress|email|E:s',
+    'help|H',
+);
+
+usage() if $opts{help};
+
+# initialize defaults
+foreach my $key ( keys %defaults ) {
+    $opts{$key} = $defaults{$key} unless $opts{$key}
+}
+$opts{emailAddress} = 'postmaster@'.$opts{CN};
+
+mkdir('ssl') unless -d 'ssl';
+
+my $CA_key = 'ssl/qpsmtpd-ca.key';
+my $CA_crt = 'ssl/qpsmtpd-ca.crt';
+my $CA_serial = 'ssl/.cert.serial';
+
+my ($CA, $CAfilename) = tempfile( $template, DIR => "ssl", UNLINK => 1);
+
+print ${CA} return_cfg('CA');
+close ${CA};
+
+system('openssl', 'genrsa', '-out', $CA_key, 2048) == 0 
+    or die "Cannot create CA key: $?";
+
+system('openssl', 'req', '-config', $CAfilename, '-new', '-x509',
+	'-days', (365*6), '-key', $CA_key,
+	'-out', $CA_crt) == 0
+    or die "Cannot create CA cert: $?";
+
+my $SERVER_key = 'ssl/qpsmtpd-server.key';
+my $SERVER_csr = 'ssl/qpsmtpd-server.csr';
+my $SERVER_crt = 'ssl/qpsmtpd-server.crt';
+
+my ($SERVER, $SERVERfilename) = tempfile( $template, DIR => "ssl", UNLINK => 1);
+print ${SERVER} return_cfg($opts{OU});
+close ${SERVER};
+
+system('openssl', 'genrsa', '-out', $SERVER_key, 1024) == 0 
+    or die "Cannot create server key: $?";
+
+system('openssl', 'req', '-config', $SERVERfilename, '-new', 
+	'-key', $SERVER_key, '-out', $SERVER_csr) == 0
+    or die "Cannot create CA cert: $?";
+
+my ($SIGN, $SIGNfilename) = tempfile( $template, DIR => "ssl", UNLINK => 1);
+print ${SIGN} <<"EOT";
+extensions = x509v3
+[ x509v3 ]
+subjectAltName   = email:copy
+nsComment        = tls certificate
+nsCertType       = server
+EOT
+close ${SIGN};
+
+open my $SERIAL, '>', $CA_serial;
+print ${SERIAL} "01\n";
+close ${SERIAL};
+
+system('openssl', 'x509', '-extfile', $SIGNfilename, '-days', (365*2),
+	'-CAserial', $CA_serial, '-CA', $CA_crt,
+	'-CAkey', $CA_key, '-in', $SERVER_csr,
+	'-req', '-out', $SERVER_crt) == 0
+    or die "Cannot sign cert: $?";
+
+exit(0);
+	
+sub return_cfg {
+    my $OU = shift;
+    my $RANDOM = int(rand(1000)).'RAN'.int(rand(1000)).'DOM';
+    my $cfg = <<"EOT";
+[ req ]
+default_bits           = 1024
+default_keyfile        = keyfile.pem
+distinguished_name     = req_distinguished_name
+attributes             = req_attributes
+prompt                 = no
+output_password        = mypass
+
+[ req_distinguished_name ]
+C                      = $opts{C}
+ST                     = $opts{ST}
+L                      = $opts{L}
+O                      = $opts{O}
+OU                     = $OU
+CN                     = $opts{CN}
+emailAddress           = $opts{emailAddress}
+
+[ req_attributes ]
+challengePassword      = $RANDOM challenge password
+EOT
+    return $cfg;
+}
+
+sub usage {
+    print STDERR <<"EOT";
+
+ $0 will generate a TLS certificate "the quick way",
+ i.e. without interaction.  You can change some defaults however.
+    
+ These options are recognized:             Default:
+
+  --C       Country (two letters, e.g. DE) $defaults{C}
+  --ST      State (spelled out)            $defaults{ST}
+  --L       City                           $defaults{L}
+  --O       Organization                   $defaults{O}
+  --OU      Organizational Unit            $defaults{OU}
+  --CN      Common name                    $defaults{CN}
+  --email   Email address of postmaster    postmaster\@CN
+  --help    Show usage
+
+EOT
+    exit(1);
+}