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
This commit is contained in:
John Peacock 2006-01-05 02:21:32 +00:00
parent 1c2009764f
commit 7c1c9ef01b
3 changed files with 171 additions and 20 deletions

View File

@ -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;

View File

@ -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;
}

138
plugins/tls_cert Executable file
View File

@ -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);
}