Merge pull request #1241 from ikedas/issue-1239 by ikedas

S/MIME: Simplify the method to get email addresses in X.509 certificates (#1239)

cpanfile

@@ -204,15 +204,16 @@ feature 'Crypt::Eksblowfish', 'Used to encrypt passwords with the Bcrypt hash al
 };
 
 feature 'x509-auth', 'Required to extract user certificates for SSL clients and S/MIME messages.' => sub {
-    requires 'Crypt::OpenSSL::X509', '>= 1.800.1';
+    # Note: email() for certificate on versions < 1.909 was broken.
+    requires 'Crypt::OpenSSL::X509', '>= 1.909';
 };
 
 feature 'smime', 'Required to sign, verify, encrypt and decrypt S/MIME messages.' => sub {
-    requires 'Convert::ASN1', '>= 0.14';
     requires 'Crypt::SMIME', '>= 0.15';
     # Required to extract user certificates for SSL clients and S/MIME messages.
-    # Note: On versions < 1.808, the value() method for extension was broken.
-    requires 'Crypt::OpenSSL::X509', '>= 1.808';
+    # Note: value() for extension on versions < 1.808 was broken.
+    # Note: email() for certificate on versions < 1.909 was broken.
+    requires 'Crypt::OpenSSL::X509', '>= 1.909';
 };
 
 feature 'csv', 'CSV database driver, required if you include list members, owners or moderators from CSV file.' => sub {

src/cgi/wwsympa.fcgi.in

@@ -50,7 +50,6 @@ use POSIX qw();
 use Time::Local qw();
 use URI;
 use Data::Dumper;    # tentative
-BEGIN { eval 'use Crypt::OpenSSL::X509'; }
 use Sympa;
 use Sympa::Archive;
@@ -87,6 +86,7 @@ use Sympa::Ticket;
 use Sympa::Tools::Data;
 use Sympa::Tools::File;
 use Sympa::Tools::Password;
+use Sympa::Tools::SMIME;
 use Sympa::Tools::Text;
 use Sympa::Tracking;
 use Sympa::User;
@@ -1287,28 +1287,25 @@ while ($query = Sympa::WWW::FastCGI->new) {
     ## RSS does not require user authentication
     unless ($rss) {
-        if (    $Crypt::OpenSSL::X509::VERSION
-            and $ENV{SSL_CLIENT_VERIFY}
-            and $ENV{SSL_CLIENT_VERIFY} eq 'SUCCESS'
+        if ('SUCCESS' eq ($ENV{SSL_CLIENT_VERIFY} // '')
             and $in{'action'} ne 'sso_login') {
             # Get rfc822Name in X.509v3 subjectAltName, otherwise
             # emailAddress attribute in subject DN (the first one of either).
             # Note: Earlier efforts getting attribute such as MAIL, Email in
             # subject DN are no longer supported.
-            my $x509 = eval {
-                Crypt::OpenSSL::X509->new_from_string($ENV{SSL_CLIENT_CERT});
-            };
-            my $email = Sympa::Tools::Text::canonic_email($x509->email)
-                if $x509 and Sympa::Tools::Text::valid_email($x509->email);
+            my $cert =
+                Sympa::Tools::SMIME::parse_cert(text => $ENV{SSL_CLIENT_CERT})
+                // {};
+            my $email = ($cert->{emails} // [])->[0];
             if ($email) {
                 $param->{'user'}{'email'}    = $email;
                 $session->{'email'}          = $email;
                 $param->{'auth_method'}      = 'smime';
                 $session->{'auth'}           = 'x509';
-                $param->{'ssl_client_s_dn'}  = $x509->subject;
-                $param->{'ssl_client_v_end'} = $x509->notAfter;
-                $param->{'ssl_client_i_dn'}  = $x509->issuer;
+                $param->{'ssl_client_s_dn'}  = $cert->{subject};
+                $param->{'ssl_client_v_end'} = $cert->{notAfter};
+                $param->{'ssl_client_i_dn'}  = $cert->{issuer};
                 # Only with Apache+mod_ssl or lighttpd+mod_openssl.
                 $param->{'ssl_cipher_usekeysize'} =
                     $ENV{SSL_CIPHER_USEKEYSIZE};

src/lib/Sympa/Tools/SMIME.pm

@@ -31,47 +31,13 @@ use strict;
 use warnings;
 use English qw(-no_match_vars);
 
+BEGIN { eval 'use Crypt::OpenSSL::X509'; }
+
 use Conf;
-use Sympa::Log;
 use Sympa::Tools::Text;
 
-my $log = Sympa::Log->instance;
-
-=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->syslog('debug2', '(%s, %s)', @_);
     my $that = shift || '*';
     my $operation = shift;
 
@@ -102,8 +68,6 @@ sub find_keys {
         my $k = $c;
         $k =~ s/\/cert\.pem/\/private_key/;
         unless ($keys{$k}) {
-            $log->syslog('debug3', '%s exists, but matching %s doesn\'t',
-                $c, $k);
             delete $certs{$c};
         }
     }
@@ -112,8 +76,6 @@ sub find_keys {
         my $c = $k;
         $c =~ s/\/private_key/\/cert\.pem/;
         unless ($certs{$c}) {
-            $log->syslog('debug3', '%s exists, but matching %s doesn\'t',
-                $k, $c);
             delete $keys{$k};
         }
     }
@@ -130,34 +92,15 @@ sub find_keys {
             $certs = "$dir/cert.pem";
             $keys  = "$dir/private_key";
         } else {
-            $log->syslog('debug3', '%s: no certs/keys found for %s',
-                $that, $operation);
             return undef;
         }
     }
 
-    $log->syslog('debug3', '%s: certs/keys for %s found', $that, $operation);
     return ($certs, $keys);
 }
 
-BEGIN {
-    eval 'use Crypt::OpenSSL::X509';
-    eval 'use Convert::ASN1 qw()';
-}
-
-# 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->syslog('debug3', '(%s => %s)', @_);
     my %arg = @_;
 
     return undef unless $Crypt::OpenSSL::X509::VERSION;
@@ -169,27 +112,23 @@ sub parse_cert {
     } elsif ($arg{'file'}) {
         $x509 = eval { Crypt::OpenSSL::X509->new_from_file($arg{'file'}) };
     } else {
-        $log->syslog('err', 'Neither "text" nor "file" given');
-        return undef;
+        die 'bug in logic. Ask developer';
     }
     unless ($x509) {
-        $log->syslog('err', 'Cannot parse certificate');
         return undef;
     }
 
     my %res;
-    $res{subject} = join '',
-        map { '/' . $_->as_string } @{$x509->subject_name->entries};
-
-    # Get email(s).
-    # The subjectAltName extension is used. The email() method that gives
-    # single address may be used for workaround on malformed certificates.
-    my @emails = _get_subjectAltName($x509, 1);    # rfc822Name [1]
-    unless (@emails) {
-        @emails = ($x509->email) if $x509->email;
-    }
-    $res{email} =
-        {map { (Sympa::Tools::Text::canonic_email($_) => 1) } @emails};
+    $res{subject}  = $x509->subject;
+    $res{notAfter} = $x509->notAfter;
+    $res{issuer}   = $x509->issuer;
+
+    my @emails =
+        map  { Sympa::Tools::Text::canonic_email($_) }
+        grep { Sympa::Tools::Text::valid_email($_) }
+        split / +/, ($x509->email // '');
+    $res{emails} = [@emails];
+    $res{email} = {map { ($_ => 1) } @emails};
 
     # Check key usage roughy.
     my %purposes = $x509->extensions_by_name->{keyUsage}->hash_bit_string;
@@ -198,81 +137,106 @@ sub parse_cert {
     return \%res;
 }
 
-sub _get_subjectAltName {
-    my $x509        = shift;
-    my $context_num = shift;
-
-    my $extensions = $x509->extensions_by_name;
-
-    return
-            unless $extensions
-        and $extensions->{subjectAltName}
-        and $extensions->{subjectAltName}->value =~ /\A#([0-9A-F]+)\z/;
-
-    my $bin = pack 'H*', $1;
-    my ($tag, $tnum, $len);
-
-    ($tag, $tnum, $bin, $len) = _parse_asn1_single_value($bin);
-    return
-        unless defined $tag
-        and ($tag & ~Convert::ASN1::ASN_CONSTRUCTOR()) ==
-        Convert::ASN1::ASN_SEQUENCE();
-
-    my @ret;
-    while (length $bin) {
-        my $val;
-        ($tag, $tnum, $val, $len) = _parse_asn1_single_value($bin);
-        last unless defined $tag;
-        $bin = substr $bin, $len;
-        next if $tag == 0 and length $val == 0;
-
-        push @ret, $val
-            if ($tag & 0xC0) == Convert::ASN1::ASN_CONTEXT()
-            and $tnum == $context_num;
-    }
-    return @ret;
-}
+1;
+__END__
 
-sub _parse_asn1_single_value {
-    my $bin = shift;
+=encoding utf-8
 
-    my ($tb, $tag, $tnum) =
-        Convert::ASN1::asn_decode_tag2(substr $bin, 0, 10);
-    return unless defined $tb;
-    my ($lb, $len) = Convert::ASN1::asn_decode_length(substr $bin, $tb, 10);
-    return unless $tb + $lb + $len <= length $bin;
+=head1 NAME
 
-    return ($tag, $tnum, substr($bin, $tb + $lb, $len), $tb + $lb + $len);
-}
+Sympa::Tools::SMIME - Tools for S/MIME messages and X.509 certificates
 
-# 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->syslog('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->syslog('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->syslog('err', 'Openssl pkcs7 returned an error: %s',
-                $status);
-            return 0;
-        }
-        return 1;
-    }
-}
+=head1 DESCRIPTION
 
-1;
+=head2 Functions
+
+=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.
+
+=item parse_cert ( C<text>|C<file> =E<gt> $content )
+
+Parses X.509 certificate.
+
+Options:
+
+=over
+
+=item C<file> =E<gt> $filename
+
+=item C<text> =E<gt> $text
+
+Specifies PEM-encoded certificate.
+
+=back
+
+Returns a hashref containing these items:
+
+=over
+
+=item {email}
+
+hashref with email addresses from cert as keys
+
+=item {emails}
+
+arrayref with email addresses from cert.
+This was added on Sympa 6.2.67b.
+
+=item {subject}
+
+distinguished name
+
+=item {purpose}
+
+hashref containing:
+
+=over
+
+=item {enc}
+
+true if v3 purpose is encryption
+
+=item {sign}
+
+true if v3 purpose is signing
+
+=back
+
+=item TBD.
+
+=back
+
+If parsing failed, returns C<undef>.
+
+=back
+
+=head1 HISTORY
+
+TBD.
+
+=cut