view release on metacpan or  search on metacpan

SMIME.pl  view on Meta::CPAN

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

        CRL_CHECK
        CRL_CHECK_ALL
       )]
   );
Exporter::export_ok_tags('constants');

our $VERSION = '0.33';

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('_sign', $mime);
}

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;
	# The man page of CMS_encrypt(3) recommends DES-EDE3-CBC
	# for interoperability but it can no longer be considered
	# to be a safe algorithm. We use AES-128-CBC instead.
	my $cipher = shift // "AES-128-CBC";

	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('_encrypt', $mime, $cipher);
}

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="?(?:authE|e)nveloped-data"?!)) {
		# smime-typeが存在しないか、それがenveloped-dataである。
		1;
	} else {
		undef;
	}
}

sub _moveHeaderAndDo {
	my $this = shift;
	my $method = shift;
	my $mime = shift;
	my @args = @_;

	# Content- または MIME- で始まるヘッダはそのままに、
	# それ以外のヘッダはmultipartのトップレベルにコピーしなければならない。