Allow override of TLS security methods using CIPHER_STRINGS passed to

IO::Socket::SSL.  Brian Szymanski <ski-qpsmtpd@allafrica.com>

git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@663 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
John Peacock 2006-10-04 13:39:27 +00:00
parent a7a3031440
commit 9c39c530b2
2 changed files with 24 additions and 2 deletions

View File

@ -0,0 +1,4 @@
# Override HIGH security using suitable string from available ciphers at
# L<http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS>
# See plugins/tls for details.
MEDIUM

View File

@ -46,6 +46,15 @@ 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.
=head1 CIPHERS and COMPATIBILITY
By default, we use only the plugins that openssl considers to be
"high security". If you need to tweak the available ciphers for some
broken client (such as Versamail 3.x), have a look at the available
ciphers at L<http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS>,
and put a suitable string in config/tls_ciphers (e.g. "DEFAULT" or
"HIGH:MEDIUM")
=cut
use IO::Socket::SSL;# qw(debug1 debug2 debug3 debug4);
@ -62,14 +71,17 @@ sub init {
$self->tls_cert($cert);
$self->tls_key($key);
$self->tls_ca($ca);
$self->tls_ciphers($self->qp->config('tls_ciphers') || 'HIGH');
$self->log(LOGINFO, "ciphers: $self->tls_ciphers");
local $^W; # this bit is very noisy...
my $ssl_ctx = IO::Socket::SSL::SSL_Context->new(
SSL_use_cert => 1,
SSL_cert_file => $self->tls_cert,
SSL_key_file => $self->tls_key,
SSL_ca_file => $self->tls_ca,
SSL_cipher_list => 'HIGH',
SSL_cipher_list => $self->tls_ciphers,
SSL_server => 1
) or die "Could not create SSL context: $!";
# now extract the password...
@ -149,7 +161,7 @@ sub _convert_to_ssl {
SSL_cert_file => $self->tls_cert,
SSL_key_file => $self->tls_key,
SSL_ca_file => $self->tls_ca,
SSL_cipher_list => 'HIGH',
SSL_cipher_list => $self->tls_ciphers,
SSL_server => 1,
SSL_reuse_ctx => $self->ssl_context,
) or die "Could not create SSL socket: $!";
@ -191,6 +203,12 @@ sub tls_ca {
$self->{_tls_ca};
}
sub tls_ciphers {
my $self = shift;
@_ and $self->{_tls_ciphers} = shift;
$self->{_tls_ciphers};
}
sub ssl_context {
my $self = shift;
@_ and $self->{_ssl_ctx} = shift;