Crypt-SMIME-0.31/0000755000175000017500000000000014764200436011552 5ustar phophoCrypt-SMIME-0.31/t/0000755000175000017500000000000014764200436012015 5ustar phophoCrypt-SMIME-0.31/t/pod-coverage.t0000644000175000017500000000047014571250325014554 0ustar phopho#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok( { also_private => [ qr/^x509_/, qr/^FORMAT_/, qr/^constant$/ # Generated by ExtUtils::Constant ] }); Crypt-SMIME-0.31/t/pod.t0000644000175000017500000000021414571250325012757 0ustar phopho#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Crypt-SMIME-0.31/t/03-chained-certs.t0000644000175000017500000001703514571250325015137 0ustar phopho# -*- perl -*- use strict; use warnings; use ExtUtils::PkgConfig (); use File::Spec; use File::Temp qw(tempfile); use Test::More; use Test::Exception; use Config; # Create the following certificate tree: # # + The root CA (self-signed) # | # `-+ An intermediate CA #1 # | # `-+ An intermediate CA #2 # | # `-- An user # # Then do the following: # # 1. Make a mail signed by an user private key and let it contain # certificates of two intermediate CAs. # # 2. Verify the mail with only the root CA certificate and its # key. Can we prove the mail is actually trustable? my (%key, %csr, %crt); do { my $OPENSSL = do { if (defined(my $prefix = ExtUtils::PkgConfig->variable('openssl', 'prefix'))) { my $OPENSSL = $prefix . '/bin/openssl' . $Config{exe_ext}; if (-x $OPENSSL) { diag "Using `$OPENSSL' to generate a keypair"; $OPENSSL; } else { plan skip_all => q{Executable `openssl' was not found}; } } else { plan skip_all => q{No package `openssl' found}; } }; my $DEVNULL = File::Spec->devnull(); # Create the root CA. do { my ($conf_fh, $conf_file) = tempfile(UNLINK => 1); print {$conf_fh} << 'EOF'; [ req ] distinguished_name = req_distinguished_name attributes = req_attributes req_extensions = v3_ca prompt = no [ req_distinguished_name ] C = JP ST = Some-State L = Some-Locality O = Crypt::SMIME OU = The Root CA CN = ROOT [ req_attributes ] [ v3_ca ] basicConstraints = CA:true EOF close $conf_fh; (undef, $key{root}) = tempfile(UNLINK => 1); (undef, $csr{root}) = tempfile(UNLINK => 1); (undef, $crt{root}) = tempfile(UNLINK => 1); system(qq{$OPENSSL genrsa -out $key{root} >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL req -new -key $key{root} -out $csr{root} -config $conf_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL x509 -in $csr{root} -out $crt{root} -req -signkey $key{root} -set_serial 1 -extfile $conf_file -extensions v3_ca >$DEVNULL 2>&1}) and die; }; # Create an intermediate CA #1. do { my ($conf_fh, $conf_file) = tempfile(UNLINK => 1); print {$conf_fh} << 'EOF'; [ req ] distinguished_name = req_distinguished_name attributes = req_attributes req_extensions = v3_ca prompt = no [ req_distinguished_name ] C = JP ST = Some-State L = Some-Locality O = Crypt::SMIME OU = An intermediate CA No.1 CN = INTERMED-1 [ req_attributes ] [ v3_ca ] basicConstraints = CA:true EOF close $conf_fh; (undef, $key{intermed_1}) = tempfile(UNLINK => 1); (undef, $csr{intermed_1}) = tempfile(UNLINK => 1); (undef, $crt{intermed_1}) = tempfile(UNLINK => 1); system(qq{$OPENSSL genrsa -out $key{intermed_1} >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL req -new -key $key{intermed_1} -out $csr{intermed_1} -config $conf_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL x509 -in $csr{intermed_1} -out $crt{intermed_1} -req -CA $crt{root} -CAkey $key{root} -set_serial 1 -extfile $conf_file -extensions v3_ca >$DEVNULL 2>&1}) and die; }; # Create an intermediate CA #2. do { my ($conf_fh, $conf_file) = tempfile(UNLINK => 1); print {$conf_fh} << 'EOF'; [ req ] distinguished_name = req_distinguished_name attributes = req_attributes req_extensions = v3_ca prompt = no [ req_distinguished_name ] C = JP ST = Some-State L = Some-Locality O = Crypt::SMIME OU = An intermediate CA No.2 CN = INTERMED-2 [ req_attributes ] [ v3_ca ] basicConstraints = CA:true EOF close $conf_fh; (undef, $key{intermed_2}) = tempfile(UNLINK => 1); (undef, $csr{intermed_2}) = tempfile(UNLINK => 1); (undef, $crt{intermed_2}) = tempfile(UNLINK => 1); system(qq{$OPENSSL genrsa -out $key{intermed_2} >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL req -new -key $key{intermed_2} -out $csr{intermed_2} -config $conf_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL x509 -in $csr{intermed_2} -out $crt{intermed_2} -req -CA $crt{intermed_1} -CAkey $key{intermed_1} -set_serial 1 -extfile $conf_file -extensions v3_ca >$DEVNULL 2>&1}) and die; }; # Create an user. do { my ($conf_fh, $conf_file) = tempfile(UNLINK => 1); print {$conf_fh} << 'EOF'; [ req ] distinguished_name = req_distinguished_name attributes = req_attributes prompt = no [ req_distinguished_name ] C = JP ST = Some-State L = Some-Locality O = Crypt::SMIME OU = An user CN = USER [ req_attributes ] EOF close $conf_fh; (undef, $key{user}) = tempfile(UNLINK => 1); (undef, $csr{user}) = tempfile(UNLINK => 1); (undef, $crt{user}) = tempfile(UNLINK => 1); system(qq{$OPENSSL genrsa -out $key{user} >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL req -new -key $key{user} -out $csr{user} -config $conf_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL x509 -in $csr{user} -out $crt{user} -req -CA $crt{intermed_2} -CAkey $key{intermed_2} -set_serial 1 >$DEVNULL 2>&1}) and die; }; }; sub key { my $who = shift; local $/; open my $fh, '<', $key{$who} or die $!; return scalar <$fh>; }; sub crt { my $who = shift; local $/; open my $fh, '<', $crt{$who} or die $!; return scalar <$fh>; } my $plain = q{From: alice@example.org To: bob@example.org Subject: Crypt::SMIME test This is a test mail. Please ignore... }; $plain =~ s/\r?\n|\r/\r\n/g; my $verified = q{Subject: Crypt::SMIME test This is a test mail. Please ignore... }; $verified =~ s/\r?\n|\r/\r\n/g; # ----------------------------------------------------------------------------- plan tests => 15; use_ok('Crypt::SMIME'); my $signed = do { my $SMIME; lives_ok { $SMIME = Crypt::SMIME->new } 'new'; lives_ok { $SMIME->setPrivateKey(key('user'), crt('user')) } 'setPrivateKey(USER)'; lives_ok { $SMIME->setPublicKey(crt('intermed_1')."\n".crt('intermed_2')) } 'setPublicKey(INTERMED-1 & INTERMED-2)'; my $tmp; lives_ok { $tmp = $SMIME->sign($plain) } 'sign($plain)'; $tmp; }; sub smime_check_ok { my ( $case, %opts ) = @_; my $SMIME = Crypt::SMIME->new; lives_ok { $SMIME->setPublicKey(crt('root')) } 'setPublicKey(ROOT)'; my $checked; if( defined $opts{'add_time'} ) { my $time = time + $opts{'add_time'}; lives_ok { $SMIME->setAtTime($time) } "set verify timestamp to ".localtime($time); } if ($opts{'expect_failure'}) { dies_ok { $checked = $SMIME->check($signed) }, 'check must fail with exception'; } else { lives_ok { $checked = $SMIME->check($signed) } 'check'; is($checked, $verified, '$verified eq check(sign($plain))'); } } smime_check_ok('with default parameters'); smime_check_ok('with timestamp of tomorrow', 'add_time' => 60*60*24 ); smime_check_ok('with timestamp of in one year', 'add_time' => 60*60*24*365, 'expect_failure' => 1); Crypt-SMIME-0.31/t/manifest.t0000644000175000017500000000141114571250325014003 0ustar phopho#!perl use strict; use warnings; use ExtUtils::Manifest qw(fullcheck); use Test::More tests => 2; my ($missing, $extra) = do { local $ExtUtils::Manifest::Quiet = 1; fullcheck(); }; # Check for missing files in every case. ok !scalar @$missing, 'No missing files that are in MANIFEST' or do { diag "No such file: $_" foreach @$missing; }; # Check for additional files - but not on Windows. # See https://rt.cpan.org/Public/Bug/Display.html?id=124130 subtest 'extra files' => sub { if ($^O eq 'MSWin32') { plan skip_all => 'Not supported on Windows'; } else { plan tests => 1; } ok !scalar @$extra, 'No extra files that aren\'t in MANIFEST' or do { diag "Not in MANIFEST: $_" foreach @$extra; }; }; Crypt-SMIME-0.31/t/boilerplate.t0000644000175000017500000000231014571250325014476 0ustar phopho#!perl -T use strict; use warnings; use Test::More tests => 3; sub not_in_file_ok { my ($filename, %regex) = @_; open my $fh, "<", $filename or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } module_boilerplate_ok('SMIME.pl'); Crypt-SMIME-0.31/t/04-taint.t0000644000175000017500000002526714571307167013563 0ustar phopho#!perl -T use strict; use warnings; use ExtUtils::PkgConfig (); use File::Spec; use File::Temp qw(tempfile); use Test::More; use Test::Exception; use Config; BEGIN { eval 'use Test::Taint 1.06'; plan skip_all => 'Test::Taint 1.06 required for testing behaviors on tainted inputs' if $@; }; BEGIN { eval 'use Taint::Util 0.08 qw(untaint)'; plan skip_all => 'Taint::Util 0.08 required for testing behaviors on tainted inputs' if $@; }; my ($key, $crt); do { # What can we do other than this...? untaint $ENV{PATH}; my $OPENSSL = do { if (defined(my $prefix = ExtUtils::PkgConfig->variable('openssl', 'prefix'))) { my $OPENSSL = $prefix . '/bin/openssl' . $Config{exe_ext}; if (-x $OPENSSL) { untaint $OPENSSL; diag "Using `$OPENSSL' to generate a keypair"; $OPENSSL; } else { plan skip_all => q{Executable `openssl' was not found}; } } else { plan skip_all => q{No package `openssl' found}; } }; my ($conf_fh, $conf_file) = tempfile(UNLINK => 1); print {$conf_fh} <<'EOF'; [ req ] distinguished_name = req_distinguished_name attributes = req_attributes prompt = no [ req_distinguished_name ] C = AU ST = Some-State L = Test Locality O = Organization Name OU = Organizational Unit Name CN = Common Name emailAddress = test@email.address [ req_attributes ] EOF close $conf_fh; my $DEVNULL = File::Spec->devnull(); my (undef, $key_file) = tempfile(UNLINK => 1); my (undef, $csr_file) = tempfile(UNLINK => 1); my (undef, $crt_file) = tempfile(UNLINK => 1); system(qq{$OPENSSL genrsa -out $key_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL req -new -key $key_file -out $csr_file -config $conf_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL x509 -in $csr_file -out $crt_file -req -signkey $key_file -set_serial 1 >$DEVNULL 2>&1}) and die $!; $key = do { local $/; open my $fh, '<', $key_file or die $!; scalar <$fh>; }; $crt = do { local $/; open my $fh, '<', $crt_file or die $!; scalar <$fh>; }; }; my $plain = q{From: alice@example.org To: bob@example.org Subject: Crypt::SMIME test This is a test mail. Please ignore... }; $plain =~ s/\r?\n|\r/\r\n/g; my $verify = q{Subject: Crypt::SMIME test This is a test mail. Please ignore... }; $verify =~ s/\r?\n|\r/\r\n/g; # ----------------------------------------------------------------------------- plan tests => 7; use_ok('Crypt::SMIME'); taint_checking_ok(); subtest 'Untainted' => sub { plan tests => 20; my $smime = Crypt::SMIME->new(); untaint $key; untaint $crt; lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair'; lives_ok {$smime->setPublicKey($crt)} 'Set un untainted public key'; lives_ok {$smime->setPublicKey([$crt])} 'Set un untainted public key'; my $signed; untaint $plain; lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message'; untainted_ok $signed, 'The signed message shall be untainted'; lives_and { ok $smime->isSigned($signed) } 'isSigned() on an untainted signed message shall succeed'; my $verified; lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message'; untainted_ok $verified, 'The verified message shall be untainted'; lives_ok { $smime->setAtTime(time); $verified = $smime->check($signed); } 'Verify an untainted message with untainted parameters'; untainted_ok $verified, 'The verified message shall still be untainted'; my $encrypted; lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt an untainted message'; untainted_ok $encrypted, 'The encrypted message shall be untainted'; lives_and { ok $smime->isEncrypted($encrypted); } 'isEncrypted() on an untainted encrypted message shall succeed'; my $decrypted; lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt an untainted message'; untainted_ok $decrypted, 'The decrypted message shall be untainted'; is $decrypted, $verify, 'The decrypted message matches to the original'; my $certs_ref; lives_ok {$certs_ref = Crypt::SMIME::extractCertificates($signed)} 'Extract certificates from an untainted message'; untainted_ok_deeply $certs_ref, 'The extracted certificates shall be untainted'; lives_ok {$certs_ref = Crypt::SMIME::getSigners($signed)} 'Extract signer certificates from an untainted message'; untainted_ok_deeply $certs_ref, 'The extracted certificates shall be untainted'; }; subtest 'Tainted keypair' => sub { plan tests => 18; my $smime = Crypt::SMIME->new(); taint $key; taint $crt; lives_ok {$smime->setPrivateKey($key, $crt)} 'Set a tainted keypair'; untaint $crt; lives_ok {$smime->setPublicKey($crt)} 'Set un untainted public key'; lives_ok {$smime->setPublicKey([$crt])} 'Set un untainted public key'; untainted_ok $smime, 'The context itself is not tainted'; my $signed; untaint $plain; lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message'; tainted_ok $signed, 'The signed message shall be tainted'; my $verified; untaint $signed; lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message'; untainted_ok $verified, 'The verified message shall be untainted'; my $encrypted; lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt an untainted message'; untainted_ok $encrypted, 'The encrypted message shall be untainted'; lives_and { ok $smime->isEncrypted($encrypted); } 'isEncrypted() on an untainted encrypted message shall succeed'; my $decrypted; lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt an untainted message'; tainted_ok $decrypted, 'The decrypted message shall be tainted'; is $decrypted, $verify, 'The decrypted message matches to the original'; my $certs_ref; taint $signed; lives_ok {$certs_ref = Crypt::SMIME::extractCertificates($signed)} 'Extract certificates from a tainted message'; tainted_ok_deeply $certs_ref, 'The extracted certificates shall be tainted'; lives_ok {$certs_ref = Crypt::SMIME::getSigners($signed)} 'Extract signer certificates from an tainted message'; tainted_ok_deeply $certs_ref, 'The extracted certificates shall be tainted'; }; subtest 'Tainted plain text' => sub { plan tests => 13; my $smime = Crypt::SMIME->new(); untaint $key; untaint $crt; lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair'; lives_ok {$smime->setPublicKey($crt)} 'Set an untainted public key'; lives_ok {$smime->setPublicKey([$crt])} 'Set an untainted public key'; my $signed; taint $plain; lives_ok {$signed = $smime->sign($plain)} 'Sign a tainted message'; tainted_ok $signed, 'The signed message shall be tainted'; my $verified; lives_ok {$verified = $smime->check($signed)} 'Verify a tainted message'; tainted_ok $verified, 'The verified message shall be tainted (because we haven\'t verified the cleanliness of message itself)'; my $encrypted; lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt a tainted message'; tainted_ok $encrypted, 'The encrypted message shall be tainted'; lives_and { ok $smime->isEncrypted($encrypted); } 'isEncrypted() on a tainted encrypted message shall succeed'; my $decrypted; lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt a tainted message'; tainted_ok $decrypted, 'The decrypted message shall be tainted'; is $decrypted, $verify, 'The decrypted message matches to the original'; }; subtest 'Tainted public keys' => sub { plan tests => 20; my $smime = Crypt::SMIME->new(); untaint $key; untaint $crt; lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair'; taint $crt; lives_ok {$smime->setPublicKey($crt)} 'Set a tainted public key'; lives_ok {$smime->setPublicKey([$crt])} 'Set a tainted public key'; my $signed; untaint $plain; lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message'; tainted_ok $signed, 'The signed message shall be tainted (because we signed it with a tainted key)'; my $verified; untaint $signed; lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message'; tainted_ok $verified, 'The verified message shall be tainted (because we verified it with a tainted key)'; my $encrypted; lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt an untainted message'; tainted_ok $encrypted, 'The encrypted message shall be tainted (because we encrypted it with a tainted key)'; lives_and { ok $smime->isEncrypted($encrypted); } 'isEncrypted() on a tainted encrypted message shall succeed'; my $decrypted; lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt a tainted message'; tainted_ok $decrypted, 'The decrypted message shall be tainted'; is $decrypted, $verify, 'The decrypted message matches to the original'; lives_ok {$smime->setPublicKeyStore()} 'Load the default public key store'; lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message'; tainted_ok $signed, 'The signed message shall be tainted (because we haven\'t removed our tainted key)'; lives_ok {$smime->setPublicKey([])} 'Clear the public key store'; lives_ok {$smime->setPublicKeyStore()} 'Load the default public key store'; lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message'; untainted_ok $signed, 'The signed message shall be untainted now'; }; subtest 'Tainted verification parameters' => sub { plan tests => 9; my $smime = Crypt::SMIME->new(); untaint $key; untaint $crt; lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair'; lives_ok {$smime->setPublicKey($crt)} 'Set an untainted public key'; lives_ok {$smime->setPublicKey([$crt])} 'Set an untainted public key'; my $signed; untaint $plain; lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message'; untainted_ok $signed, 'The signed message shall be untainted'; my $verified; lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message'; untainted_ok $verified, 'The verified message shall be untainted'; lives_ok { my $time = time; taint $time; $smime->setAtTime($time); $verified = $smime->check($signed); } 'Verify an untainted message with tainted parameters'; tainted_ok $verified, 'The verified message shall be tainted'; }; Crypt-SMIME-0.31/t/02-smime.more.t0000644000175000017500000001223614571250325014476 0ustar phopho# -*- perl -*- use strict; use warnings; use ExtUtils::PkgConfig (); use File::Spec; use File::Temp qw(tempfile); use Test::Exception; use Test::More; use Config; my ($key, $crt); do { my $OPENSSL = do { if (defined(my $prefix = ExtUtils::PkgConfig->variable('openssl', 'prefix'))) { my $OPENSSL = $prefix . '/bin/openssl' . $Config{exe_ext}; if (-x $OPENSSL) { diag "Using `$OPENSSL' to generate a keypair"; $OPENSSL; } else { plan skip_all => q{Executable `openssl' was not found}; } } else { plan skip_all => q{No package `openssl' found}; } }; my ($conf_fh, $conf_file) = tempfile(UNLINK => 1); print {$conf_fh} <<'EOF'; [ req ] distinguished_name = req_distinguished_name attributes = req_attributes prompt = no [ req_distinguished_name ] C = AU ST = Some-State L = Test Locality O = Organization Name OU = Organizational Unit Name CN = Common Name emailAddress = test@email.address [ req_attributes ] EOF close $conf_fh; my $DEVNULL = File::Spec->devnull(); my (undef, $key_file) = tempfile(UNLINK => 1); my (undef, $csr_file) = tempfile(UNLINK => 1); my (undef, $crt_file) = tempfile(UNLINK => 1); system(qq{$OPENSSL genrsa -out $key_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL req -new -key $key_file -out $csr_file -config $conf_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL x509 -in $csr_file -out $crt_file -req -signkey $key_file -set_serial 1 >$DEVNULL 2>&1}) and die $!; $key = do { local $/; open my $fh, '<', $key_file or die $!; scalar <$fh>; }; $crt = do { local $/; open my $fh, '<', $crt_file or die $!; scalar <$fh>; }; }; # ----------------------------------------------------------------------------- plan tests => 18; use_ok('Crypt::SMIME', ':constants'); my $password = ''; my $src_mime = "Content-Type: text/plain\r\n" . "Subject: S/MIME test.\r\n" . "From: alice\@example.com\r\n" . "To: bob\@example.org\r\n" . "\r\n" . "test message.\r\n"; my $verify = "Content-Type: text/plain\r\n" . "Subject: S/MIME test.\r\n" . "\r\n" . "test message.\r\n"; my $verify_header = "Subject: S/MIME test.\r\n" . "From: alice\@example.com\r\n" . "To: bob\@example.org\r\n"; my $signed; my $encrypted; { # smime-sign. my $smime = Crypt::SMIME->new(); ok($smime, "new instance of Crypt::SMIME"); $smime->setPrivateKey($key, $crt, $password); $signed = $smime->sign($src_mime); # $src_mimeはMIMEメッセージ文字列 ok($signed, 'got anything from $smime->sign'); my @lf = $signed=~/\n/g; my @crlf = $signed=~/\r\n/g; is(scalar@crlf,scalar@lf,'all \n in signed are part of \r\n'); note($signed); my @certs = @{ Crypt::SMIME::extractCertificates($signed, FORMAT_SMIME()) }; is scalar @certs, 1, 'the signed message includes one certificate'; my @signers = @{ Crypt::SMIME::getSigners($signed, FORMAT_SMIME()) }; is_deeply \@signers, \@certs, '...which is in fact the signer of the message'; # prepare/sign-only my ($prepared,$header) = $smime->prepareSmimeMessage($src_mime); is($prepared,$verify,"prepared mime message"); is($header,$verify_header,"outer headers of prepared mime message"); ok(index($signed,$prepared)>=0, 'prepared message appears in signed message too'); ok(index($signed,$header)>=0, 'outer headers of prepared message is apprers in signed message too'); my $signed_only = $smime->signonly($src_mime); ok($signed_only, 'got anything from $smime->signonly'); note($signed_only); @lf = $signed_only=~/\n/g; @crlf = $signed_only=~/\r\n/g; is(scalar@crlf,scalar@lf,'all \n in signed_only are part of \r\n'); } { # smime-encrypt. my $smime = Crypt::SMIME->new(); $smime->setPublicKey($crt); $encrypted = $smime->encrypt($signed); ok($encrypted, 'got anything from $smime->encrypt'); } { # smime-decrypt. my $smime = Crypt::SMIME->new(); $smime->setPrivateKey($key, $crt, $password); my $decrypted = $smime->decrypt($encrypted); ok($decrypted, 'got anything from $smime->decrypt'); # and verify. dies_ok { $smime->check($decrypted); } 'verification fails due to empty pubkey store'; lives_and { is $smime->check($decrypted, NO_CHECK_CERTIFICATE()), $verify; } 'skip verification of certificate chain'; $smime->setPublicKey($crt); is($smime->check($decrypted),$verify, 'verify result of decrypt.'); } subtest 'Bug #124035' => sub { # https://rt.cpan.org/Public/Bug/Display.html?id=124035 plan tests => 1; my $smime = Crypt::SMIME->new(); my $msg = qq{Content-Type: multipart/signed; micalg=sha1;\r\n} . qq{ boundary="8323329-949354117-1422908037=:4488"\r\n} . qq{ protocol="application/pkcs7-signature";\r\n} . qq{\r\n} . qq{...\r\n}; ok($smime->isSigned($msg)); }; Crypt-SMIME-0.31/t/00-load.t0000644000175000017500000000022514571250325013333 0ustar phopho#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Crypt::SMIME' ); } diag( "Testing Crypt::SMIME $Crypt::SMIME::VERSION, Perl $], $^X" ); Crypt-SMIME-0.31/t/01-smime.t0000644000175000017500000001023714571250325013533 0ustar phopho# -*- perl -*- use strict; use warnings; use ExtUtils::PkgConfig (); use File::Spec; use File::Temp qw(tempfile); use Test::More; use Test::Exception; use Config; my (%key, %csr, %crt, %p12); do { my $OPENSSL = do { if (defined(my $prefix = ExtUtils::PkgConfig->variable('openssl', 'prefix'))) { my $OPENSSL = $prefix . '/bin/openssl' . $Config{exe_ext}; if (-x $OPENSSL) { diag "Using `$OPENSSL' to generate a keypair"; $OPENSSL; } else { plan skip_all => q{Executable `openssl' was not found}; } } else { plan skip_all => q{No package `openssl' found}; } }; my ($conf_fh, $conf_file) = tempfile(UNLINK => 1); print {$conf_fh} <<'EOF'; [ req ] distinguished_name = req_distinguished_name attributes = req_attributes prompt = no [ req_distinguished_name ] C = AU ST = Some-State L = Test Locality O = Organization Name OU = Organizational Unit Name CN = Common Name emailAddress = test@email.address [ req_attributes ] EOF close $conf_fh; my $DEVNULL = File::Spec->devnull(); foreach my $i (1 .. 2) { (undef, $key{$i}) = tempfile(UNLINK => 1); (undef, $csr{$i}) = tempfile(UNLINK => 1); (undef, $crt{$i}) = tempfile(UNLINK => 1); (undef, $p12{$i}) = tempfile(UNLINK => 1); system(qq{$OPENSSL genrsa -out $key{$i} >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL req -new -key $key{$i} -out $csr{$i} -config $conf_file >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL x509 -in $csr{$i} -out $crt{$i} -req -signkey $key{$i} -set_serial $i >$DEVNULL 2>&1}) and die $!; system(qq{$OPENSSL pkcs12 -export -descert -out $p12{$i} -inkey $key{$i} -in $crt{$i} -passout pass:Secret123 >$DEVNULL 2>&1}) and die $!; } }; sub key { my $i = shift; local $/; open my $fh, '<', $key{$i} or die $!; return scalar <$fh>; } sub crt { my $i = shift; local $/; open my $fh, '<', $crt{$i} or die $!; return scalar <$fh>; } sub p12 { my $i = shift; local $/; open my $fh, '<', $p12{$i} or die $!; binmode $fh; return scalar <$fh>; } my $plain = q{From: alice@example.org To: bob@example.org Subject: Crypt::SMIME test Content-Type: text/plain This is a test mail. Please ignore... }; $plain =~ s/\r?\n|\r/\r\n/g; my $verify = q{Subject: Crypt::SMIME test Content-Type: text/plain This is a test mail. Please ignore... }; $verify =~ s/\r?\n|\r/\r\n/g; #----------------------- plan tests => 25; use_ok('Crypt::SMIME'); my $smime; ok($smime = Crypt::SMIME->new, 'new'); ok($smime->setPrivateKey(key(1), crt(1)), 'setPrivateKey (without passphrase)'); dies_ok {$smime->sign} 'sign undef'; dies_ok {$smime->sign(\123)} 'sign ref'; dies_ok {$smime->signonly} 'signonly undef'; dies_ok {$smime->signonly(\123)} 'signonly ref'; dies_ok {$smime->encrypt} 'encrypt undef'; dies_ok {$smime->encrypt(\123)} 'encrypt ref'; dies_ok {$smime->isSigned} 'isSigned undef'; dies_ok {$smime->isSigned(\123)} 'isSigned ref'; dies_ok {$smime->isEncrypted} 'isEncrypted undef'; dies_ok {$smime->isEncrypted(\123)} 'isEncrypted ref'; my $signed; ok($signed = $smime->sign($plain), 'sign'); ok($smime->isSigned($signed), 'signed'); ok($smime->setPublicKey(crt(1)), 'setPublicKey (one key)'); my $checked; ok($checked = $smime->check($signed), 'check'); is($checked, $verify, '$verify eq check(sign($plain))'); ok($smime->setPublicKey([crt(1), crt(2)]), 'setPublicKey (two keys)'); my $encrypted; ok($encrypted = $smime->encrypt($plain), 'encrypt'); ok($smime->isEncrypted($encrypted), 'isEncrypted'); my $decrypted; ok($decrypted = $smime->decrypt($encrypted), 'decrypt (by sender\'s key)'); is($decrypted, $verify, '$plain eq decrypt(encrypt($plain))'); $smime->setPrivateKey(key(2), crt(2)); ok($decrypted = $smime->decrypt($encrypted), 'decrypt (by recipient\'s key)'); $smime->setPrivateKeyPkcs12(p12(2), 'Secret123'); ok($decrypted = $smime->decrypt($encrypted), 'decrypt (by recipient\'s PKCS12 key)'); 1; Crypt-SMIME-0.31/MANIFEST0000644000175000017500000000070014764200436012700 0ustar phophoChanges lib/SMIME.pm lib/SMIME/JA.pod Makefile.PL MANIFEST This list of files MANIFEST.SKIP README SMIME.mlpod SMIME.pl SMIME.pod SMIME.xs t/00-load.t t/01-smime.t t/02-smime.more.t t/03-chained-certs.t t/04-taint.t t/boilerplate.t t/manifest.t t/pod-coverage.t t/pod.t typemap META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Crypt-SMIME-0.31/Makefile.PL0000644000175000017500000001207014600157132013515 0ustar phophouse strict; use warnings; use ExtUtils::Constant 0.23 qw(WriteConstants autoload); use ExtUtils::MakeMaker qw(WriteMakefile); # Work around a problem in ExtUtils::Constant::ProxySubs which # generates code not working with perl<5.14. # https://rt.cpan.org/Public/Bug/Display.html?id=124074 my $USE_PROXYSUBS = $^V gt v5.14.0; my $CAT = $^O eq 'MSWin32' ? 'type' : 'cat'; my $SEP = $^O eq 'MSWin32' ? '' : '"'; do { open my $fh, '>', 'const-autoload.inc' or die $!; if (!$USE_PROXYSUBS) { print {$fh} "use Carp qw(croak);\n"; print {$fh} autoload('Crypt::SMIME'), "\n"; } }; WriteMakefile( NAME => 'Crypt::SMIME', AUTHOR => 'Ymirlink ', VERSION_FROM => 'SMIME.pl', ABSTRACT => 'S/MIME message signing, verification, encryption and decryption', LICENSE => 'perl_5', PL_FILES => {}, CONFIGURE_REQUIRES => { 'ExtUtils::CChecker' => 0, 'ExtUtils::Constant' => '0.23', 'ExtUtils::MakeMaker' => 0, 'ExtUtils::PkgConfig' => 0, }, PREREQ_PM => { 'XSLoader' => 0, }, BUILD_REQUIRES => { 'ExtUtils::PkgConfig' => 0, 'Test::Exception' => 0, 'Test::More' => 0, }, CONFIGURE => sub { require ExtUtils::CChecker; require ExtUtils::PkgConfig; local $| = 1; my $cc = ExtUtils::CChecker->new(); print 'checking for gettimeofday... '; my $HAVE_GETTIMEOFDAY = $cc->try_compile_run(<<'EOF'); #include int main(int argc, char* argv[]) { struct timeval tv; gettimeofday(&tv, (struct timezone*)0); return 0; } EOF my $HAVE_SYS_TIME_H = $HAVE_GETTIMEOFDAY; print ($HAVE_GETTIMEOFDAY ? "yes\n" : "no\n"); print 'checking for time... '; my $HAVE_TIME = $cc->try_compile_run(<<'EOF'); #include int main(int argc, char* argv[]) { time_t t; t = time((time_t*)0); return 0; } EOF my $HAVE_TIME_H = $HAVE_TIME; print ($HAVE_TIME ? "yes\n" : "no\n"); my ($LIBCRYPTO_CFLAGS, $LIBCRYPTO_LIBS) = do { if (exists $ENV{LIBCRYPTO_CFLAGS} && exists $ENV{LIBCRYPTO_LIBS}) { ($ENV{LIBCRYPTO_CFLAGS}, $ENV{LIBCRYPTO_LIBS}); } else { print 'checking for libcrypto... '; # CMS support was introduced in 0.9.8 # CMS_STREAM was introduced in 0.9.9 my %LIBCRYPTO = ExtUtils::PkgConfig->find('libcrypto >= 0.9.9'); print "$LIBCRYPTO{modversion}\n"; ($LIBCRYPTO{cflags}, $LIBCRYPTO{libs}); } }; print "checking for LIBCRYPTO_CFLAGS... $LIBCRYPTO_CFLAGS\n"; print "checking for LIBCRYPTO_LIBS... $LIBCRYPTO_LIBS\n"; return +{ INC => join(' ', $LIBCRYPTO_CFLAGS, '-DOPENSSL_LOAD_CONF', $HAVE_GETTIMEOFDAY ? ('-DHAVE_GETTIMEOFDAY') : (), $HAVE_SYS_TIME_H ? ('-DHAVE_SYS_TIME_H' ) : (), $HAVE_TIME ? ('-DHAVE_TIME' ) : (), $HAVE_TIME_H ? ('-DHAVE_TIME_H' ) : ()), LIBS => $LIBCRYPTO_LIBS, }; }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Crypt-SMIME-*' }, realclean => { FILES => 'const-*.inc' }, PM => { 'lib/SMIME.pm' => '$(INST_LIBDIR)/SMIME.pm', 'lib/SMIME/JA.pod' => '$(INST_LIBDIR)/SMIME/JA.pod', }, depend => { 'lib/SMIME.pm' => "SMIME.pl SMIME.pod const-autoload.inc\n" . ("\tmkdir -p lib\n") . "\techo $SEP# This file is automatically generated from SMIME.pl$SEP > \$\@\n" . "\techo $SEP# All of your changes will be lost if you edit this directly.$SEP >> \$\@\n" . "\t$CAT SMIME.pl >> \$\@\n" . "\t$CAT const-autoload.inc >> \$\@\n" . "\techo # >> \$\@\n" . "\techo __END__ >> \$\@\n" . "\techo # >> \$\@\n" . "\t$CAT SMIME.pod >> \$\@\n", 'SMIME.pod' => "SMIME.mlpod\n" . "\tmlpod2pod \$< > \$\@", 'lib/SMIME/JA.pod' => "SMIME.mlpod\n" . ("\tmkdir -p lib/SMIME\n") . "\tmlpod2pod --langs=ja \$< | perl -pe 's/(\\xe5\\x90\\x8d\\xe5\\x89\\x8d)/NAME/' > \$\@", }, ); WriteConstants( NAME => 'Crypt::SMIME', NAMES => [ {name => 'NO_CHECK_CERTIFICATE', macro => 'CMS_NO_SIGNER_CERT_VERIFY', value => 'CMS_NO_SIGNER_CERT_VERIFY'}, {name => 'FORMAT_ASN1' , macro => 1, value => 'CRYPT_SMIME_FORMAT_ASN1' }, {name => 'FORMAT_PEM' , macro => 1, value => 'CRYPT_SMIME_FORMAT_PEM' }, {name => 'FORMAT_SMIME', macro => 1, value => 'CRYPT_SMIME_FORMAT_SMIME'} ], ($USE_PROXYSUBS ? (PROXYSUBS => {autoload => 1}) : ()) ); Crypt-SMIME-0.31/lib/0000755000175000017500000000000014764200436012320 5ustar phophoCrypt-SMIME-0.31/lib/SMIME.pm0000644000175000017500000002664414764200432013540 0ustar phopho# This file is automatically generated from SMIME.pl # All of your changes will be lost if you edit this directly. package Crypt::SMIME; use warnings; use strict; use Exporter 'import'; use XSLoader; our %EXPORT_TAGS = ( constants => [qw( NO_CHECK_CERTIFICATE FORMAT_ASN1 FORMAT_PEM FORMAT_SMIME )] ); Exporter::export_ok_tags('constants'); our $VERSION = '0.31'; XSLoader::load(__PACKAGE__, $VERSION); 1; sub sign { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#sign: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#sign: ARG[1] is a Ref. [$mime]\n"; } $this->_moveHeaderAndDo($mime, '_sign'); } sub signonly { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#signonly: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#signonly: ARG[1] is a Ref. [$mime]\n"; } # suppose that $mime is prepared. my $result = $this->_signonly($mime); $result =~ s/\r?\n|\r/\r\n/g; $result; } sub encrypt { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#encrypt: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#encrypt: ARG[1] is a Ref. [$mime]\n"; } $this->_moveHeaderAndDo($mime, '_encrypt'); } sub isSigned { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#isSigned: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#isSigned: ARG[1] is a Ref. [$mime]\n"; } my $ctype = $this->_getContentType($mime); if($ctype =~ m!^application/(?:x-)?pkcs7-mime! && $ctype =~ m!smime-type="?signed-data"?!) { # signed-data署名 1; } elsif($ctype =~ m!^multipart/signed! && $ctype =~ m!protocol="?application/(?:x-)?pkcs7-signature"?!) { # 分離署名 (クリア署名) 1; } else { undef; } } sub isEncrypted { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#isEncrypted: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#isEncrypted: ARG[1] is a Ref. [$mime]\n"; } my $ctype = $this->_getContentType($mime); if($ctype =~ m!^application/(?:x-)?pkcs7-mime! && ($ctype !~ m!smime-type=! || $ctype =~ m!smime-type="?enveloped-data"?!)) { # smime-typeが存在しないか、それがenveloped-dataである。 1; } else { undef; } } sub _moveHeaderAndDo { my $this = shift; my $mime = shift; my $method = shift; # Content- または MIME- で始まるヘッダはそのままに、 # それ以外のヘッダはmultipartのトップレベルにコピーしなければならない。 # (FromやTo、Subject等) ($mime,my $headers) = $this->prepareSmimeMessage($mime); my $result = $this->$method($mime); $result =~ s/\r?\n|\r/\r\n/g; # コピーしたヘッダを入れる $result =~ s/\r\n\r\n/\r\n$headers\r\n/; $result; } sub _getContentType { my $this = shift; my $mime = shift; my $headkey; my $headline = ''; $mime =~ s/\r?\n|\r/\r\n/g; foreach my $line (split /\r\n/, $mime) { if(!length($line)) { return $headline; } elsif($line =~ m/^([^\s:][^:]*?):\s?(.*)/) { my ($key, $value) = ($1, $2); $headkey = $key; if($key =~ m/^Content-Type$/i) { $headline = $value; } } else { if($headkey =~ m/^Content-Type$/i) { $headline .= "\r\n$line"; } } } return $headline; } # ----------------------------------------------------------------------------- # my ($message,$movedheader) = $smime->prepareSmimeMessage($mime); # sub prepareSmimeMessage { my $this = shift; my $mime = shift; $mime =~ s/\r?\n|\r/\r\n/g; my $move = ''; my $rest = ''; my $is_move = 0; my $is_rest = 1; while($mime=~/(.*\n?)/g) { my $line = $1; if($line eq "\r\n") { # end of header. $rest .= $line . substr($mime,pos($mime)); last; } if($line=~/^(Content-|MIME-)/i) { ($is_move, $is_rest) = (0,1); } elsif( $line =~ /^(Subject:)/i ) { ($is_move, $is_rest) = (1,1); } elsif( $line =~ /^\S/ ) { ($is_move, $is_rest) = (1,0); } $is_move and $move .= $line; $is_rest and $rest .= $line; } ($rest,$move); } __END__ =encoding utf-8 =head1 NAME Crypt::SMIME - S/MIME message signing, verification, encryption and decryption =head1 SYNOPSIS use Crypt::SMIME; my $plain = <<'EOF'; From: alice@example.org To: bob@example.com Subject: Crypt::SMIME test This is a test mail. Please ignore... EOF my $smime = Crypt::SMIME->new(); $smime->setPrivateKey($privkey, $crt); # $smime->setPublicKey([$icacert]); # if need be. my $signed = $smime->sign($plain); print $signed; =head1 DESCRIPTION This module provides a class for handling S/MIME messages. It can sign, verify, encrypt and decrypt messages. It requires libcrypto (L). =head1 EXPORTS No symbols are exported by default. The following symbols can optionally be exported: =over =item C See L. =item C =item C =item C See L. =item C<:constants> Export all of the above. =back =head1 METHODS =over 4 =item new() my $smime = Crypt::SMIME->new(); The constructor takes no arguments. =item setPrivateKey() $smime->setPrivateKey($key, $crt); $smime->setPrivateKey($key, $crt, $password); Store a private key and its X.509 certificate into the instance. The private key will be used for signing and decryption. Note that this method takes a PEM string, not a name of a file which contains a key or a certificate. The private key and certificate must be encoded in PEM format. The method dies if it fails to load the key. =item setPrivateKeyPkcs12() $smime->setPrivateKeyPkcs12($key, $pkcs12); $smime->setPrivateKeyPkcs12($key, $pkcs12, $password); Load a private key and its X.509 certificate from PKCS#12 into the instance. The private key will be used for signing and decryption. The method dies if it fails to load PKCS12. =item setPublicKey() $smime->setPublicKey($crt); $smime->setPublicKey([$crt1, $crt2, ...]); Store one or more X.509 certificates into the instance. The public keys will be used for signing, verification and encryption. The certificates must be encoded in PEM format. The method dies if it fails to load the certificates. =item setPublicKeyStore() $smime->setPublicKeyStore($path, ...); Set the paths of file or directory containing trusted certificates. The certificate stores will be used for verification. The method dies if it fails to load the certificate stores. =item sign() $signed_mime = $smime->sign($raw_mime); Sign a MIME message and return an S/MIME message. The signature is always detached. Any headers except C, C and C will be moved to the top-level of the MIME message. C header will be copied to both of the plain text part and the top-level for mail clients which can't properly handle S/MIME messages. The resulting message will be tainted if any of the original MIME message, the private key or its certificate is tainted. =item signonly() $sign = $smime->signonly($prepared_mime); Generate a signature from a MIME message. The resulting signature is encoded in Base64. The MIME message to be passed to this method should be preprocessed beforehand by the prepareSmimeMessage() method. You would rarely need to call this method directly. The resulting signature will be tainted if any of the original MIME message, the private key or its certificate is tainted. =item prepareSmimeMessage() ($prepared_mime, $outer_header) = $smime->prepareSmimeMessage($source_mime); Preprocess a MIME message to be signed. C<$prepared_mime> will be a string containing the processed MIME message, and C<$outer_header> will be a string that is a list of headers to be moved to the top-level of MIME message. You would rarely need to call this method directly. The entity body of C<$source_mime> will be directly copied to C<$prepared_mime>. Any headers of C<$source_mime> except C, C and C will be copied to C<$prepared_mime>, and those excluded headers will be copied to C<$outer_header>. Note that the C header will be copied to both side exceptionally. =item check() use Crypt::SMIME qw(:constants); $source_mime = $smime->check($signed_mime); $source_mime = $smime->check($signed_mime, $flags); Verify a signature of S/MIME message and return a MIME message. The method dies if it fails to verify it. When the option C is given as C<$flags>, the signer's certificate chain is not verified. The default value for C<$flags> is C<0>, which performs all the verifications. The resulting message will be tainted if the original S/MIME message, the C<$flags>, verification time (L) or at least one of the provided public keys are tainted. =item encrypt() $encrypted_mime = $smime->encrypt($raw_mime); Encrypt a MIME message and return a S/MIME message. Any headers except C, C and C will be moved to the top-level of the MIME message. C header will be copied to both of the plain text part and the top-level for mail clients which can't properly handle S/MIME messages. The resulting message will be tainted if the original MIME message or at least one public key is tainted. =item decrypt() $decrypted_mime = $smime->decrypt($encrypted_mime); Decrypt an S/MIME and return a MIME message. This method dies if it fails to decrypt it. The resulting message will be tainted if any of the original S/MIME message, the private key or its certificate is tainted. =item isSigned() $is_signed = $smime->isSigned($mime); Return true if the given string is a signed S/MIME message. Note that if the message was encrypted after signing, this method returns false because in that case the signature is hidden in the encrypted message. =item isEncrypted() $is_encrypted = $smime->isEncrypted($mime); Return true if the given string is an encrypted S/MIME message. Note that if the message was signed with non-detached signature after encryption, this method returns false because in that case the encrypted message is hidden in the signature. =back =over =item setAtTime() $yesterday = time - (60*60*24); $smime->setAtTime($yesterday); Set the time to use for verification. Default is to use the current time. Must be an unix epoch timestamp. =back =head1 FUNCTIONS =over 4 =item extractCertificates() use Crypt::SMIME qw(:constants); @certs = @{Crypt::SMIME::extractCertificates($data)}; @certs = @{Crypt::SMIME::extractCertificates($data, FORMAT_SMIME)}; Get all X.509 certificates (and CRLs, if any) included in S/MIME message or PKCS#7 object $data. Optional C<$type> parameter may specify type of data: C (default) for S/MIME message; C for binary format; C for PEM format. =item getSigners() @certs = @{Crypt::SMIME::getSigners($data)}; @certs = @{Crypt::SMIME::getSigners($data, $type)}; Get X.509 certificates of signers included in S/MIME message or PKCS#7 object. Optional $type parameter may specify type of data. Note that any public keys returned by this function are not verified. check() should be executed to ensure public keys are valid. =back =head1 AUTHOR Copyright 2006-2014 YMIRLINK Inc. All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself Bug reports and comments to: tl@tripletail.jp =for comment Local Variables: mode: cperl End: Crypt-SMIME-0.31/lib/SMIME/0000755000175000017500000000000014764200436013172 5ustar phophoCrypt-SMIME-0.31/lib/SMIME/JA.pod0000644000175000017500000001770314571251050014172 0ustar phopho=encoding utf-8 =head1 NAME Crypt::SMIME::JA - S/MIMEの署名、検証、暗号化、復号 =head1 概要 use Crypt::SMIME; my $plain = <<'EOF'; From: alice@example.org To: bob@example.com Subject: Crypt::SMIME test This is a test mail. Please ignore... EOF my $smime = Crypt::SMIME->new(); $smime->setPrivateKey($privkey, $crt); # $smime->setPublicKey([$icacert]); # if need be. my $signed = $smime->sign($plain); print $signed; =head1 説明 S/MIMEの署名、検証、暗号化、復号を行うクラス。 libcrypto (L) が必要。 =head1 エクスポート 既定でエクスポートされるシンボルは無いが、次のシンボルはエクスポート可能である。 =over =item C L を参照。 =item C =item C =item C L を参照。 =item C<:constants> 上記のもの全てをエクスポートする。 =back =head1 メソッド =over 4 =item new() my $smime = Crypt::SMIME->new(); 引数無し =item setPrivateKey() $smime->setPrivateKey($key, $crt); $smime->setPrivateKey($key, $crt, $password); 秘密鍵を設定する。ここで設定された秘密鍵は署名と復号の際に用いられる。 ファイル名ではなく、鍵本体を渡す。 対応しているフォーマットは PEM のみ。鍵の読み込みに失敗した場合はdieする。 =item setPrivateKeyPkcs12() $smime->setPrivateKeyPkcs12($key, $pkcs12); $smime->setPrivateKeyPkcs12($key, $pkcs12, $password); 秘密鍵およびその X.509 証明書を PKCS#12 から読み込んで設定する。秘密鍵は署名と復号の際に用いられる。 読み込みに失敗した場合は die する。 =item setPublicKey() $smime->setPublicKey($crt); $smime->setPublicKey([$crt1, $crt2, ...]); 公開鍵を設定する。ここで設定された公開鍵は署名への添付、署名の検証、 そして暗号化の際に用いられる。 対応しているフォーマットは PEM のみ。鍵の読み込みに失敗した場合はdieする。 =item setPublicKeyStore() $smime->setPublicKeyStore($path, ...); 信頼している証明書 (複数可) が入ったファイルやディレクトリのパス (複数可) を設定する。ここで設定された証明書ストアは、署名の検証の際に用いられる。 証明書ストアの読み込みに失敗した場合はdieする。 =item sign() $signed_mime = $smime->sign($raw_mime); 署名を行い、MIMEメッセージを返す。可能な署名はクリア署名のみ。 C, C 及び C を除いたヘッダは multipartのトップレベルに移される。 C はS/MIMEを認識できないメーラのために, multipartの トップレベルと保護されるメッセージの両側に配置される。 元の MIME メッセージ、秘密鍵、またはその証明書のいずれかが汚染されている (tainted) ならば、署名されたメッセージも汚染される。 =item signonly() $sign = $smime->signonly($prepared_mime); 署名の計算を行う。 C<$sign> はBASE64でエンコードされて返る。 C<$prepared_mime> には, L で返される値を渡す。 元の MIME メッセージ、秘密鍵、またはその証明書のいずれかが汚染されている (tainted) ならば、生成された署名も汚染される。 =item prepareSmimeMessage() ($prepared_mime, $outer_header) = $smime->prepareSmimeMessage($source_mime); 署名用のメッセージを準備する。 C<$prepared_mime> には署名用に修正されたMIMEメッセージを返す。 C<$outer_header> は、S/MIMEの外側に付与するヘッダを返す。 C<$prepared_mime> の本文はC<$source_mime>と同じ物となるが、 ヘッダに関してはC, C, C を除く全てが 取り除かれる。取り除かれたヘッダは C<$outer_header> に返される。 S/MIMEメッセージを構築する際にはこれをS/MIMEメッセージのヘッダに追加する。 C ヘッダのみは C<$prepared_mime> と C<$outer_header> の両方に 現れる点に注意。 =item check() use Crypt::SMIME qw(:constants); $source_mime = $smime->check($signed_mime); $source_mime = $smime->check($signed_mime, $flags); 検証を行う。検証に失敗した場合はその理由と共にdieする。 C<$flags> として C オプションを指定した場合には、署名者の証明書チェーンを検証しない。 C<$flags> のデフォルト値は C<0> であり、この場合には全ての整合性についての検証を行う。 元の S/MIME メッセージ, C<$flags>, 検証時刻 (L), または 公開鍵の少なくとも一つが汚染されている(tainted) ならば、検証されたメッセージも汚染される。 =item encrypt() $encrypted_mime = $smime->encrypt($raw_mime); 暗号化を行う。 C, C 及び C を除いたヘッダは multipartのトップレベルにコピーされる。 C はS/MIMEを認識できないメーラのために, multipartの トップレベルと保護されるメッセージの両側に配置される。 元の MIME メッセージ、または公開鍵の少なくとも一つが汚染されている (tainted) ならば、暗号化されたメッセージも汚染される。 =item decrypt() $decrypted_mime = $smime->decrypt($encrypted_mime); 復号を行う。復号に失敗した場合はその理由と共にdieする。 元の S/MIME メッセージ、秘密鍵、またはその証明書のいずれかが汚染されている (tainted) ならば、復号されたメッセージも汚染される。 =item isSigned() $is_signed = $smime->isSigned($mime); 渡されたMIMEメッセージがS/MIMEで署名されたものなら真を返す。 クリア署名かどうかは問わない。 署名後に暗号化したメッセージを渡した場合は、署名が直接見えない為、 偽を返す事に注意。 =item isEncrypted() $is_encrypted = $smime->isEncrypted($mime); 渡されたMIMEメッセージがS/MIMEで暗号化されたものなら真を返す。 暗号化後に署名したメッセージを渡した場合は、暗号文が直接見えない為、 偽を返す事に注意。 =back =over =item setAtTime() $yesterday = time - (60*60*24); $smime->setAtTime($yesterday); 検証時に用いる時刻を設定する。デフォルトは現在時刻。 UNIX epoch 形式でなければならない。 =back =head1 関数 =over 4 =item extractCertificates() use Crypt::SMIME qw(:constants); @certs = @{Crypt::SMIME::extractCertificates($data)}; @certs = @{Crypt::SMIME::extractCertificates($data, FORMAT_SMIME)}; パラメータでデータの種類を指定できる。 C (初期値) はS/MIMEメッセージ、 Cはバイナリ形式、 CはPEM形式。 =item getSigners() @certs = @{Crypt::SMIME::getSigners($data)}; @certs = @{Crypt::SMIME::getSigners($data, $type)}; S/MIMEメッセージまたはPKCS#7オブジェクトに含まれる、署名者の X.509証明書を取得する。オプションの$typeパラメータでデータの種類を指定できる。 この関数が返す公開鍵は検証されていないことに注意。 公開鍵が有効であることを確かめるにはcheck()を実行すること。 =back =head1 著者 Copyright 2006-2014 YMIRLINK Inc. All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself Bug reports and comments to: tl@tripletail.jp =for comment Local Variables: mode: cperl End: Crypt-SMIME-0.31/SMIME.pl0000644000175000017500000000765414764200326012773 0ustar phophopackage Crypt::SMIME; use warnings; use strict; use Exporter 'import'; use XSLoader; our %EXPORT_TAGS = ( constants => [qw( NO_CHECK_CERTIFICATE FORMAT_ASN1 FORMAT_PEM FORMAT_SMIME )] ); Exporter::export_ok_tags('constants'); our $VERSION = '0.31'; XSLoader::load(__PACKAGE__, $VERSION); 1; sub sign { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#sign: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#sign: ARG[1] is a Ref. [$mime]\n"; } $this->_moveHeaderAndDo($mime, '_sign'); } sub signonly { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#signonly: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#signonly: ARG[1] is a Ref. [$mime]\n"; } # suppose that $mime is prepared. my $result = $this->_signonly($mime); $result =~ s/\r?\n|\r/\r\n/g; $result; } sub encrypt { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#encrypt: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#encrypt: ARG[1] is a Ref. [$mime]\n"; } $this->_moveHeaderAndDo($mime, '_encrypt'); } sub isSigned { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#isSigned: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#isSigned: ARG[1] is a Ref. [$mime]\n"; } my $ctype = $this->_getContentType($mime); if($ctype =~ m!^application/(?:x-)?pkcs7-mime! && $ctype =~ m!smime-type="?signed-data"?!) { # signed-data署名 1; } elsif($ctype =~ m!^multipart/signed! && $ctype =~ m!protocol="?application/(?:x-)?pkcs7-signature"?!) { # 分離署名 (クリア署名) 1; } else { undef; } } sub isEncrypted { my $this = shift; my $mime = shift; if(!defined($mime)) { die __PACKAGE__."#isEncrypted: ARG[1] is not defined.\n"; } elsif(ref($mime)) { die __PACKAGE__."#isEncrypted: ARG[1] is a Ref. [$mime]\n"; } my $ctype = $this->_getContentType($mime); if($ctype =~ m!^application/(?:x-)?pkcs7-mime! && ($ctype !~ m!smime-type=! || $ctype =~ m!smime-type="?enveloped-data"?!)) { # smime-typeが存在しないか、それがenveloped-dataである。 1; } else { undef; } } sub _moveHeaderAndDo { my $this = shift; my $mime = shift; my $method = shift; # Content- または MIME- で始まるヘッダはそのままに、 # それ以外のヘッダはmultipartのトップレベルにコピーしなければならない。 # (FromやTo、Subject等) ($mime,my $headers) = $this->prepareSmimeMessage($mime); my $result = $this->$method($mime); $result =~ s/\r?\n|\r/\r\n/g; # コピーしたヘッダを入れる $result =~ s/\r\n\r\n/\r\n$headers\r\n/; $result; } sub _getContentType { my $this = shift; my $mime = shift; my $headkey; my $headline = ''; $mime =~ s/\r?\n|\r/\r\n/g; foreach my $line (split /\r\n/, $mime) { if(!length($line)) { return $headline; } elsif($line =~ m/^([^\s:][^:]*?):\s?(.*)/) { my ($key, $value) = ($1, $2); $headkey = $key; if($key =~ m/^Content-Type$/i) { $headline = $value; } } else { if($headkey =~ m/^Content-Type$/i) { $headline .= "\r\n$line"; } } } return $headline; } # ----------------------------------------------------------------------------- # my ($message,$movedheader) = $smime->prepareSmimeMessage($mime); # sub prepareSmimeMessage { my $this = shift; my $mime = shift; $mime =~ s/\r?\n|\r/\r\n/g; my $move = ''; my $rest = ''; my $is_move = 0; my $is_rest = 1; while($mime=~/(.*\n?)/g) { my $line = $1; if($line eq "\r\n") { # end of header. $rest .= $line . substr($mime,pos($mime)); last; } if($line=~/^(Content-|MIME-)/i) { ($is_move, $is_rest) = (0,1); } elsif( $line =~ /^(Subject:)/i ) { ($is_move, $is_rest) = (1,1); } elsif( $line =~ /^\S/ ) { ($is_move, $is_rest) = (1,0); } $is_move and $move .= $line; $is_rest and $rest .= $line; } ($rest,$move); } Crypt-SMIME-0.31/SMIME.xs0000644000175000017500000007362114764177404013021 0ustar phopho#include #include #if defined(HAVE_SYS_TIME_H) # include #endif #include #include #include #include #include #include #include #if defined(HAVE_TIME_H) # include #endif #include #include #include "EXTERN.h" #include "perl.h" #include "XSUB.h" enum { CRYPT_SMIME_FORMAT_ASN1, CRYPT_SMIME_FORMAT_PEM, CRYPT_SMIME_FORMAT_SMIME }; struct crypt_smime { EVP_PKEY *priv_key; X509* priv_cert; bool priv_key_is_tainted; bool priv_cert_is_tainted; const EVP_CIPHER* cipher; /* 暗号化, 添付用 */ STACK_OF(X509)* pubkeys_stack; /* 検証用 */ X509_STORE* pubkeys_store; bool pubkeys_are_tainted; X509_VERIFY_PARAM *verify_params; bool verify_time_is_tainted; }; typedef struct crypt_smime * Crypt_SMIME; static inline unsigned long OpenSSL_get_last_error() { unsigned long last_error = ERR_get_error(); if (last_error != 0) { while (TRUE) { /* User code might have caused OpenSSL to emit more than a * single error before entering this function. OpenSSL 3.0 * appears to push errors to the queue even when no public * functions actually return error, and we have no choice * but to discard them all. This is fine. It's OpenSSL * after all. */ unsigned long next_error = ERR_get_error(); if (next_error != 0) { last_error = next_error; } else { break; } } } return last_error; } static inline void OPENSSL_CROAK(char const* description) { unsigned long last_error = OpenSSL_get_last_error(); if (last_error != 0) { croak("%s: %s", description, ERR_error_string(last_error, NULL)); } else { croak("%s", description); } } static inline bool is_string(SV const* sv) { /* It's not sufficient to call SvPOK() to see if an SV contains a * character string. It returns false for all SV if taint checking * is enabled. */ return SvPOK(sv) || SvPOKp(sv); } static int B64_write_CMS(BIO *bio, CMS_ContentInfo *p7) { BIO *b64; if(!(b64 = BIO_new(BIO_f_base64()))) { return 0; } bio = BIO_push(b64, bio); i2d_CMS_bio(bio, p7); (void)BIO_flush(bio); bio = BIO_pop(bio); BIO_free(b64); return 1; } static EVP_PKEY* load_privkey(Crypt_SMIME this, char* pem, char* password) { BIO *buf; EVP_PKEY *key; buf = BIO_new_mem_buf(pem, -1); if (buf == NULL) { return NULL; } key = PEM_read_bio_PrivateKey( buf, NULL, (pem_password_cb*)NULL, password); BIO_free(buf); return key; } /* ---------------------------------------------------------------------------- * X509* x509 = load_cert(crt); * extract X509 information from cert data. * not from file, from just data. * ------------------------------------------------------------------------- */ static X509* load_cert(char* crt) { BIO* buf; X509 *x; buf = BIO_new_mem_buf(crt, -1); if (buf == NULL) { return NULL; } x = PEM_read_bio_X509_AUX(buf, NULL, NULL, NULL); BIO_free(buf); return x; } static SV* sign(Crypt_SMIME this, char* plaintext, unsigned int len) { BIO* inbuf; BIO* outbuf; CMS_ContentInfo* cms; int flags = CMS_DETACHED | CMS_STREAM | CMS_PARTIAL; BUF_MEM* bufmem; SV* result; int err; int i; inbuf = BIO_new_mem_buf(plaintext, len); if (inbuf == NULL) { return NULL; } /* Generate a detached signature */ cms = CMS_sign(this->priv_cert, this->priv_key, NULL, inbuf, flags); if (cms == NULL) { BIO_free(inbuf); return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { CMS_ContentInfo_free(cms); BIO_free(inbuf); return NULL; } for (i = 0; i < sk_X509_num(this->pubkeys_stack); i++) { X509* x509 = sk_X509_value(this->pubkeys_stack, i); assert(x509 != NULL); /* CMS_add1_cert() increments the refcount in X509 and * CMS_ContentInfo_free() decrements it. */ if (CMS_add1_cert(cms, x509) != 1) { if (ERR_GET_REASON(ERR_peek_last_error()) != CMS_R_CERTIFICATE_ALREADY_PRESENT) { CMS_ContentInfo_free(cms); BIO_free(inbuf); return NULL; } } } err = SMIME_write_CMS(outbuf, cms, inbuf, flags); CMS_ContentInfo_free(cms); BIO_free(inbuf); if (err != 1) { return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); if (this->priv_key_is_tainted || this->priv_cert_is_tainted || this->pubkeys_are_tainted) { SvTAINTED_on(result); } return result; } static SV* signonly(Crypt_SMIME this, char* plaintext, unsigned int len) { BIO* inbuf; BIO* outbuf; CMS_ContentInfo* cms; int flags = CMS_DETACHED; BUF_MEM* bufmem; SV* result; int err; int i; inbuf = BIO_new_mem_buf(plaintext, len); if (inbuf == NULL) { return NULL; } /* Generate a detached signature */ cms = CMS_sign(this->priv_cert, this->priv_key, NULL, inbuf, flags); BIO_free(inbuf); if (cms == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { CMS_ContentInfo_free(cms); return NULL; } for (i = 0; i < sk_X509_num(this->pubkeys_stack); i++) { X509* x509 = sk_X509_value(this->pubkeys_stack, i); assert(x509 != NULL); if (CMS_add1_cert(cms, x509) != 1) { if (ERR_GET_REASON(ERR_peek_last_error()) != CMS_R_CERTIFICATE_ALREADY_PRESENT) { CMS_ContentInfo_free(cms); BIO_free(inbuf); return NULL; } } } err = B64_write_CMS(outbuf, cms); CMS_ContentInfo_free(cms); if (err != 1) { return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); if (this->priv_key_is_tainted || this->priv_cert_is_tainted || this->pubkeys_are_tainted) { SvTAINTED_on(result); } return result; } static SV* check(Crypt_SMIME this, char* signed_mime, unsigned int len, int flags) { BIO* inbuf; BIO* detached = NULL; BIO* outbuf; CMS_ContentInfo* cms; int err; BUF_MEM* bufmem; SV* result; inbuf = BIO_new_mem_buf(signed_mime, len); if (inbuf == NULL) { return NULL; } cms = SMIME_read_CMS(inbuf, &detached); BIO_free(inbuf); if (cms == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { CMS_ContentInfo_free(cms); return NULL; } if(this->verify_params) { X509_STORE_set1_param(this->pubkeys_store, this->verify_params); } err = CMS_verify(cms, this->pubkeys_stack, this->pubkeys_store, detached, outbuf, flags); CMS_ContentInfo_free(cms); if (detached != NULL) { BIO_free(detached); } if (err != 1) { BIO_free(outbuf); return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); if (this->pubkeys_are_tainted || this->verify_time_is_tainted) { SvTAINTED_on(result); } return result; } /* CMS */ static SV* _encrypt(Crypt_SMIME this, char* plaintext, unsigned int len) { BIO* inbuf; BIO* outbuf; CMS_ContentInfo* enc; int flags = 0; int err; BUF_MEM* bufmem; SV* result; inbuf = BIO_new_mem_buf(plaintext, len); if (inbuf == NULL) { return NULL; } enc = CMS_encrypt(this->pubkeys_stack, inbuf, this->cipher, flags); BIO_free(inbuf); if (enc == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { CMS_ContentInfo_free(enc); return NULL; } err = SMIME_write_CMS(outbuf, enc, NULL, flags); CMS_ContentInfo_free(enc); if (err != 1) { BIO_free(outbuf); return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); if (this->pubkeys_are_tainted) { SvTAINTED_on(result); } return result; } static SV* _decrypt(Crypt_SMIME this, char* encrypted_mime, unsigned int len) { BIO* inbuf; BIO* outbuf; CMS_ContentInfo * enc; int flags = 0; int err; BUF_MEM* bufmem; SV* result; inbuf = BIO_new_mem_buf(encrypted_mime, len); if (inbuf == NULL) { return NULL; } enc = SMIME_read_CMS(inbuf, NULL); BIO_free(inbuf); if (enc == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { CMS_ContentInfo_free(enc); return NULL; } err = CMS_decrypt(enc, this->priv_key, this->priv_cert, NULL, outbuf, flags); CMS_ContentInfo_free(enc); if (err != 1) { BIO_free(outbuf); return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); if (this->priv_key_is_tainted || this->priv_cert_is_tainted) { SvTAINTED_on(result); } return result; } static void seed_rng() { /* OpenSSL automatically seeds the random number generator from * /dev/urandom (on UNIX) or CryptGenRandom (on Windows). But if * we are on an exotic platform, we must somehow seed the RNG. */ RAND_poll(); while (RAND_status() == 0) { #if defined(HAVE_GETTIMEOFDAY) struct timeval tv; gettimeofday(&tv, NULL); RAND_seed(&tv, sizeof(struct timeval)); #elif defined(HAVE_TIME) time_t t; t = time(NULL); RAND_seed(&t, sizeof(time_t)); #else croak("Crypt::SMIME#import: don't know how to seed the CSPRNG on this platform"); #endif } } #include "const-c.inc" MODULE = Crypt::SMIME PACKAGE = Crypt::SMIME INCLUDE: const-xs.inc BOOT: ERR_load_crypto_strings(); OpenSSL_add_all_algorithms(); seed_rng(); Crypt_SMIME new(class) CODE: RETVAL = safemalloc(sizeof(struct crypt_smime)); if (RETVAL == NULL) { croak("Crypt::SMIME#new: unable to allocate Crypt_SMIME"); } memset(RETVAL, '\0', sizeof(struct crypt_smime)); OUTPUT: RETVAL void DESTROY(Crypt_SMIME this) CODE: if (this->priv_cert) { X509_free(this->priv_cert); } if (this->priv_key) { EVP_PKEY_free(this->priv_key); } if (this->pubkeys_stack) { sk_X509_pop_free(this->pubkeys_stack, X509_free); } if (this->pubkeys_store) { X509_STORE_free(this->pubkeys_store); } if (this->verify_params) { X509_VERIFY_PARAM_free(this->verify_params); } safefree(this); SV* setPrivateKey(Crypt_SMIME this, char* pem, char* crt, char* password = "") PROTOTYPE: $$$;$ CODE: /* Remove old keys if any. */ if (this->priv_cert) { X509_free(this->priv_cert); this->priv_cert = NULL; } if (this->priv_key) { EVP_PKEY_free(this->priv_key); this->priv_key = NULL; } this->priv_key = load_privkey(this, pem, password); if (this->priv_key == NULL) { OPENSSL_CROAK("Crypt::SMIME#setPrivateKey: failed to load the private key"); } this->priv_cert = load_cert(crt); if (this->priv_cert == NULL) { OPENSSL_CROAK("Crypt::SMIME#setPrivateKey: failed to load the private cert"); } this->priv_key_is_tainted = SvTAINTED(ST(1)); this->priv_cert_is_tainted = SvTAINTED(ST(2)); SvREFCNT_inc(ST(0)); RETVAL = ST(0); OUTPUT: RETVAL SV* setPrivateKeyPkcs12(Crypt_SMIME this, SV* pkcs12, char* password = "") PROTOTYPE: $$$;$ PREINIT: BIO *bio; PKCS12 *p12; CODE: if (this->priv_cert) { X509_free(this->priv_cert); this->priv_cert = NULL; } if (this->priv_key) { EVP_PKEY_free(this->priv_key); this->priv_key = NULL; } if (SvOK(pkcs12)) { if ((bio = BIO_new_mem_buf(SvPV_nolen(pkcs12), SvCUR(pkcs12))) != NULL) { if ((p12 = d2i_PKCS12_bio(bio, NULL)) != NULL) { BIO_free(bio); if (PKCS12_parse(p12, password, &this->priv_key, &this->priv_cert, NULL) != 0) { PKCS12_free(p12); } else { PKCS12_free(p12); OPENSSL_CROAK("Crypt::SMIME#setPrivateKeyPkcs12: failed to parse a PKCS#12 structure"); } } else { BIO_free(bio); OPENSSL_CROAK("Crypt::SMIME#setPrivateKeyPkcs12: failed to decode a PKCS#12 structure"); } } else { OPENSSL_CROAK("Crypt::SMIME#setPrivateKeyPkcs12: failed to allocate a buffer"); } } else { croak("Crypt::SMIME#setPrivateKeyPkcs12: argument `pkcs12' must be a scalar"); } this->priv_key_is_tainted = SvTAINTED(ST(1)); this->priv_cert_is_tainted = SvTAINTED(ST(1)); SvREFCNT_inc(ST(0)); RETVAL = ST(0); OUTPUT: RETVAL SV* setPublicKey(Crypt_SMIME this, SV* crt) CODE: /* crt: ARRAY Refなら、その各要素が公開鍵 SCALARなら、それが公開鍵 */ /* 古い鍵があったら消す */ if (this->pubkeys_stack) { sk_X509_pop_free(this->pubkeys_stack, X509_free); this->pubkeys_stack = NULL; } if (this->pubkeys_store) { X509_STORE_free(this->pubkeys_store); this->pubkeys_store = NULL; } this->pubkeys_store = X509_STORE_new(); if (this->pubkeys_store == NULL) { croak("Crypt::SMIME#setPublicKey: failed to allocate X509_STORE"); } /* 何故STACK_OF(X509)とX509_STOREの二つを使う必要があるのか。 */ this->pubkeys_stack = sk_X509_new_null(); if (this->pubkeys_stack == NULL) { croak("Crypt::SMIME#setPublicKey: failed to allocate STACK_OF(X509)"); } this->pubkeys_are_tainted = FALSE; if (SvROK(crt) && SvTYPE(SvRV(crt)) == SVt_PVAV) { AV* array = (AV*)SvRV(crt); I32 i, len = av_len(array); for (i = 0; i <= len; i++) { SV** val = av_fetch(array, i, 1); if (val == NULL) { continue; /* 多分起こらないが… */ } if (is_string(*val)) { SV* this_sv = ST(0); dSP; ENTER; PUSHMARK(SP); XPUSHs(this_sv); XPUSHs(*val); PUTBACK; call_method("_addPublicKey", G_DISCARD); LEAVE; } else { croak("Crypt::SMIME#setPublicKey: ARG[1] is an array but it contains some non-string values"); } } } else if (is_string(crt)) { SV* this_sv = ST(0); dSP; ENTER; PUSHMARK(SP); XPUSHs(this_sv); XPUSHs(crt); PUTBACK; call_method("_addPublicKey", G_DISCARD); LEAVE; } else { croak("Crypt::SMIME#setPublicKey: ARG[1] is not a string nor an ARRAY Ref"); } SvREFCNT_inc(ST(0)); RETVAL = ST(0); OUTPUT: RETVAL void _addPublicKey(Crypt_SMIME this, char* crt) PREINIT: BIO* buf; CODE: /* Be aware; 'crt' may contain two or more certificates. */ buf = BIO_new_mem_buf(crt, -1); if (buf == NULL) { OPENSSL_CROAK("Crypt::SMIME#setPublicKey: failed to allocate a buffer"); } while (1) { X509* pub_cert; pub_cert = PEM_read_bio_X509_AUX(buf, NULL, NULL, NULL); if (pub_cert == NULL) { if (ERR_GET_REASON(ERR_peek_last_error()) == PEM_R_NO_START_LINE) { OpenSSL_get_last_error(); // Discard the error. break; } else { BIO_free(buf); OPENSSL_CROAK("Crypt::SMIME#setPublicKey: failed to load the public cert"); } } /* X509_STORE_add_cert() internally increments the refcount in * X509 unlike sk_X509_push(). So we must not call * X509_up_ref() here. */ if (X509_STORE_add_cert(this->pubkeys_store, pub_cert) == 0) { X509_free(pub_cert); BIO_free(buf); OPENSSL_CROAK("Crypt::SMIME#setPublicKey: failed to store the public cert"); } if (sk_X509_push(this->pubkeys_stack, pub_cert) == 0) { X509_free(pub_cert); BIO_free(buf); OPENSSL_CROAK("Crypt::SMIME#setPublicKey: failed to push the public cert onto the stack"); } } BIO_free(buf); if (SvTAINTED(ST(1))) { this->pubkeys_are_tainted = TRUE; } SV* setPublicKeyStore(Crypt_SMIME this, ...) INIT: X509_STORE* store; X509* pub_cert; X509_LOOKUP *lookup_file, *lookup_path; int i, has_file = 0, has_path = 0; char* pathname; struct stat bufstat; CODE: /* 古い証明書ストアがあったら消す */ if (this->pubkeys_store) { X509_STORE_free(this->pubkeys_store); this->pubkeys_store = NULL; } store = X509_STORE_new(); if (store == NULL) { croak("Crypt::SMIME#setPublicKeyStore: failed to allocate X509_STORE"); } /* setPublicKey()で設定した証明書があれば追加する */ for (i = 0; i < sk_X509_num(this->pubkeys_stack); i++) { pub_cert = sk_X509_value(this->pubkeys_stack, i); if (pub_cert == NULL || X509_STORE_add_cert(store, pub_cert) == 0) { X509_STORE_free(store); croak("Crypt::SMIME#setPublicKeyStore: failed to store the public cert"); } } if (sk_X509_num(this->pubkeys_stack) == 0) { this->pubkeys_are_tainted = FALSE; } /* 引数があれば証明書ストアとして追加する */ lookup_file = X509_STORE_add_lookup(store, X509_LOOKUP_file()); if (lookup_file == NULL) { X509_STORE_free(store); croak("Crypt::SMIME#setPublicKeyStore: failed to allocate X509_LOOKUP"); } lookup_path = X509_STORE_add_lookup(store, X509_LOOKUP_hash_dir()); if (lookup_path == NULL) { X509_STORE_free(store); croak("Crypt::SMIME#setPublicKeyStore: failed to allocate X509_LOOKUP"); } for (i = 1; i < items; i++) { if (ST(i) == NULL) { continue; /* 多分起こらないが… */ } if (!is_string(ST(i))) { X509_STORE_free(store); croak("Crypt::SMIME#setPublicKeyStore: ARG[%d] is non-string value", i); } pathname = (char *)SvPV_nolen(ST(i)); if (stat(pathname, &bufstat) != 0) { X509_STORE_free(store); croak("Crypt::SMIME#setPublicKeyStore: cannot stat %s", pathname); } else if (bufstat.st_mode & S_IFDIR) { if (!X509_LOOKUP_add_dir(lookup_path, pathname, X509_FILETYPE_PEM)) { X509_STORE_free(store); croak("Crypt::SMIME#setPublicKeyStore: failed to add ARG[%d] as store", i); } has_path = 1; } else { if (!X509_LOOKUP_load_file(lookup_file, pathname, X509_FILETYPE_PEM)) { X509_STORE_free(store); croak("Crypt::SMIME#setPublicKeyStore: failed to add ARG[%d] as store", i); } has_file = 1; } if (SvTAINTED(ST(i))) { this->pubkeys_are_tainted = TRUE; } } /* 引数がなければ初期値の場所のストアを (存在すれば) 追加する */ if (!has_file) { X509_LOOKUP_load_file(lookup_file, NULL, X509_FILETYPE_DEFAULT); } if (!has_path) { X509_LOOKUP_add_dir(lookup_path, NULL, X509_FILETYPE_DEFAULT); } ERR_clear_error(); this->pubkeys_store = store; SvREFCNT_inc(ST(0)); RETVAL = ST(0); OUTPUT: RETVAL SV* _sign(Crypt_SMIME this, SV* plaintext) CODE: /* 秘密鍵がまだセットされていなければエラー */ if (this->priv_key == NULL) { croak("Crypt::SMIME#sign: private key has not yet been set. Set one before signing"); } if (this->priv_cert == NULL) { croak("Crypt::SMIME#sign: private cert has not yet been set. Set one before signing"); } RETVAL = sign(this, SvPV_nolen(plaintext), SvCUR(plaintext)); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#sign: failed to sign the message"); } OUTPUT: RETVAL SV* _signonly(Crypt_SMIME this, SV* plaintext) CODE: /* 秘密鍵がまだセットされていなければエラー */ if (this->priv_key == NULL) { croak("Crypt::SMIME#signonly: private key has not yet been set. Set one before signing"); } if (this->priv_cert == NULL) { croak("Crypt::SMIME#signonly: private cert has not yet been set. Set one before signing"); } RETVAL = signonly(this, SvPV_nolen(plaintext), SvCUR(plaintext)); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#signonly: failed to sign the message"); } OUTPUT: RETVAL SV* _encrypt(Crypt_SMIME this, SV* plaintext) CODE: /* 公開鍵がまだセットされていなければエラー */ if (this->pubkeys_stack == NULL) { croak("Crypt::SMIME#encrypt: public cert has not yet been set. Set one before encrypting"); } /* Initialize the cipher suite to use for encryption */ if (this->cipher == NULL) { /* The man page of CMS_encrypt(3) recommends DES-EDE3-CBC * i.e. EVP_des_ede3_cbc() for interoperability but it can * no longer be considered to be a safe algorithm. We use * AES-128-CBC instead. */ this->cipher = EVP_aes_128_cbc(); } RETVAL = _encrypt(this, SvPV_nolen(plaintext), SvCUR(plaintext)); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#encrypt: failed to encrypt the message"); } OUTPUT: RETVAL SV* check(Crypt_SMIME this, SV* signed_mime, int flags = 0) PROTOTYPE: $$;$ CODE: if (this->pubkeys_store == NULL) { if (!(flags & CMS_NO_SIGNER_CERT_VERIFY)) { croak("Crypt::SMIME#check: public cert has not yet been set. Set one before checking"); } } RETVAL = check(this, SvPV_nolen(signed_mime), SvCUR(signed_mime), flags); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#check: failed to check the signature"); } OUTPUT: RETVAL SV* decrypt(Crypt_SMIME this, SV* encrypted_mime) CODE: /* 秘密鍵がまだセットされていなければエラー */ if (this->priv_key == NULL) { croak("Crypt::SMIME#decrypt: private key has not yet been set. Set one before decrypting"); } if (this->priv_cert == NULL) { croak("Crypt::SMIME#decrypt: private cert has not yet been set. Set one before decrypting"); } RETVAL = _decrypt(this, SvPV_nolen(encrypted_mime), SvCUR(encrypted_mime)); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#decrypt: failed to decrypt the message"); } OUTPUT: RETVAL SV* x509_subject_hash(char* cert) CODE: { X509* x509 = load_cert(cert); if( x509!=NULL ) { RETVAL = newSVuv(X509_subject_name_hash(x509)); X509_free(x509); }else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL SV* x509_issuer_hash(char* cert) CODE: { X509* x509 = load_cert(cert); if( x509!=NULL ) { RETVAL = newSVuv(X509_issuer_name_hash(x509)); X509_free(x509); }else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL SV* extractCertificates(SV* indata, int informat=CRYPT_SMIME_FORMAT_SMIME) PROTOTYPE: $;$ INIT: BIO* bio; CMS_ContentInfo* cms = NULL; STACK_OF(X509)* certs = NULL; STACK_OF(X509_CRL)* crls = NULL; int i; AV* result; BUF_MEM* bufmem; if (!SvOK(indata)) { XSRETURN_UNDEF; } bio = BIO_new_mem_buf(SvPV_nolen(indata), SvCUR(indata)); if (bio == NULL) { OPENSSL_CROAK( "Crypt::SMIME#extractCertificates: failed to allocate a buffer" ); } switch (informat) { case CRYPT_SMIME_FORMAT_SMIME: cms = SMIME_read_CMS(bio, NULL); break; case CRYPT_SMIME_FORMAT_PEM: cms = PEM_read_bio_CMS(bio, NULL, NULL, NULL); break; case CRYPT_SMIME_FORMAT_ASN1: cms = d2i_CMS_bio(bio, NULL); break; default: BIO_free(bio); croak("Crypt::SMIME#extractCertificates: unknown format %d", informat); } BIO_free(bio); if (cms == NULL) { XSRETURN_UNDEF; } certs = CMS_get1_certs(cms); crls = CMS_get1_crls(cms); result = (AV*)sv_2mortal((SV*)newAV()); CODE: if (certs != NULL) { for (i = 0; i < sk_X509_num(certs); i++) { bio = BIO_new(BIO_s_mem()); if (bio == NULL) { sk_X509_CRL_pop_free(crls, X509_CRL_free); sk_X509_pop_free(certs, X509_free); CMS_ContentInfo_free(cms); croak("Crypt::SMIME#extractCertificates: failed to allocate a buffer"); } PEM_write_bio_X509(bio, sk_X509_value(certs, i)); BIO_get_mem_ptr(bio, &bufmem); av_push(result, newSVpv(bufmem->data, bufmem->length)); BIO_free(bio); } } if (crls != NULL) { for (i = 0; i < sk_X509_CRL_num(crls); i++) { bio = BIO_new(BIO_s_mem()); if (bio == NULL) { sk_X509_CRL_pop_free(crls, X509_CRL_free); sk_X509_pop_free(certs, X509_free); CMS_ContentInfo_free(cms); croak("Crypt::SMIME#extractCertificates: failed to allocate a buffer"); } PEM_write_bio_X509_CRL(bio, sk_X509_CRL_value(crls, i)); BIO_get_mem_ptr(bio, &bufmem); av_push(result, newSVpv(bufmem->data, bufmem->length)); BIO_free(bio); } } sk_X509_CRL_pop_free(crls, X509_CRL_free); sk_X509_pop_free(certs, X509_free); CMS_ContentInfo_free(cms); RETVAL = newRV((SV*) result); OUTPUT: RETVAL SV* getSigners(SV* indata, int informat=CRYPT_SMIME_FORMAT_SMIME) PROTOTYPE: $;$ INIT: BIO* bio; BIO* detached = NULL; CMS_ContentInfo* cms = NULL; int flags; int err; STACK_OF(X509)* signers; int i; AV* result; BUF_MEM* bufmem; if (!SvOK(indata)) { XSRETURN_UNDEF; } bio = BIO_new_mem_buf(SvPV_nolen(indata), SvCUR(indata)); if (bio == NULL) { OPENSSL_CROAK( "Crypt::SMIME#getSigners: failed to allocate a buffer" ); } switch (informat) { case CRYPT_SMIME_FORMAT_SMIME: cms = SMIME_read_CMS(bio, &detached); break; case CRYPT_SMIME_FORMAT_PEM: cms = PEM_read_bio_CMS(bio, NULL, NULL, NULL); break; case CRYPT_SMIME_FORMAT_ASN1: cms = d2i_CMS_bio(bio, NULL); break; default: BIO_free(bio); croak("Crypt::SMIME#getSigners: unknown format %d", informat); } BIO_free(bio); if (cms == NULL) { XSRETURN_UNDEF; } /* We are only interested in the signers. No verifications need to * be done. */ flags = CMS_NO_SIGNER_CERT_VERIFY | CMS_NO_ATTR_VERIFY | CMS_NO_CONTENT_VERIFY; err = CMS_verify(cms, NULL, NULL, detached, NULL, flags); if (err != 1) { OPENSSL_CROAK("Crypt::SMIME#getSigners: failed to extract signers"); } if (detached != NULL) { BIO_free(detached); } signers = CMS_get0_signers(cms); if (signers == NULL) { CMS_ContentInfo_free(cms); XSRETURN_UNDEF; } result = (AV*)sv_2mortal((SV*)newAV()); CODE: if (0 < sk_X509_num(signers)) { for (i = 0; i < sk_X509_num(signers); i++) { bio = BIO_new(BIO_s_mem()); if (bio == NULL) { sk_X509_free(signers); CMS_ContentInfo_free(cms); croak("Crypt::SMIME#getSigners: failed to allocate a buffer"); } PEM_write_bio_X509(bio, sk_X509_value(signers, i)); BIO_get_mem_ptr(bio, &bufmem); av_push(result, newSVpv(bufmem->data, bufmem->length)); BIO_free(bio); } } sk_X509_free(signers); CMS_ContentInfo_free(cms); RETVAL = newRV((SV*) result); OUTPUT: RETVAL void setAtTime(Crypt_SMIME this, time_t timestamp) CODE: if ( ! this->verify_params) { this->verify_params = X509_VERIFY_PARAM_new(); } X509_VERIFY_PARAM_set_time(this->verify_params, timestamp); this->verify_time_is_tainted = SvTAINTED(ST(1)); # ----------------------------------------------------------------------------- # End of File. # ----------------------------------------------------------------------------- Crypt-SMIME-0.31/MANIFEST.SKIP0000644000175000017500000000031414571250325013444 0ustar phopho~$ \.tar\.gz$ (^|/)\.svn(/|$) ^\.hg(/|$) ^\.hgignore$ ^\.hgtags$ ^blib(/|$) ^const-.*?\.inc$ ^Makefile$ ^Makefile\.old$ ^MANIFEST\.bak$ (^|/)MYMETA\. ^pm_to_blib$ ^SMIME\.bs$ ^SMIME\.c$ ^SMIME\.o$ ^\.git Crypt-SMIME-0.31/typemap0000644000175000017500000000106414571250325013153 0ustar phophoTYPEMAP Crypt_SMIME T_PTROBJ_SPECIAL INPUT T_PTROBJ_SPECIAL /* タイプ名のアンダースコアを::に変えたパッケージ名にblessされているのでなければcroak */ if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = ($type) tmp; } else { croak(\"$var is not of type ${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\"); } OUTPUT T_PTROBJ_SPECIAL sv_setref_pv( $arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\", (void*)$var); Crypt-SMIME-0.31/SMIME.pod0000644000175000017500000001657514571250677013156 0ustar phopho=encoding utf-8 =head1 NAME Crypt::SMIME - S/MIME message signing, verification, encryption and decryption =head1 SYNOPSIS use Crypt::SMIME; my $plain = <<'EOF'; From: alice@example.org To: bob@example.com Subject: Crypt::SMIME test This is a test mail. Please ignore... EOF my $smime = Crypt::SMIME->new(); $smime->setPrivateKey($privkey, $crt); # $smime->setPublicKey([$icacert]); # if need be. my $signed = $smime->sign($plain); print $signed; =head1 DESCRIPTION This module provides a class for handling S/MIME messages. It can sign, verify, encrypt and decrypt messages. It requires libcrypto (L). =head1 EXPORTS No symbols are exported by default. The following symbols can optionally be exported: =over =item C See L. =item C =item C =item C See L. =item C<:constants> Export all of the above. =back =head1 METHODS =over 4 =item new() my $smime = Crypt::SMIME->new(); The constructor takes no arguments. =item setPrivateKey() $smime->setPrivateKey($key, $crt); $smime->setPrivateKey($key, $crt, $password); Store a private key and its X.509 certificate into the instance. The private key will be used for signing and decryption. Note that this method takes a PEM string, not a name of a file which contains a key or a certificate. The private key and certificate must be encoded in PEM format. The method dies if it fails to load the key. =item setPrivateKeyPkcs12() $smime->setPrivateKeyPkcs12($key, $pkcs12); $smime->setPrivateKeyPkcs12($key, $pkcs12, $password); Load a private key and its X.509 certificate from PKCS#12 into the instance. The private key will be used for signing and decryption. The method dies if it fails to load PKCS12. =item setPublicKey() $smime->setPublicKey($crt); $smime->setPublicKey([$crt1, $crt2, ...]); Store one or more X.509 certificates into the instance. The public keys will be used for signing, verification and encryption. The certificates must be encoded in PEM format. The method dies if it fails to load the certificates. =item setPublicKeyStore() $smime->setPublicKeyStore($path, ...); Set the paths of file or directory containing trusted certificates. The certificate stores will be used for verification. The method dies if it fails to load the certificate stores. =item sign() $signed_mime = $smime->sign($raw_mime); Sign a MIME message and return an S/MIME message. The signature is always detached. Any headers except C, C and C will be moved to the top-level of the MIME message. C header will be copied to both of the plain text part and the top-level for mail clients which can't properly handle S/MIME messages. The resulting message will be tainted if any of the original MIME message, the private key or its certificate is tainted. =item signonly() $sign = $smime->signonly($prepared_mime); Generate a signature from a MIME message. The resulting signature is encoded in Base64. The MIME message to be passed to this method should be preprocessed beforehand by the prepareSmimeMessage() method. You would rarely need to call this method directly. The resulting signature will be tainted if any of the original MIME message, the private key or its certificate is tainted. =item prepareSmimeMessage() ($prepared_mime, $outer_header) = $smime->prepareSmimeMessage($source_mime); Preprocess a MIME message to be signed. C<$prepared_mime> will be a string containing the processed MIME message, and C<$outer_header> will be a string that is a list of headers to be moved to the top-level of MIME message. You would rarely need to call this method directly. The entity body of C<$source_mime> will be directly copied to C<$prepared_mime>. Any headers of C<$source_mime> except C, C and C will be copied to C<$prepared_mime>, and those excluded headers will be copied to C<$outer_header>. Note that the C header will be copied to both side exceptionally. =item check() use Crypt::SMIME qw(:constants); $source_mime = $smime->check($signed_mime); $source_mime = $smime->check($signed_mime, $flags); Verify a signature of S/MIME message and return a MIME message. The method dies if it fails to verify it. When the option C is given as C<$flags>, the signer's certificate chain is not verified. The default value for C<$flags> is C<0>, which performs all the verifications. The resulting message will be tainted if the original S/MIME message, the C<$flags>, verification time (L) or at least one of the provided public keys are tainted. =item encrypt() $encrypted_mime = $smime->encrypt($raw_mime); Encrypt a MIME message and return a S/MIME message. Any headers except C, C and C will be moved to the top-level of the MIME message. C header will be copied to both of the plain text part and the top-level for mail clients which can't properly handle S/MIME messages. The resulting message will be tainted if the original MIME message or at least one public key is tainted. =item decrypt() $decrypted_mime = $smime->decrypt($encrypted_mime); Decrypt an S/MIME and return a MIME message. This method dies if it fails to decrypt it. The resulting message will be tainted if any of the original S/MIME message, the private key or its certificate is tainted. =item isSigned() $is_signed = $smime->isSigned($mime); Return true if the given string is a signed S/MIME message. Note that if the message was encrypted after signing, this method returns false because in that case the signature is hidden in the encrypted message. =item isEncrypted() $is_encrypted = $smime->isEncrypted($mime); Return true if the given string is an encrypted S/MIME message. Note that if the message was signed with non-detached signature after encryption, this method returns false because in that case the encrypted message is hidden in the signature. =back =over =item setAtTime() $yesterday = time - (60*60*24); $smime->setAtTime($yesterday); Set the time to use for verification. Default is to use the current time. Must be an unix epoch timestamp. =back =head1 FUNCTIONS =over 4 =item extractCertificates() use Crypt::SMIME qw(:constants); @certs = @{Crypt::SMIME::extractCertificates($data)}; @certs = @{Crypt::SMIME::extractCertificates($data, FORMAT_SMIME)}; Get all X.509 certificates (and CRLs, if any) included in S/MIME message or PKCS#7 object $data. Optional C<$type> parameter may specify type of data: C (default) for S/MIME message; C for binary format; C for PEM format. =item getSigners() @certs = @{Crypt::SMIME::getSigners($data)}; @certs = @{Crypt::SMIME::getSigners($data, $type)}; Get X.509 certificates of signers included in S/MIME message or PKCS#7 object. Optional $type parameter may specify type of data. Note that any public keys returned by this function are not verified. check() should be executed to ensure public keys are valid. =back =head1 AUTHOR Copyright 2006-2014 YMIRLINK Inc. All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself Bug reports and comments to: tl@tripletail.jp =for comment Local Variables: mode: cperl End: Crypt-SMIME-0.31/SMIME.mlpod0000644000175000017500000003237014571250325013464 0ustar phopho =encoding utf-8 =head1 NAME Crypt::SMIME - S/MIME message signing, verification, encryption and decryption J<< ja; Crypt::SMIME::JA - S/MIMEの署名、検証、暗号化、復号 >> =head1 SYNOPSIS use Crypt::SMIME; my $plain = <<'EOF'; From: alice@example.org To: bob@example.com Subject: Crypt::SMIME test This is a test mail. Please ignore... EOF my $smime = Crypt::SMIME->new(); $smime->setPrivateKey($privkey, $crt); # $smime->setPublicKey([$icacert]); # if need be. my $signed = $smime->sign($plain); print $signed; =head1 DESCRIPTION This module provides a class for handling S/MIME messages. It can sign, verify, encrypt and decrypt messages. It requires libcrypto (L). J<< ja; S/MIMEの署名、検証、暗号化、復号を行うクラス。 libcrypto (L) が必要。 >> =head1 EXPORTS No symbols are exported by default. The following symbols can optionally be exported: J<< ja; 既定でエクスポートされるシンボルは無いが、次のシンボルはエクスポート可能である。 >> =over =item C See L. J<< ja; L を参照。 >> =item C =item C =item C See L. J<< ja; L を参照。 >> =item C<:constants> Export all of the above. J<< ja; 上記のもの全てをエクスポートする。 >> =back =head1 METHODS =over 4 =item new() my $smime = Crypt::SMIME->new(); The constructor takes no arguments. J<< ja; 引数無し >> =item setPrivateKey() $smime->setPrivateKey($key, $crt); $smime->setPrivateKey($key, $crt, $password); Store a private key and its X.509 certificate into the instance. The private key will be used for signing and decryption. Note that this method takes a PEM string, not a name of a file which contains a key or a certificate. J<< ja; 秘密鍵を設定する。ここで設定された秘密鍵は署名と復号の際に用いられる。 ファイル名ではなく、鍵本体を渡す。 >> The private key and certificate must be encoded in PEM format. The method dies if it fails to load the key. J<< ja; 対応しているフォーマットは PEM のみ。鍵の読み込みに失敗した場合はdieする。 >> =item setPrivateKeyPkcs12() $smime->setPrivateKeyPkcs12($key, $pkcs12); $smime->setPrivateKeyPkcs12($key, $pkcs12, $password); Load a private key and its X.509 certificate from PKCS#12 into the instance. The private key will be used for signing and decryption. The method dies if it fails to load PKCS12. J<< ja; 秘密鍵およびその X.509 証明書を PKCS#12 から読み込んで設定する。秘密鍵は署名と復号の際に用いられる。 読み込みに失敗した場合は die する。 >> =item setPublicKey() $smime->setPublicKey($crt); $smime->setPublicKey([$crt1, $crt2, ...]); Store one or more X.509 certificates into the instance. The public keys will be used for signing, verification and encryption. J<< ja; 公開鍵を設定する。ここで設定された公開鍵は署名への添付、署名の検証、 そして暗号化の際に用いられる。 >> The certificates must be encoded in PEM format. The method dies if it fails to load the certificates. J<< ja; 対応しているフォーマットは PEM のみ。鍵の読み込みに失敗した場合はdieする。 >> =item setPublicKeyStore() $smime->setPublicKeyStore($path, ...); Set the paths of file or directory containing trusted certificates. The certificate stores will be used for verification. J<< ja; 信頼している証明書 (複数可) が入ったファイルやディレクトリのパス (複数可) を設定する。ここで設定された証明書ストアは、署名の検証の際に用いられる。 >> The method dies if it fails to load the certificate stores. J<< ja; 証明書ストアの読み込みに失敗した場合はdieする。 >> =item sign() $signed_mime = $smime->sign($raw_mime); Sign a MIME message and return an S/MIME message. The signature is always detached. J<< ja; 署名を行い、MIMEメッセージを返す。可能な署名はクリア署名のみ。 >> Any headers except C, C and C will be moved to the top-level of the MIME message. C header will be copied to both of the plain text part and the top-level for mail clients which can't properly handle S/MIME messages. J<< ja; C, C 及び C を除いたヘッダは multipartのトップレベルに移される。 C はS/MIMEを認識できないメーラのために, multipartの トップレベルと保護されるメッセージの両側に配置される。 >> The resulting message will be tainted if any of the original MIME message, the private key or its certificate is tainted. J<< ja; 元の MIME メッセージ、秘密鍵、またはその証明書のいずれかが汚染されている (tainted) ならば、署名されたメッセージも汚染される。 >> =item signonly() $sign = $smime->signonly($prepared_mime); Generate a signature from a MIME message. The resulting signature is encoded in Base64. The MIME message to be passed to this method should be preprocessed beforehand by the prepareSmimeMessage() method. You would rarely need to call this method directly. J<< ja; 署名の計算を行う。 C<$sign> はBASE64でエンコードされて返る。 C<$prepared_mime> には, L で返される値を渡す。 >> The resulting signature will be tainted if any of the original MIME message, the private key or its certificate is tainted. J<< ja; 元の MIME メッセージ、秘密鍵、またはその証明書のいずれかが汚染されている (tainted) ならば、生成された署名も汚染される。 >> =item prepareSmimeMessage() ($prepared_mime, $outer_header) = $smime->prepareSmimeMessage($source_mime); Preprocess a MIME message to be signed. C<$prepared_mime> will be a string containing the processed MIME message, and C<$outer_header> will be a string that is a list of headers to be moved to the top-level of MIME message. You would rarely need to call this method directly. J<< ja; 署名用のメッセージを準備する。 C<$prepared_mime> には署名用に修正されたMIMEメッセージを返す。 C<$outer_header> は、S/MIMEの外側に付与するヘッダを返す。 >> The entity body of C<$source_mime> will be directly copied to C<$prepared_mime>. Any headers of C<$source_mime> except C, C and C will be copied to C<$prepared_mime>, and those excluded headers will be copied to C<$outer_header>. Note that the C header will be copied to both side exceptionally. J<< ja; C<$prepared_mime> の本文はC<$source_mime>と同じ物となるが、 ヘッダに関してはC, C, C を除く全てが 取り除かれる。取り除かれたヘッダは C<$outer_header> に返される。 S/MIMEメッセージを構築する際にはこれをS/MIMEメッセージのヘッダに追加する。 C ヘッダのみは C<$prepared_mime> と C<$outer_header> の両方に 現れる点に注意。 >> =item check() use Crypt::SMIME qw(:constants); $source_mime = $smime->check($signed_mime); $source_mime = $smime->check($signed_mime, $flags); Verify a signature of S/MIME message and return a MIME message. The method dies if it fails to verify it. J<< ja; 検証を行う。検証に失敗した場合はその理由と共にdieする。 >> When the option C is given as C<$flags>, the signer's certificate chain is not verified. The default value for C<$flags> is C<0>, which performs all the verifications. J<< ja; C<$flags> として C オプションを指定した場合には、署名者の証明書チェーンを検証しない。 C<$flags> のデフォルト値は C<0> であり、この場合には全ての整合性についての検証を行う。 >> The resulting message will be tainted if the original S/MIME message, the C<$flags>, verification time (L) or at least one of the provided public keys are tainted. J<< ja; 元の S/MIME メッセージ, C<$flags>, 検証時刻 (L), または 公開鍵の少なくとも一つが汚染されている(tainted) ならば、検証されたメッセージも汚染される。 >> =item encrypt() $encrypted_mime = $smime->encrypt($raw_mime); Encrypt a MIME message and return a S/MIME message. J<< ja; 暗号化を行う。 >> Any headers except C, C and C will be moved to the top-level of the MIME message. C header will be copied to both of the plain text part and the top-level for mail clients which can't properly handle S/MIME messages. J<< ja; C, C 及び C を除いたヘッダは multipartのトップレベルにコピーされる。 C はS/MIMEを認識できないメーラのために, multipartの トップレベルと保護されるメッセージの両側に配置される。 >> The resulting message will be tainted if the original MIME message or at least one public key is tainted. J<< ja; 元の MIME メッセージ、または公開鍵の少なくとも一つが汚染されている (tainted) ならば、暗号化されたメッセージも汚染される。 >> =item decrypt() $decrypted_mime = $smime->decrypt($encrypted_mime); Decrypt an S/MIME and return a MIME message. This method dies if it fails to decrypt it. J<< ja; 復号を行う。復号に失敗した場合はその理由と共にdieする。 >> The resulting message will be tainted if any of the original S/MIME message, the private key or its certificate is tainted. J<< ja; 元の S/MIME メッセージ、秘密鍵、またはその証明書のいずれかが汚染されている (tainted) ならば、復号されたメッセージも汚染される。 >> =item isSigned() $is_signed = $smime->isSigned($mime); Return true if the given string is a signed S/MIME message. Note that if the message was encrypted after signing, this method returns false because in that case the signature is hidden in the encrypted message. J<< ja; 渡されたMIMEメッセージがS/MIMEで署名されたものなら真を返す。 クリア署名かどうかは問わない。 署名後に暗号化したメッセージを渡した場合は、署名が直接見えない為、 偽を返す事に注意。 >> =item isEncrypted() $is_encrypted = $smime->isEncrypted($mime); Return true if the given string is an encrypted S/MIME message. Note that if the message was signed with non-detached signature after encryption, this method returns false because in that case the encrypted message is hidden in the signature. J<< ja; 渡されたMIMEメッセージがS/MIMEで暗号化されたものなら真を返す。 暗号化後に署名したメッセージを渡した場合は、暗号文が直接見えない為、 偽を返す事に注意。 >> =back =item setAtTime() $yesterday = time - (60*60*24); $smime->setAtTime($yesterday); Set the time to use for verification. Default is to use the current time. Must be an unix epoch timestamp. J<< ja; 検証時に用いる時刻を設定する。デフォルトは現在時刻。 UNIX epoch 形式でなければならない。 >> =back =head1 FUNCTIONS =over 4 =item extractCertificates() use Crypt::SMIME qw(:constants); @certs = @{Crypt::SMIME::extractCertificates($data)}; @certs = @{Crypt::SMIME::extractCertificates($data, FORMAT_SMIME)}; Get all X.509 certificates (and CRLs, if any) included in S/MIME message or PKCS#7 object $data. Optional C<$type> parameter may specify type of data: C (default) for S/MIME message; C for binary format; C for PEM format. J<< ja; パラメータでデータの種類を指定できる。 C (初期値) はS/MIMEメッセージ、 Cはバイナリ形式、 CはPEM形式。 >> =item getSigners() @certs = @{Crypt::SMIME::getSigners($data)}; @certs = @{Crypt::SMIME::getSigners($data, $type)}; Get X.509 certificates of signers included in S/MIME message or PKCS#7 object. Optional $type parameter may specify type of data. J<< ja; S/MIMEメッセージまたはPKCS#7オブジェクトに含まれる、署名者の X.509証明書を取得する。オプションの$typeパラメータでデータの種類を指定できる。 >> Note that any public keys returned by this function are not verified. check() should be executed to ensure public keys are valid. J<< ja; この関数が返す公開鍵は検証されていないことに注意。 公開鍵が有効であることを確かめるにはcheck()を実行すること。 >> =back =head1 AUTHOR Copyright 2006-2014 YMIRLINK Inc. All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself Bug reports and comments to: tl@tripletail.jp =for comment Local Variables: mode: cperl End: =cut Crypt-SMIME-0.31/Changes0000644000175000017500000001411014764177630013053 0ustar phophoRevision history for Crypt::SMIME 0.31 Wed Mar 12 12:28:16 JST 2025 - Fix build with ExtUtils-ParseXS > 3.51: https://rt.cpan.org/Public/Bug/Display.html?id=162293 0.30 Mon Mar 25 11:13:13 JST 2024 - Added missing licence info to META files: https://rt.cpan.org/Public/Bug/Display.html?id=152521 0.29 Mon Mar 4 18:10:38 JST 2024 - Fixed a bug which could cause a double-free on X.509 structures in a certain scenario: https://rt.cpan.org/Public/Bug/Display.html?id=152115 0.28 Mon Oct 25 11:38:55 JST 2021 - Support OpenSSL 3.0. 0.27 Tue Sep 15 11:02:21 JST 2020 - Removed "t/dependencies.t". The behavior of Test::Dependencies has changed in 0.28, and it's no longer useful for us: https://rt.cpan.org/Public/Bug/Display.html?id=133309 0.26 Mon Aug 3 15:40:04 JST 2020 - sign(), signonly(), encrypt(), check(), decrypt() no longer truncate inputs on a NUL character, Patch by Brian Safford (https://rt.cpan.org/Public/Bug/Display.html?id=133084) 0.25 Thu Feb 22 18:34:02 JST 2018 - Fix the test '03-chained-certs.t' which can fail depending on the used libcrypto, Reported by Thomas Eckardt. 0.24 Wed Feb 21 13:39:48 JST 2018 - New method: setAtTime(), Patch by Markus Benning. 0.23 Tue Jan 23 18:29:53 JST 2018 - Improve Makefile.PL (again) so it works on Windows too, Suggested by Thomas Eckardt. - README now has hints for installing the package on Windows, Suggested by Thomas Eckardt. 0.22 Mon Jan 22 13:07:10 JST 2018 - Improve Makefile.PL so it works on Windows too, Suggested by Thomas Eckardt. 0.21 Mon Jan 15 14:03:25 JST 2018 - Work around a problem in ExtUtils::Constant::ProxySubs which generates code not working with perl<5.14: https://rt.cpan.org/Public/Bug/Display.html?id=124074 0.20 Wed Jan 10 14:32:56 JST 2018 - Fix a bug in _getContentType, Patch by unrtstRMSPAM [...] cpan.org: https://rt.cpan.org/Public/Bug/Display.html?id=124035 0.19 Fri Dec 2 13:22:27 JST 2016 - Use RFC-5652 CMS functions instead of PKCS#7 ones for better interoperability, Suggested by Hib Engler . CMS has a backwards compatibility with PKCS#7 so the change should introduce no compat issues. - Use AES-128-CBC instead of DES-EDE3-CBC for encryption, suggested by the same person. 0.18 Thu Oct 13 18:45:53 JST 2016 - Fix compatibility problem with OpenSSL >= 1.1, Reported by ppisar [...] redhat.com: https://rt.cpan.org/Public/Bug/Display.html?id=118344 0.17 Tue Jun 21 12:24:18 JST 2016 - New function: setPrivateKeyPkcs12(), Patch by MIK [...] cpan.org: https://rt.cpan.org/Public/Bug/Display.html?id=115490 0.16 Mon Oct 5 10:57:44 JST 2015 - Constants FORMAT_ASN1, FORMAT_PEM, and FORMAT_SMIME can now be exported. - New exportable constant: NO_CHECK_CERTIFICATE - check() now takes an optional argument $flag. The only possible value for $flag is NO_CHECK_CERTIFICATE, which disables the verification of signer's vertificate chain. 0.15 Wed Aug 13 16:53:50 JST 2014 - New function: setPublicKeyStore(), Patch by hatuka [...] nezumi.nu: https://rt.cpan.org/Public/Bug/Display.html?id=97955 - Fix a memory leak in setPublicKey(). - Add missing test cases for taintedness. 0.14 Mon Aug 4 14:21:21 JST 2014 - New function: extractCertificates() and getSigners(), Patch by hatuka [...] nezumi.nu: https://rt.cpan.org/Public/Bug/Display.html?id=97691 0.13 Wed May 7 16:23:52 JST 2014 - Improve compatibility with MS Windows: https://rt.cpan.org/Public/Bug/Display.html?id=95373 - Do not include .hgtags in release tarball: https://rt.cpan.org/Public/Bug/Display.html?id=95294 - Makefile.PL now aborts if no libcrypto.pc can be found in PKG_CONFIG_PATH. 0.12 Fri May 2 14:41:17 JST 2014 - Fix broken t/00-load.t that was introduced in 0.11. 0.11 Wed Apr 30 19:09:28 JST 2014 - setPublicKey() was erroneously raising an error if taint checking was enabled: https://rt.cpan.org/Ticket/Display.html?id=95163 - sign(), signonly(), check(), encrypt(), decrypt() now returns a tainted message if the input or a key is tainted. See the documentation for details. - Load the standard OpenSSL configuration file when available: https://rt.cpan.org/Public/Bug/Display.html?id=87675 - `make clean' should not remove SMIME.pod: https://rt.cpan.org/Public/Bug/Display.html?id=56025 - isSigned() and isEncrypted() were failing to recognize a signed / encrypted message if its Content-Type has an unquoted smime-type: https://rt.cpan.org/Public/Bug/Display.html?id=53620 0.10 Thu Apr 21 14:15:46 JST 2011 fix: setPublicKey() should allow a single PEM string to contain many X.509 certificates. http://rt.cpan.org/Public/Bug/Display.html?id=67612 0.09 Thu Oct 2 15:00:03 JST 2008 fix INSTALLMANxDIR problem. fix: SSLEAY_RAND_BYTES:PRNG not seeded. http://rt.cpan.org/Public/Bug/Display.html?id=35839 0.08 Wed Sep 26 11:20:58 JST 2007 doc fix 0.07 Tue Sep 25 12:39:36 JST 2007 Renamed from Tripletail::SMIME. 0.06 Wed Sep 7 18:32:12 JST 2005 fix: Attempt to free unreferenced scalar on x509_xx_hash. 0.05 Fri Aug 12 14:06:56 JST 2005 add: x509_subject_hash, x509_issuer_hash. 0.04 Fri Aug 12 11:55:38 JST 2005 fix: signonly had returned with "\n", new return with "\r\n". 0.03 Tue Aug 9 12:44:53 JST 2005 add: prepareSmimeMessage method. 0.02 Mon Aug 8 19:21:04 JST 2005 add: signonly method. 0.01 Mon Aug 8 17:55:33 JST 2005 First version. Crypt-SMIME-0.31/README0000644000175000017500000000342114571250325012430 0ustar phophoNAME Crypt::SMIME - S/MIME message signing, verification, encryption and decryption DESCRIPTION This module provides a class for handling S/MIME messages. It can sign, verify, encrypt and decrypt messages. It requires libcrypto (http://www.openssl.org). INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install HINTS FOR WINDOWS USERS Openssl has to be installed first - and openssl/bin must be in PATH for the module tests. * The ENV for LIBCRYPTO_CFLAGS should point to the openssl include folder. * The ENV for LIBCRYPTO_LIBS should point to the openssl libraries. Example: set PATH=C:\openssl\bin;%PATH% set LIBCRYPTO_CFLAGS=-IC:/openssl/include set LIBCRYPTO_LIBS="c:/openssl/lib/libeay32.lib" "c:/openssl/lib/ssleay32.lib" Strawberry perl always provides a full *nix compatible libcrypro environment. There are no settings or additionally installations required for this perl distribution. SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Crypt::SMIME You can also look for information at: CPAN http://search.cpan.org/dist/Crypt-SMIME/ BUGS Please post any bug reports and feature requests to rt.cpan.org. Failure to do so will result in a higher probability of neglection: https://rt.cpan.org/Public/Dist/Display.html?Name=Crypt-SMIME COPYRIGHT AND LICENCE Copyright (C) 2006-2014 YMIRLINK Inc. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Crypt-SMIME-0.31/META.yml0000644000175000017500000000130214764200436013017 0ustar phopho--- abstract: 'S/MIME message signing, verification, encryption and decryption' author: - 'Ymirlink ' build_requires: ExtUtils::PkgConfig: '0' Test::Exception: '0' Test::More: '0' configure_requires: ExtUtils::CChecker: '0' ExtUtils::Constant: '0.23' ExtUtils::MakeMaker: '0' ExtUtils::PkgConfig: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Crypt-SMIME no_index: directory: - t - inc requires: XSLoader: '0' version: '0.31' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Crypt-SMIME-0.31/META.json0000644000175000017500000000217614764200436013201 0ustar phopho{ "abstract" : "S/MIME message signing, verification, encryption and decryption", "author" : [ "Ymirlink " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Crypt-SMIME", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::PkgConfig" : "0", "Test::Exception" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::CChecker" : "0", "ExtUtils::Constant" : "0.23", "ExtUtils::MakeMaker" : "0", "ExtUtils::PkgConfig" : "0" } }, "runtime" : { "requires" : { "XSLoader" : "0" } } }, "release_status" : "stable", "version" : "0.31", "x_serialization_backend" : "JSON::PP version 4.16" }