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
parent
1c2009764f
commit
7c1c9ef01b
@ -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;
|
||||
|
||||
27
plugins/tls
27
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;
|
||||
}
|
||||
|
||||
|
||||
138
plugins/tls_cert
Executable file
138
plugins/tls_cert
Executable 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);
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user