Commit b617f936 authored by sikeda's avatar sikeda
Browse files

[svn] (con'd r10649) Retrieving layout changes done on trunk (#1 of #3/3).


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@11317 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent 94bbc72f
......@@ -70,6 +70,8 @@ nobase_modules_DATA = \
Sympa/Task.pm \
Sympa/Template/Compat.pm \
tools.pm \
Sympa/Tools/DKIM.pm \
Sympa/Tools/SMIME.pm \
Sympa/Tracking.pm \
tt2.pm \
Sympa/Upgrade.pm \
......
......@@ -64,6 +64,7 @@ use SDM;
use Sympa::SQLSource;
use Sympa::Task;
use tools;
use Sympa::Tools::SMIME;
use Sympa::Tracking;
use tt2;
use Sympa::User;
......@@ -521,9 +522,6 @@ my %list_of_lists = ();
my %list_of_robots = ();
my %edit_list_conf = ();
use DB_File;
$DB_BTREE->{compare} = \&_compare_addresses;
## Creates an object.
sub new {
my ($pkg, $name, $robot, $options) = @_;
......@@ -2576,7 +2574,7 @@ sub send_file {
$data->{'list'}{'dir'} = $self->{'dir'};
# Sign mode
my $smime_sign = tools::smime_find_keys($self, 'sign');
my $smime_sign = Sympa::Tools::SMIME::find_keys($self, 'sign');
# if the list have it's private_key and cert sign the message
# . used only for the welcome message, could be useful in other case?
......@@ -9310,20 +9308,6 @@ sub _save_list_members_file {
return 1;
}
sub _compare_addresses {
my ($a, $b) = @_;
my ($ra, $rb);
$a =~ tr/A-Z/a-z/;
$b =~ tr/A-Z/a-z/;
$ra = reverse $a;
$rb = reverse $b;
return ($ra cmp $rb);
}
## Does the real job : stores the message given as an argument into
## the digest of the list.
sub store_digest {
......@@ -10299,7 +10283,7 @@ sub get_cert {
# it will have the respective cert attached anyways.
# (the problem is that netscape, opera and IE can't only
# read the first cert in a file)
my ($certs, $keys) = tools::smime_find_keys($self, 'encrypt');
my ($certs, $keys) = Sympa::Tools::SMIME::find_keys($self, 'encrypt');
my @cert;
if ($format eq 'pem') {
......
......@@ -68,6 +68,8 @@ use Sympa::List;
use Log;
use Sympa::Scenario;
use tools;
use Sympa::Tools::DKIM;
use Sympa::Tools::SMIME;
use tt2;
# Language context
......@@ -974,7 +976,7 @@ sub check_dkim_signature {
Conf::get_robot_conf($robot_id || '*', 'dkim_feature'), 'on'
)
) {
$self->{'dkim_pass'} = tools::dkim_verifier($self->as_string);
$self->{'dkim_pass'} = Sympa::Tools::DKIM::verifier($self->as_string);
}
}
......@@ -1434,7 +1436,7 @@ sub smime_decrypt {
#FIXME: an empty "context" parameter means mail to sympa@, listmaster@...
my ($certs, $keys) =
tools::smime_find_keys($self->{context} || '*', 'decrypt');
Sympa::Tools::SMIME::find_keys($self->{context} || '*', 'decrypt');
unless (defined $certs and @$certs) {
Log::do_log('err',
'Unable to decrypt message: missing certificate file');
......@@ -1563,7 +1565,8 @@ sub smime_encrypt {
if ($is_list eq 'list') { #FIXME: Not in case
my $list = Sympa::List->new($email);
my $dummy;
($certfile, $dummy) = tools::smime_find_keys($list, 'encrypt');
($certfile, $dummy) =
Sympa::Tools::SMIME::find_keys($list, 'encrypt');
} else {
my $base =
"$Conf::Conf{'ssl_cert_dir'}/" . tools::escape_chars($email);
......@@ -1724,7 +1727,7 @@ sub smime_sign {
#FIXME
return 1 unless $list;
my ($certfile, $keyfile) = tools::smime_find_keys($list, 'sign');
my ($certfile, $keyfile) = Sympa::Tools::SMIME::find_keys($list, 'sign');
my $signed_msg;
......@@ -1861,7 +1864,7 @@ sub check_smime_signature {
my %certs;
my $signers = Crypt::SMIME::getSigners($self->as_string);
foreach my $cert (@{$signers || []}) {
my $parsed = tools::smime_parse_cert(text => $cert);
my $parsed = Sympa::Tools::SMIME::parse_cert(text => $cert);
next unless $parsed;
next unless $parsed->{'email'}{lc $sender};
......
......@@ -70,7 +70,7 @@ our %cpan_modules = (
},
'Crypt::SMIME' => {
required_version => '0.15',
package_name => 'Crypt-SMIME',
package_name => 'Crypt-SMIME',
'gettext_id' =>
'required to sign, verify, encrypt and decrypt S/MIME messages.',
},
......@@ -93,12 +93,6 @@ our %cpan_modules = (
mandatory => 1,
'gettext_id' => 'used to decode date and time in message headers',
},
'DB_File' => {
required_version => '1.75',
package_name => 'DB_File',
mandatory => 1,
'gettext_id' => 'used for maintaining snapshots of list members',
},
'DBD::ODBC' => {
package_name => 'DBD-ODBC',
'gettext_id' =>
......
......@@ -36,6 +36,7 @@ use Log;
use Sympa::Mail;
use SDM;
use tools;
use Sympa::Tools::SMIME;
use tt2;
use Sympa::User;
......@@ -131,7 +132,7 @@ sub send_global_file {
$data->{'sender'} = $who;
# Sign mode
my $smime_sign = tools::smime_find_keys($robot, 'sign');
my $smime_sign = Sympa::Tools::SMIME::find_keys($robot, 'sign');
$data->{'conf'}{'version'} = $main::Version;
$data->{'from'} = "$data->{'conf'}{'email'}\@$data->{'conf'}{'host'}"
......
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014 GIP RENATER
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Sympa::Tools::DKIM;
use strict;
use warnings;
use English qw(-no_match_vars);
use Conf;
use Log;
sub get_dkim_parameters {
Log::do_log('debug2', '(%s)', @_);
my $that = shift;
my ($robot_id, $list);
if (ref $that eq 'Sympa::List') {
$robot_id = $that->{'domain'};
$list = $that;
} elsif ($that and $that ne '*') {
$robot_id = $that;
} else {
$robot_id = '*';
}
my $data;
my $keyfile;
if ($list) {
# fetch dkim parameter in list context
$data->{'d'} = $list->{'admin'}{'dkim_parameters'}{'signer_domain'};
if ($list->{'admin'}{'dkim_parameters'}{'signer_identity'}) {
$data->{'i'} =
$list->{'admin'}{'dkim_parameters'}{'signer_identity'};
} else {
# RFC 4871 (page 21)
$data->{'i'} = $list->get_list_address('owner'); # -request
}
$data->{'selector'} = $list->{'admin'}{'dkim_parameters'}{'selector'};
$keyfile = $list->{'admin'}{'dkim_parameters'}{'private_key_path'};
} else {
# in robot context
$data->{'d'} = Conf::get_robot_conf($robot_id, 'dkim_signer_domain');
$data->{'i'} =
Conf::get_robot_conf($robot_id, 'dkim_signer_identity');
$data->{'selector'} =
Conf::get_robot_conf($robot_id, 'dkim_selector');
$keyfile = Conf::get_robot_conf($robot_id, 'dkim_private_key_path');
}
return undef
unless defined $data->{'d'}
and defined $data->{'selector'}
and defined $keyfile;
my $fh;
unless (open $fh, '<', $keyfile) {
Log::do_log('err', 'Could not read dkim private key %s: %m',
$keyfile);
return undef;
}
$data->{'private_key'} = do { local $RS; <$fh> };
close $fh;
return $data;
}
# input a msg as string, output the dkim status
sub verifier {
my $msg_as_string = shift;
my $dkim;
Log::do_log('debug', 'DKIM verifier');
unless (eval "require Mail::DKIM::Verifier") {
Log::do_log('err',
"Failed to load Mail::DKIM::verifier perl module, ignoring DKIM signature"
);
return undef;
}
unless ($dkim = Mail::DKIM::Verifier->new()) {
Log::do_log('err', 'Could not create Mail::DKIM::Verifier');
return undef;
}
my $temporary_file = $Conf::Conf{'tmpdir'} . "/dkim." . $PID;
if (!open(MSGDUMP, "> $temporary_file")) {
Log::do_log('err', 'Can\'t store message in file %s',
$temporary_file);
return undef;
}
print MSGDUMP $msg_as_string;
unless (close(MSGDUMP)) {
Log::do_log('err', 'Unable to dump message in temporary file %s',
$temporary_file);
return undef;
}
unless (open(MSGDUMP, "$temporary_file")) {
Log::do_log('err', 'Can\'t read message in file %s', $temporary_file);
return undef;
}
# this documented method is pretty but dont validate signatures, why ?
# $dkim->load(\*MSGDUMP);
while (<MSGDUMP>) {
chomp;
s/\015$//;
$dkim->PRINT("$_\015\012");
}
$dkim->CLOSE;
close(MSGDUMP);
unlink($temporary_file);
foreach my $signature ($dkim->signatures) {
return 1 if ($signature->result_detail eq "pass");
}
return undef;
}
1;
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014 GIP RENATER
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Sympa::Tools::SMIME;
use strict;
use warnings;
use English qw(-no_match_vars);
use Conf;
use Log;
=over
=item find_keys ( $that, $operation )
Find the appropriate S/MIME keys/certs for $operation of $that.
$operation can be:
=over
=item 'sign'
return the preferred signing key/cert
=item 'decrypt'
return a list of possible decryption keys/certs
=item 'encrypt'
return the preferred encryption key/cert
=back
Returnss C<($certs, $keys)>.
For 'sign' and 'encrypt', these are strings containing the absolute filename.
For 'decrypt', these are arrayrefs containing absolute filenames.
=back
=cut
# Old name: tools::smime_find_keys()
sub find_keys {
Log::do_log('debug2', '(%s, %s)', @_);
my $that = shift || '*';
my $operation = shift;
my $dir;
if (ref $that eq 'Sympa::List') {
$dir = $that->{'dir'};
} else {
$dir = $Conf::Conf{'home'} . '/sympa'; #FIXME
}
my (%certs, %keys);
my $ext = ($operation eq 'sign' ? 'sign' : 'enc');
unless (opendir(D, $dir)) {
return undef;
}
while (my $fn = readdir(D)) {
if ($fn =~ /^cert\.pem/) {
$certs{"$dir/$fn"} = 1;
} elsif ($fn =~ /^private_key/) {
$keys{"$dir/$fn"} = 1;
}
}
closedir(D);
foreach my $c (keys %certs) {
my $k = $c;
$k =~ s/\/cert\.pem/\/private_key/;
unless ($keys{$k}) {
Log::do_log('debug3', '%s exists, but matching %s doesn\'t',
$c, $k);
delete $certs{$c};
}
}
foreach my $k (keys %keys) {
my $c = $k;
$c =~ s/\/private_key/\/cert\.pem/;
unless ($certs{$c}) {
Log::do_log('debug3', '%s exists, but matching %s doesn\'t',
$k, $c);
delete $keys{$k};
}
}
my ($certs, $keys);
if ($operation eq 'decrypt') {
$certs = [sort keys %certs];
$keys = [sort keys %keys];
} else {
if ($certs{"$dir/cert.pem.$ext"}) {
$certs = "$dir/cert.pem.$ext";
$keys = "$dir/private_key.$ext";
} elsif ($certs{"$dir/cert.pem"}) {
$certs = "$dir/cert.pem";
$keys = "$dir/private_key";
} else {
Log::do_log('debug3', '%s: no certs/keys found for %s',
$that, $operation);
return undef;
}
}
Log::do_log('debug3', '%s: certs/keys for %s found', $that, $operation);
return ($certs, $keys);
}
BEGIN { eval 'use Crypt::OpenSSL::X509'; }
# IN: hashref:
# file => filename
# text => PEM-encoded cert
# OUT: hashref
# email => email address from cert
# subject => distinguished name
# purpose => hashref
# enc => true if v3 purpose is encryption
# sign => true if v3 purpose is signing
#
# Old name: tools::smime_parse_cert()
sub parse_cert {
Log::do_log('debug3', '(%s => %s)', @_);
my %arg = @_;
## Load certificate
my $x509;
if ($arg{'text'}) {
$x509 = eval { Crypt::OpenSSL::X509->new_from_string($arg{'text'}) };
} elsif ($arg{'file'}) {
$x509 = eval { Crypt::OpenSSL::X509->new_from_file($arg{'file'}) };
} else {
Log::do_log('err', 'Neither "text" nor "file" given');
return undef;
}
unless ($x509) {
Log::do_log('err', 'Cannot parse certificate');
return undef;
}
my %res;
$res{subject} = join '',
map { '/' . $_->as_string } @{$x509->subject_name->entries};
$res{email}{lc($x509->email)} = 1 if $x509->email;
# Check key usage roughy.
my %purposes = $x509->extensions_by_name->{keyUsage}->hash_bit_string;
$res{purpose}->{sign} = $purposes{'Digital Signature'} ? 1 : '';
$res{purpose}->{enc} = $purposes{'Key Encipherment'} ? 1 : '';
return \%res;
}
# NO LONGER USED
# However, this function may be useful because it can extract messages openssl
# can not (e.g. signature part not encoded by BASE64).
sub smime_extract_certs {
my ($mime, $outfile) = @_;
Log::do_log('debug2', '(%s)', $mime->mime_type);
if ($mime->mime_type =~ /application\/(x-)?pkcs7-/) {
my $pipeout;
unless (
open $pipeout,
'|-', $Conf::Conf{openssl}, 'pkcs7', '-print_certs',
'-inform' => 'der',
'-out' => $outfile
) {
Log::do_log('err', 'Unable to run openssl pkcs7: %m');
return 0;
}
print $pipeout $mime->bodyhandle->as_string;
close $pipeout;
my $status = $CHILD_ERROR >> 8;
if ($status) {
Log::do_log('err', 'Openssl pkcs7 returned an error: %s',
$status);
return 0;
}
return 1;
}
}
1;
......@@ -810,116 +810,6 @@ sub get_template_path {
return $dir . '/' . $tpl;
}
sub get_dkim_parameters {
Log::do_log('debug2', '(%s)', @_);
my $that = shift;
my ($robot_id, $list);
if (ref $that eq 'Sympa::List') {
$robot_id = $that->{'domain'};
$list = $that;
} elsif ($that and $that ne '*') {
$robot_id = $that;
} else {
$robot_id = '*';
}
my $data;
my $keyfile;
if ($list) {
# fetch dkim parameter in list context
$data->{'d'} = $list->{'admin'}{'dkim_parameters'}{'signer_domain'};
if ($list->{'admin'}{'dkim_parameters'}{'signer_identity'}) {
$data->{'i'} =
$list->{'admin'}{'dkim_parameters'}{'signer_identity'};
} else {
# RFC 4871 (page 21)
$data->{'i'} = $list->get_list_address('owner'); # -request
}
$data->{'selector'} = $list->{'admin'}{'dkim_parameters'}{'selector'};
$keyfile = $list->{'admin'}{'dkim_parameters'}{'private_key_path'};
} else {
# in robot context
$data->{'d'} = Conf::get_robot_conf($robot_id, 'dkim_signer_domain');
$data->{'i'} =
Conf::get_robot_conf($robot_id, 'dkim_signer_identity');
$data->{'selector'} =
Conf::get_robot_conf($robot_id, 'dkim_selector');
$keyfile = Conf::get_robot_conf($robot_id, 'dkim_private_key_path');
}
return undef
unless defined $data->{'d'}
and defined $data->{'selector'}
and defined $keyfile;
my $fh;
unless (open $fh, '<', $keyfile) {
Log::do_log('err', 'Could not read dkim private key %s: %m',
$keyfile);
return undef;
}
$data->{'private_key'} = do { local $RS; <$fh> };
close $fh;
return $data;
}
# input a msg as string, output the dkim status
sub dkim_verifier {
my $msg_as_string = shift;
my $dkim;
Log::do_log('debug', 'Dkim verifier');
unless (eval "require Mail::DKIM::Verifier") {
Log::do_log('err',
"Failed to load Mail::DKIM::verifier perl module, ignoring DKIM signature"
);
return undef;
}
unless ($dkim = Mail::DKIM::Verifier->new()) {
Log::do_log('err', 'Could not create Mail::DKIM::Verifier');
return undef;
}
my $temporary_file = $Conf::Conf{'tmpdir'} . "/dkim." . $PID;
if (!open(MSGDUMP, "> $temporary_file")) {
Log::do_log('err', 'Can\'t store message in file %s',
$temporary_file);
return undef;
}
print MSGDUMP $msg_as_string;
unless (close(MSGDUMP)) {
Log::do_log('err', 'Unable to dump message in temporary file %s',
$temporary_file);
return undef;
}
unless (open(MSGDUMP, "$temporary_file")) {
Log::do_log('err', 'Can\'t read message in file %s', $temporary_file);
return undef;
}
# this documented method is pretty but dont validate signatures, why ?
# $dkim->load(\*MSGDUMP);
while (<MSGDUMP>) {
chomp;
s/\015$//;
$dkim->PRINT("$_\015\012");
}
$dkim->CLOSE;
close(MSGDUMP);