From 7c1c9ef01bc7e4cd1e927d42a7b10ceb913dbbb6 Mon Sep 17 00:00:00 2001 From: John Peacock Date: Thu, 5 Jan 2006 02:21:32 +0000 Subject: [PATCH] Fix problems with tls and relay_client. Merge r597 from branches/0.3x git-svn-id: https://svn.perl.org/qpsmtpd/trunk@598 958fd67b-6ff1-0310-b445-bb7760255be9 --- lib/Qpsmtpd/Connection.pm | 26 ++++++- plugins/tls | 27 +++----- plugins/tls_cert | 138 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 171 insertions(+), 20 deletions(-) create mode 100755 plugins/tls_cert diff --git a/lib/Qpsmtpd/Connection.pm b/lib/Qpsmtpd/Connection.pm index 8fe3180..8492755 100644 --- a/lib/Qpsmtpd/Connection.pm +++ b/lib/Qpsmtpd/Connection.pm @@ -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; diff --git a/plugins/tls b/plugins/tls index 56a5468..2731449 100644 --- a/plugins/tls +++ b/plugins/tls @@ -25,8 +25,12 @@ 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); @@ -103,21 +107,8 @@ sub hook_unrecognized_command { ) or die "Could not create SSL socket: $!"; } - my $conn = $self->connection; - # Create a new connection object with subset of information collected thus far - my $newconn = Qpsmtpd::Connection->new( - map { $_ => $conn->$_ } - qw( - local_ip - local_port - remote_ip - remote_port - remote_host - remote_info - relay_client - ), - ); - $self->qp->connection($newconn); + # Clone connection object (without data received from client) + $self->qp->connection($self->connection->clone()); $self->qp->reset_transaction; if ($self->qp->isa('Danga::Socket')) { $self->connection->notes('tls_socket', $tlssocket); @@ -134,7 +125,7 @@ sub hook_unrecognized_command { return DENY, "TLS Negotiation Failed"; } - warn("TLS setup returning\n"); + $self->log(LOGWARN, "TLS setup returning"); return DONE; } diff --git a/plugins/tls_cert b/plugins/tls_cert new file mode 100755 index 0000000..51c83d2 --- /dev/null +++ b/plugins/tls_cert @@ -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); +}