byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add explicit SSL_ca_file parameter to calls to create the SSL session.

Browse Source 
git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@604 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
John Peacock 2006-01-25 14:50:47 +00:00
parent a67b39e282
commit 0f5d720359
1 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
plugins/tls
View File

@ -8,7 +8,7 @@ tls - plugin to support STARTTLS
# in config/plugins # in config/plugins
tls ssl/cert.pem ssl/privkey.pem tls ssl/cert.pem ssl/privkey.pem ssl/ca.pem
=head1 DESCRIPTION =head1 DESCRIPTION
@ -19,26 +19,34 @@ Connection notes is set. If you wish to make TLS mandatory you should check
that field and take appropriate action. Note that you can only do that from that field and take appropriate action. Note that you can only do that from
MAIL FROM onwards. MAIL FROM onwards.
Use the script C<plugins/tls_cert> to automatically generate a self-signed
certificate with the appropriate characteristics. Otherwise, you should
give absolute pathnames to the certificate, key, and the CA root cert
used to sign that certificate.
=cut =cut
use IO::Socket::SSL;# qw(debug1 debug2 debug3 debug4); use IO::Socket::SSL;# qw(debug1 debug2 debug3 debug4);
sub init { sub init {
my ($self, $qp, $cert, $key) = @_; my ($self, $qp, $cert, $key, $ca) = @_;
$cert ||= 'ssl/qpsmtpd-server.crt'; $cert ||= 'ssl/qpsmtpd-server.crt';
$key ||= 'ssl/qpsmtpd-server.key'; $key ||= 'ssl/qpsmtpd-server.key';
unless ( -f $cert && -f $key ) { $ca ||= 'ssl/qpsmtpd-ca.crt';
$self->log(LOGERROR, "Cannot locate cert/key! Run plugins/tls_cert to generate"); unless ( -f $cert && -f $key && -f $ca ) {
return; $self->log(LOGERROR, "Cannot locate cert/key! Run plugins/tls_cert to generate");
return;
} }
$self->tls_cert($cert); $self->tls_cert($cert);
$self->tls_key($key); $self->tls_key($key);
$self->tls_ca($ca);
local $^W; # this bit is very noisy... local $^W; # this bit is very noisy...
my $ssl_ctx = IO::Socket::SSL::SSL_Context->new( my $ssl_ctx = IO::Socket::SSL::SSL_Context->new(
SSL_use_cert => 1, SSL_use_cert => 1,
SSL_cert_file => $self->tls_cert, SSL_cert_file => $self->tls_cert,
SSL_key_file => $self->tls_key, SSL_key_file => $self->tls_key,
SSL_ca_file => $self->tls_ca,
SSL_cipher_list => 'HIGH', SSL_cipher_list => 'HIGH',
SSL_server => 1 SSL_server => 1
) or die "Could not create SSL context: $!"; ) or die "Could not create SSL context: $!";
@ -91,6 +99,7 @@ sub hook_unrecognized_command {
SSL_use_cert => 1, SSL_use_cert => 1,
SSL_cert_file => $self->tls_cert, SSL_cert_file => $self->tls_cert,
SSL_key_file => $self->tls_key, SSL_key_file => $self->tls_key,
SSL_ca_file => $self->tls_ca,
SSL_cipher_list => 'HIGH', SSL_cipher_list => 'HIGH',
SSL_server => 1, SSL_server => 1,
SSL_reuse_ctx => $self->ssl_context, SSL_reuse_ctx => $self->ssl_context,
@ -130,6 +139,12 @@ sub tls_key {
$self->{_tls_key}; $self->{_tls_key};
} }
sub tls_ca {
my $self = shift;
@_ and $self->{_tls_ca} = shift;
$self->{_tls_ca};
}
sub ssl_context { sub ssl_context {
my $self = shift; my $self = shift;
@_ and $self->{_ssl_ctx} = shift; @_ and $self->{_ssl_ctx} = shift;