Crypt-SMIME-0.10004075500020030000144000000000001155373732300120365ustar phousersCrypt-SMIME-0.10/t004075500020030000144000000000001155373732300123015ustar phousersCrypt-SMIME-0.10/t/smime.more.t010064400020030000144000000066261155370335100146210ustar phousers# -*- perl -*- use strict; use Test::More tests => 13; BEGIN { use_ok( 'Crypt::SMIME' ); } diag( "Testing Crypt::SMIME $Crypt::SMIME::VERSION" ); my $key = &KEY; my $crt = &CRT; 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'); #diag($signed); # 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 is apprers 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'); #diag($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. $smime->setPublicKey($crt); is($smime->check($decrypted),$verify, 'verify result of decrypt.'); } # end. sub CRT { < 23; use Test::Exception; use File::Spec; use strict; use warnings; BEGIN { use Crypt::SMIME; my $openssl = '/usr/local/ymir/perl/openssl/bin/openssl'; if (!-x $openssl) { $openssl = '/usr/bin/openssl'; } if(!-x $openssl && -e 'c:/openssl/bin/openssl.exe' ) { $openssl = 'c:/openssl/bin/openssl.exe'; } my $devnull = File::Spec->devnull(); open(FILE, "> tmp-$$.config") or die $!; print FILE<<'CONFIG'; [ 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 ] CONFIG close(FILE); foreach my $i (1 .. 2) { system(qq{$openssl genrsa > tmp-$$-$i.key 2>$devnull}) and die $!; system(qq{$openssl req -new -key tmp-$$-$i.key -out tmp-$$-$i.csr -config tmp-$$.config >$devnull}) and die $!; system(qq{$openssl x509 -in tmp-$$-$i.csr -out tmp-$$-$i.crt -req -signkey tmp-$$-$i.key -set_serial $i 2>$devnull >$devnull}) and die $!; } } END { foreach my $i (1 .. 2) { unlink "tmp-$$-$i.key", "tmp-$$-$i.csr", "tmp-$$-$i.crt"; } unlink("tmp-$$.config"); } sub key { my $i = shift; local $/ = undef; open my $fh, '<', "tmp-$$-$i.key"; <$fh>; } sub crt { my $i = shift; local $/ = undef; open my $fh, '<', "tmp-$$-$i.crt"; <$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; #----------------------- 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)'); 1; Crypt-SMIME-0.10/t/chained-certs.t010064400020030000144000000137571155373173500152710ustar phousers# -*- perl -*- use Test::More tests => 8; use Test::Exception; use File::Spec; # 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 $DEVNULL = File::Spec->devnull(); my $OPENSSL = do { my $tmp = `which openssl 2>$DEVNULL`; if ($? == 0) { chomp $tmp; $tmp; } else { BAIL_OUT("No openssl(1) were found in the PATH."); } }; diag "Using `$OPENSSL'...\n"; # Create the root CA. do { do { open my $fh, '>', "root.$$.cfg" or die $!; print {$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 $fh; }; system(qq{$OPENSSL genrsa > root.$$.key 2>$DEVNULL}) and die $!; system(qq{$OPENSSL req -new -key root.$$.key -out root.$$.csr -config root.$$.cfg 2>&1 >$DEVNULL}) and die $!; system(qq{$OPENSSL x509 -in root.$$.csr -out root.$$.crt -req -signkey root.$$.key -set_serial 1 -extfile root.$$.cfg -extensions v3_ca 2>&1 >$DEVNULL}) and die; }; # Create an intermediate CA #1. do { do { open my $fh, '>', "intermed-1.$$.cfg" or die $!; print {$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 $fh; }; system(qq{$OPENSSL genrsa > intermed-1.$$.key 2>$DEVNULL}) and die $!; system(qq{$OPENSSL req -new -key intermed-1.$$.key -out intermed-1.$$.csr -config intermed-1.$$.cfg 2>&1 >$DEVNULL}) and die $!; system(qq{$OPENSSL x509 -in intermed-1.$$.csr -out intermed-1.$$.crt -req -CA root.$$.crt -CAkey root.$$.key -set_serial 1 -extfile root.$$.cfg -extensions v3_ca 2>&1 >$DEVNULL}) and die; }; # Create an intermediate CA #2. do { do { open my $fh, '>', "intermed-2.$$.cfg" or die $!; print {$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 $fh; }; system(qq{$OPENSSL genrsa > intermed-2.$$.key 2>$DEVNULL}) and die $!; system(qq{$OPENSSL req -new -key intermed-2.$$.key -out intermed-2.$$.csr -config intermed-2.$$.cfg 2>&1 >$DEVNULL}) and die $!; system(qq{$OPENSSL x509 -in intermed-2.$$.csr -out intermed-2.$$.crt -req -CA intermed-1.$$.crt -CAkey intermed-1.$$.key -set_serial 1 -extfile root.$$.cfg -extensions v3_ca 2>&1 >$DEVNULL}) and die; }; # Create an user. do { do { open my $fh, '>', "user.$$.cfg" or die $!; print {$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 $fh; }; system(qq{$OPENSSL genrsa > user.$$.key 2>$DEVNULL}) and die $!; system(qq{$OPENSSL req -new -key user.$$.key -out user.$$.csr -config user.$$.cfg 2>&1 >$DEVNULL}) and die $!; system(qq{$OPENSSL x509 -in user.$$.csr -out user.$$.crt -req -CA intermed-2.$$.crt -CAkey intermed-2.$$.key -set_serial 1 2>&1 >$DEVNULL}) and die; }; # Delete temporary files later. END { foreach my $who (qw(root intermed-1 intermed-2 user)) { unlink "$who.$$.key", "$who.$$.cfg", "$who.$$.csr", "$who.$$.crt"; } } sub key { my $who = shift; local $/; open my $fh, '<', "$who.$$.key" or die $!; return scalar <$fh>; }; sub crt { my $who = shift; local $/; open my $fh, '<', "$who.$$.crt" 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; # ----------------------------------------------------------------------------- BEGIN { 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; }; do { my $SMIME = Crypt::SMIME->new; lives_ok { $SMIME->setPublicKey(crt('root')) } 'setPublicKey(ROOT)'; my $checked; lives_ok { $checked = $SMIME->check($signed) } 'check'; is($checked, $verified, '$verified eq check(sign($plain))'); }; Crypt-SMIME-0.10/lib004075500020030000144000000000001155373732300126045ustar phousersCrypt-SMIME-0.10/lib/SMIME004075500020030000144000000000001155373732300134565ustar phousersCrypt-SMIME-0.10/lib/SMIME/JA.pod010064400020030000144000000105311155370355000145230ustar phousers=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) 綽荀 =head2 ＜純 =over 4 =item new() my $smime = Crypt::SMIME->new(); 綣亥＜ =item setPrivateKey() $smime->setPrivateKey($key, $crt); $smime->setPrivateKey($key, $crt, $password); 腱絲泣荐絎ц┃絎腱絲泣臀峨緇垸 ＜ゃс究篏羝＜ 絲上若 PEM 帥泣茯粋昭帥紊掩翫die =item setPublicKey() $smime->setPublicKey($crt); $smime->setPublicKey([$crt1, $crt2, ...]); 泣荐絎ц┃絎泣臀峨吾羞私臀峨罎荐若 垸 絲上若 PEM 帥泣茯粋昭帥紊掩翫die =item sign() $signed_mime = $smime->sign($raw_mime); 臀峨茵MIME＜祉若吾菴純臀峨∝讐帥 C, C C ゃ multipart腱祉 C S/MIME茯茘с＜若, multipart 篆茘激＜祉若吾筝≦眼臀 =item signonly() $sign = $smime->signonly($prepared_mime); 臀峨荐膊茵 C<$sign> BASE64с潟潟若菴 C<$prepared_mime> , L цゃ羝＜ =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() $source_mime = $smime->check($signed_mime); 罎荐若茵罎荐若紊掩翫宴宴die =item encrypt() $encrypted_mime = $smime->encrypt($raw_mime); 垸茵 C, C C ゃ multipart潟若 C S/MIME茯茘с＜若, multipart 篆茘激＜祉若吾筝≦眼臀 =item decrypt() $decrypted_mime = $smime->decrypt($encrypted_mime); 緇垸茵緇垸紊掩翫宴宴die =item isSigned() $is_signed = $smime->isSigned($mime); 羝＜MIME＜祉若吾S/MIMEх讐菴 ∝讐 臀峨緇垸＜祉若吾羝＜翫臀峨贋･荀冴 純菴篋羈 =item isEncrypted() $is_encrypted = $smime->isEncrypted($mime); 羝＜MIME＜祉若吾S/MIMEф垸菴 垸緇臀峨＜祉若吾羝＜翫垽贋･荀冴 純菴篋羈 =back =head1 Copyright 2006-2007 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.10/lib/SMIME.pm010064400020030000144000000203351155373723700140770ustar phouserspackage Crypt::SMIME; use warnings; use strict; our $VERSION = '0.10'; require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); __PACKAGE__->_init; 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潟若違 # (FromToSubject膈) ($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?(.*)/) { 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) to work. =head2 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 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 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. =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. =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() $source_mime = $smime->check($signed_mime); Verify a signature of S/MIME message and return a MIME message. The method dies if it fails to verify it. =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. =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. =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 =head1 AUTHOR Copyright 2006-2007 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.10/SMIME.mlpod010064400020030000144000000167411155370323500140250ustar phousers =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) to work. J<< ja; S/MIME臀峨罎荐若垸緇垸茵鴻 libcrypto (L) 綽荀 >> =head2 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 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 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 篆茘激＜祉若吾筝≦眼臀 >> =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 цゃ羝＜ >> =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() $source_mime = $smime->check($signed_mime); Verify a signature of S/MIME message and return a MIME message. The method dies if it fails to verify it. J<< ja; 罎荐若茵罎荐若紊掩翫宴宴die >> =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 篆茘激＜祉若吾筝≦眼臀 >> =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 >> =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 =head1 AUTHOR Copyright 2006-2007 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.10/README010064400020030000144000000016101155370323500127630ustar phousersCrypt-SMIME The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Copyright (C) 2006-2007 Ymirlink This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Crypt-SMIME-0.10/Changes010064400020030000144000000020641155373702700134100ustar phousersRevision history for Crypt::SMIME 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.10/SMIME.pl010064400020030000144000000073401155373723000133220ustar phouserspackage Crypt::SMIME; use warnings; use strict; our $VERSION = '0.10'; require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); __PACKAGE__->_init; 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潟若違 # (FromToSubject膈) ($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?(.*)/) { 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.10/SMIME.xs010064400020030000144000000356501155373643200133510ustar phousers#include #include #include #include #include #include #include #include "EXTERN.h" #include "perl.h" #include "XSUB.h" struct crypt_smime { EVP_PKEY *priv_key; X509* priv_cert; const EVP_CIPHER* cipher; /* 垸, 羞私 */ STACK_OF(X509)* pubkeys_stack; /* 罎荐主 */ X509_STORE* pubkeys_store; }; typedef struct crypt_smime * Crypt_SMIME; #define OPENSSL_CROAK(description) \ croak("%s: %s", \ description, \ ERR_error_string(ERR_get_error(), NULL)) /* B64_write_PKCS7 is copyed from openssl/crypto/pkcs7/pk7_mime.c */ static int B64_write_PKCS7(BIO *bio, PKCS7 *p7) { BIO *b64; if(!(b64 = BIO_new(BIO_f_base64()))) { PKCS7err(PKCS7_F_B64_WRITE_PKCS7,ERR_R_MALLOC_FAILURE); return 0; } bio = BIO_push(b64, bio); i2d_PKCS7_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* raw) { BIO* inbuf; BIO* outbuf; PKCS7* pkcs7; int flags = PKCS7_DETACHED; BUF_MEM* bufmem; SV* result; int err; inbuf = BIO_new_mem_buf(raw, -1); if (inbuf == NULL) { return NULL; } /*∝讐篏 */ pkcs7 = PKCS7_sign(this->priv_cert, this->priv_key, NULL, inbuf, flags); if (pkcs7 == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { PKCS7_free(pkcs7); return NULL; } (void)BIO_reset(inbuf); { int i; for( i=0; i< sk_X509_num(this->pubkeys_stack); ++i ) { X509* x509 = sk_X509_value(this->pubkeys_stack,i); assert( x509!=NULL ); PKCS7_add_certificate(pkcs7, x509); } } err = SMIME_write_PKCS7(outbuf, pkcs7, inbuf, flags); PKCS7_free(pkcs7); BIO_free(inbuf); if (err != 1) { return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); return result; } static SV* signonly(Crypt_SMIME this, char* raw) { BIO* inbuf; BIO* outbuf; PKCS7* pkcs7; int flags = PKCS7_DETACHED; BUF_MEM* bufmem; SV* result; int err; inbuf = BIO_new_mem_buf(raw, -1); if (inbuf == NULL) { return NULL; } /*∝讐篏 */ pkcs7 = PKCS7_sign(this->priv_cert, this->priv_key, NULL, inbuf, flags); BIO_free(inbuf); if (pkcs7 == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { PKCS7_free(pkcs7); return NULL; } { int i; for( i=0; i< sk_X509_num(this->pubkeys_stack); ++i ) { X509* x509 = sk_X509_value(this->pubkeys_stack,i); assert( x509!=NULL ); PKCS7_add_certificate(pkcs7, x509); } } err = B64_write_PKCS7(outbuf, pkcs7); PKCS7_free(pkcs7); if (err != 1) { return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); return result; } static SV* check(Crypt_SMIME this, char* signed_mime) { BIO* inbuf; BIO* detached = NULL; BIO* outbuf; PKCS7* sign; int flags = 0; int err; BUF_MEM* bufmem; SV* result; inbuf = BIO_new_mem_buf(signed_mime, -1); if (inbuf == NULL) { return NULL; } sign = SMIME_read_PKCS7(inbuf, &detached); BIO_free(inbuf); if (sign == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { PKCS7_free(sign); return NULL; } err = PKCS7_verify(sign, NULL, this->pubkeys_store, detached, outbuf, flags); PKCS7_free(sign); if (detached != NULL) { BIO_free(detached); } if (err <= 0) { BIO_free(outbuf); return NULL; } BIO_get_mem_ptr(outbuf, &bufmem); result = newSVpv(bufmem->data, bufmem->length); BIO_free(outbuf); return result; } static SV* _encrypt(Crypt_SMIME this, char* raw) { BIO* inbuf; BIO* outbuf; PKCS7* enc; int flags = 0; int err; BUF_MEM* bufmem; SV* result; inbuf = BIO_new_mem_buf(raw, -1); if (inbuf == NULL) { return NULL; } enc = PKCS7_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) { PKCS7_free(enc); return NULL; } err = SMIME_write_PKCS7(outbuf, enc, NULL, flags); PKCS7_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); return result; } static SV* _decrypt(Crypt_SMIME this, char* encrypted_mime) { BIO* inbuf; BIO* outbuf; PKCS7* enc; int flags = 0; int err; BUF_MEM* bufmem; SV* result; inbuf = BIO_new_mem_buf(encrypted_mime, -1); if (inbuf == NULL) { return NULL; } enc = SMIME_read_PKCS7(inbuf, NULL); BIO_free(inbuf); if (enc == NULL) { return NULL; } outbuf = BIO_new(BIO_s_mem()); if (outbuf == NULL) { PKCS7_free(enc); return NULL; } err = PKCS7_decrypt(enc, this->priv_key, this->priv_cert, outbuf, flags); PKCS7_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); return result; } static void seed_rng() { RAND_poll(); while (RAND_status() == 0) { long seed = random(); RAND_seed(&seed, sizeof(long)); } } MODULE = Crypt::SMIME PACKAGE = Crypt::SMIME void _init(char* /*CLASS*/) CODE: /* libcrypto */ ERR_load_crypto_strings(); SSLeay_add_all_algorithms(); seed_rng(); Crypt_SMIME new(char* /*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_free(this->pubkeys_stack); } if (this->pubkeys_store) { X509_STORE_free(this->pubkeys_store); } safefree(this); SV* setPrivateKey(Crypt_SMIME this, char* pem, char* crt, ...) PROTOTYPE: $$$;$ PREINIT: char* password = ""; STRLEN n_a; CODE: if (items > 3) { password = (char*)SvPV(ST(3), n_a); } /* ゃ泣ｃ羔 */ 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"); } 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_free(this->pubkeys_stack); 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#new: 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)"); } 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 (SvPOK(*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 (SvPOK(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_get_error()) == PEM_R_NO_START_LINE) { break; } else { BIO_free(buf); OPENSSL_CROAK("Crypt::SMIME#setPublicKey: failed to load the public cert"); } } 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"); } pub_cert = X509_dup(pub_cert); if (pub_cert == NULL) { BIO_free(buf); OPENSSL_CROAK("Crypt::SMIME#setPublicKey: failed to duplicate the X509 structure"); } 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); SV* _sign(Crypt_SMIME this, char* raw) 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, raw); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#sign: failed to sign the message"); } OUTPUT: RETVAL SV* _signonly(Crypt_SMIME this, char* raw) 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, raw); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#signonly: failed to sign the message"); } OUTPUT: RETVAL SV* _encrypt(Crypt_SMIME this, char* raw) CODE: /* 泣障祉違 */ if (this->pubkeys_stack == NULL) { croak("Crypt::SMIME#encrypt: public cert has not yet been set. Set one before encrypting"); } /* cipher障＜域┃絎 */ if (this->cipher == NULL) { this->cipher = EVP_des_ede3_cbc(); } RETVAL = _encrypt(this, raw); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#encrypt: failed to encrypt the message"); } OUTPUT: RETVAL SV* check(Crypt_SMIME this, char* signed_mime) CODE: /* 泣障祉違 */ if (this->pubkeys_store == NULL) { croak("Crypt::SMIME#check: public cert has not yet been set. Set one before checking"); } RETVAL = check(this, signed_mime); if (RETVAL == NULL) { OPENSSL_CROAK("Crypt::SMIME#check: failed to check the signature"); } OUTPUT: RETVAL SV* decrypt(Crypt_SMIME this, char* 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, 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 # ----------------------------------------------------------------------------- # End of File. # ----------------------------------------------------------------------------- Crypt-SMIME-0.10/MANIFEST.SKIP010064400020030000144000000002471155370323500140060ustar phousers~$ \.tar\.gz$ (^|/)\.svn(/|$) ^\.hg(/|$) ^\.hgignore$ ^blib(/|$) ^Makefile$ ^Makefile\.old$ ^MANIFEST\.bak$ ^MEMO\.txt$ ^pm_to_blib$ ^SMIME\.bs$ ^SMIME\.c$ ^SMIME\.o$ Crypt-SMIME-0.10/openssl_config.PL010064400020030000144000000024511155370323500153540ustar phousers# ----------------------------------------------------------------------------- # $Id: openssl_config.PL 4705 2007-09-21 10:21:56Z pho $ # ----------------------------------------------------------------------------- use strict; 1; sub openssl_config { my $OPENSSL = shift; $OPENSSL ||= { LIBS => $ENV{LDFLAGS} || '', CFLAGS => $ENV{CFLAGS} || '', }; if ($^O eq 'MSWin32') { _openssl_config_win32($OPENSSL); } else { # FIXME: pkg-config 篏帥鴻 $OPENSSL->{LIBS} .= " -lcrypto"; } $OPENSSL->{LIBS} =~ s/^ +//; $OPENSSL; } sub _openssl_config_win32 { my $OPENSSL = shift; my $openssl_path='c:/openssl'; if( -e $openssl_path && -x "$openssl_path/bin/openssl.exe" ) { $OPENSSL->{CFLAGS} .= " -I$openssl_path/include"; use Config; if( -e "$openssl_path/lib/vc" && $Config{cc} eq 'cl' && $Config{ccflags}=~/-(M[DLT])\b/ ) { $OPENSSL->{LIBS} .= " -L$openssl_path/lib/vc -lssleay32$1 -llibeay32$1"; }else { $OPENSSL->{LIBS} .= " -L$openssl_path/lib -lssleay32 -llibeay32"; } return; } } # ----------------------------------------------------------------------------- # End of File. # ----------------------------------------------------------------------------- Crypt-SMIME-0.10/Makefile.PL010064400020030000144000000030701155370323500140570ustar phousersuse strict; use warnings; use ExtUtils::MakeMaker; require 'openssl_config.PL'; my $OPENSSL = &openssl_config(); WriteMakefile( NAME => 'Crypt::SMIME', AUTHOR => 'Ymirlink ', VERSION_FROM => 'SMIME.pl', ABSTRACT => 'S/MIME message signing, verification, encryption and decryption', PL_FILES => {}, PREREQ_PM => { 'Test::Exception' => 0, 'Test::More' => 0, 'XSLoader' => 0, }, LIBS => "$OPENSSL->{LIBS}", INC => "$OPENSSL->{CFLAGS}", dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Crypt-SMIME-* SMIME.pod', }, 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\n" . "\tmkdir -p lib\n" . "\tcat SMIME.pl > \$\@\n" . "\techo >> \$\@\n" . "\techo __END__ >> \$\@\n" . "\techo >> \$\@\n" . "\tcat 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/' > \$\@", }, ); Crypt-SMIME-0.10/META.yml010064400020030000144000000011651155373732300133660ustar phousers--- #YAML:1.0 name: Crypt-SMIME version: 0.10 abstract: S/MIME message signing, verification, encryption and decryption author: - Ymirlink license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Test::Exception: 0 Test::More: 0 XSLoader: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Crypt-SMIME-0.10/typemap010064400020030000144000000010641155370323500135100ustar phousersTYPEMAP 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.10/SMIME.pod010064400020030000144000000107631155373714000134740ustar phousers=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) to work. =head2 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 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 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. =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. =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() $source_mime = $smime->check($signed_mime); Verify a signature of S/MIME message and return a MIME message. The method dies if it fails to verify it. =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. =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. =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 =head1 AUTHOR Copyright 2006-2007 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.10/MANIFEST010064400020030000144000000004411155373732300132420ustar phousersChanges lib/SMIME.pm lib/SMIME/JA.pod Makefile.PL MANIFEST This list of files MANIFEST.SKIP openssl_config.PL README SMIME.mlpod SMIME.pl SMIME.pod SMIME.xs t/chained-certs.t t/smime.more.t t/smime.t typemap META.yml Module meta-data (added by MakeMaker)