view release on metacpan or  search on metacpan

lib/Convert/X509/minipkcs7.pm  view on Meta::CPAN

and correspondent crypto-algorithmes

=head1 SYNOPSYS

 use Convert::X509::minipkcs7;
 use Data::Dumper;

 open(F,'<', $ARGV[0]) or die;
 binmode(F);
 local $/;
 my $data=Convert::X509::minipkcs7->new(<F>);
 print Dumper($data->snlist());
        
=cut

use strict;
use warnings;
use Convert::ASN1;
use MIME::Base64;

my %oid_db=(
   'PKCS7'	=> { 'asn'=>'ContentInfo' },
	'1.2.840.113549.1.7.1'	=> { 'asn'=>'Data' },
	'1.2.840.113549.1.7.2'	=> { 'asn'=>'SignedData' },
	'1.2.840.113549.1.7.3'	=> { 'asn'=>'EnvelopedData' },
	'1.2.840.113549.1.7.4'	=> { 'asn'=>'SignedAndEnvelopedData' },
	'1.2.840.113549.1.7.5'	=> { 'asn'=>'DigestedData' },
	'1.2.840.113549.1.7.6'	=> { 'asn'=>'EncryptedData' },
);

my $asn;

sub _prepare {
  my ($pdata) = @_;
  warn ('Parameter must be a scalar ref') && return undef unless ref($pdata) eq 'SCALAR';
  # first bytes for ASN.1 SEQUENCE are 3080 or 3082
  unless (unpack('H3',$$pdata) eq '308'){
    $$pdata = decode_base64(
      join("\n",
        $$pdata =~ m!^([A-Za-z01-9+/]{1,})[-=]*$!gm
      )
    );
  }
}

sub _int2hexstr {
  my $res='';
  my $m=$_[0];
  while ($m){
	  $res = unpack('H2',pack('C', $m & 255 )) . $res;
	  $m >>= 8;
  }
  return $res;
}

sub _decode {
  warn ("Error\n",$asn->error,"\nin ASN.1 code\n") && return undef if $asn->error;
  my $type = shift;
  my $node= $asn->find( $oid_db{uc($type)}->{'asn'} || 'Any' );
  warn ('Error finding ',$type,'-', $oid_db{uc($type)}->{'asn'}, ' in module',"\n") && return undef unless $node;
  my @decoded = map {$node->decode($_)} @_;
  return ( @_ > 1 ? [@decoded] : $decoded[0] )
}

sub snlist {
	my ($self) = @_;
	my $res = { }; # {'recipients'=>[],'signers'=>[]};
	if (exists $self->{'content'}{'signerInfos'}){
		@{ $res->{'signers'} } =
			map{
			 {_int2hexstr( $_->{'issuerAndSerialNumber'}{'serialNumber'} ) =>
			 $_->{'digestAlgorithm'}{'algorithm'} }
			}
			@{ $self->{'content'}{'signerInfos'} }
		;
#		for (@{ $self->{'content'}{'signerInfos'} }) {
#			push @{ $res->{'signers'} },
#			 _int2hexstr( $_->{'issuerAndSerialNumber'}{'serialNumber'} );
	}
	if (exists $self->{'content'}{'recipientInfos'}){
	for (@{ $self->{'content'}{'recipientInfos'}{'riSet'} }) {
		my ($kkey) = keys %$_; # RecipientInfo is "CHOICE", so there is only one key

		my $k = $_->{$kkey}{'self'} || $_->{$kkey};
		# damn Signalcom again...

		my $e;
		# known cases
		# case one - keyAgreementRecipientInfo
		$e = (exists $k->{'recipientEncryptedKeys'} ?
			_int2hexstr(
			$k->{'recipientEncryptedKeys'}[0]{'recipientIdentifier'}
			 {'issuerAndSerialNumber'}{'serialNumber'}
			# I don't have any reason to "foreach" in two those lists ([0] and [0] above)
			) : undef
		);
		push @{ $res->{'recipients'} },
		 {$e=>$k->{'keyEncryptionAlgorithm'}{'algorithm'}} if($e);

		# case two - keyTransportRecipientInfo
		$e = (exists $k->{'rid'} ?
			_int2hexstr($k->{'rid'}{'issuerAndSerialNumber'}{'serialNumber'})
			: undef);
		push @{ $res->{'recipients'} },
		 {$e=>$k->{'keyEncryptionAlgorithm'}{'algorithm'}} if($e);
	}
	}
  return $res;
}

sub new {
	my $self={};
	my $class = shift;
	my $pdata = (ref($_[0]) ? $_[0] : \$_[0]);
	my (undef, $debug) = @_;
	_prepare($pdata);
	unless (unpack('H3',$$pdata) eq '308'){
		warn ('Seems to be not PKCS7 data',"\n") if $debug;
		return undef;
	}
	$self = _decode('pkcs7'=>$$pdata);
	unless ($self){