view release on metacpan or  search on metacpan

examples/tsa3161  view on Meta::CPAN

# requests are small, we don't want large files here and we timeout, 
# we don't care about contentlength

my $cnt=$ENV{'TSATimeout'}+0; $cnt=15 unless $cnt>2 && $cnt<120;
my $limit=$ENV{'TSARequestLimit'}+0; $limit=300 unless $limit>5 && $cnt<20000;

# normally a request comes in one packet, but we never know.
my $pdu='';
while ($cnt-- >0) {
   my $asn_tspreq = &asnfind('TimeStampReq');
   my $next;
   read STDIN, $next, $limit;  
   if ($next eq '') {
      sleep(1); 
   } else {
      $pdu .= $next; 
      &dieif(($cnt <= 0),"Timeout");
      &dieif((length($pdu)>$limit),"Request too long");
      my $tspreq = $asn_tspreq->decode($pdu);
   }
   last unless $asn_tspreq->error() ;
}

my $tspreq = $asn_tspreq->decode($pdu);
&dieif($asn_tspreq->error(),'Invalid request');
&dieif($tspreq->{'version'} != 1,'Invalid version');

# get policy, cert and key
{
   &dieif(!$ENV{'TSAPolicy'});
   my $asn_policyid=&asnfind('TSAPolicyId'); 
   $asn_policyid->encode($ENV{'TSAPolicy'});
   &dieif($asn_policyid->error(),"Invalid TSAPolicy syntax");
} 
my $tsa_cert;
my $tsa_cert_asn;
my $certDigest;
  { # get certificate
	my $filename = $ENV{'TSACertificateFile'} or &dieif(1, "Missing environment variable 'TSACertificateFile'");
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks) = stat $filename;
	open TSACERT, "<$filename" or &dieif(1, "cannot open TSACertificateFile '$filename'");
	binmode TSACERT;
	read TSACERT, $tsa_cert_asn, $size;
	close TSACERT;
        $certDigest=sha1($tsa_cert_asn);
	my $asn_cert=&asnfind('Certificate'); 
	$tsa_cert = $asn_cert->decode( $tsa_cert_asn) or &dieif(1, $asn_cert->error());
  }
my $tsa_key;
  { # get key
	my $filename = $ENV{'TSAKeyFile'} or &dieif(1, "Missing environment variable 'TSAKeyFile'");;
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks) = stat $filename;
	open TSAKEY, "<$filename" or &dieif(1,"cannot open TSAKeyFile '$filename'");
	binmode TSAKEY;
        my $tsa_key_pem;
	read TSAKEY, $tsa_key_pem, $size;  
	close TSAKEY;
        $tsa_key = Crypt::OpenSSL::RSA->new_private_key($tsa_key_pem) or &dieif(1,"TSAKeyFile '$filename' cannot be decoded");
  }

# some magic
my $time = Time::HiRes::gettimeofday() ;
my $now = int($time);
my $serial = ($time-1288070000)*1000000*100000 +$$;
my $TSTInfo_asn = &asnfind('TSTInfo');
$TSTInfo_asn->configure('encoding','DER');
$TSTInfo_asn->configure('encode',{time=>'withzone'});
$TSTInfo_asn->configure('encode',{timezone=>0});

# TBD: Add whatever logic you want to fill the TSTInfo, e.g. accurancy, take policy from input.
# check the validity of the digest, OIDs + length. 

my $tstinfo = {
      version=>1, 
      policy=>$ENV{'TSAPolicy'},
      messageImprint=> $tspreq->{'messageImprint'},
      genTime=>$now,
      serialNumber=>$serial,
      tsa=>{directoryName=>$tsa_cert->{'tbsCertificate'}->{'subject'}}
};
$tstinfo->{'nonce'} = $tspreq->{'nonce'} if defined $tspreq->{'nonce'};

# encode the content
my $tstinfostr=$TSTInfo_asn->encode($tstinfo) || &dieif(1,"Cannot encode TSTINFO:" .$TSTInfo_asn->error()); 

# and hash it with sha256

my $DigestAlgorithmIdentifiers=[];
$DigestAlgorithmIdentifiers->[0]={algorithm=>'2 16 840 1 101 3 4 2 1',parameters=>"\x05\x00"};
my $DigestAlgorithmIdentifiers_asn = &asnfind('DigestAlgorithmIdentifiers') ;
my $contentDigest=sha256($tstinfostr);

# encode message attributes

my @CMSAttributeList;
my $CMSAttribute_asn = &asnfind('CMSAttribute'); 
  {
     my $CMSAttributevalue_asn = &asnfind('ContentType');
     my $l = []; $l->[0] = $CMSAttributevalue_asn->encode('1.2.840.113549.1.9.16.1.4');
     my $CMSAttribute={attrType=>'1.2.840.113549.1.9.3', attrValues=>$l};
     push @CMSAttributeList,$CMSAttribute_asn->encode($CMSAttribute); 
  }
  {
     my $CMSAttributevalue_asn = &asnfind('SigningTime') ;
     my $l = []; $l->[0] = $CMSAttributevalue_asn->encode(generalTime=>$now);
     my $CMSAttribute={attrType=>'1.2.840.113549.1.9.5', attrValues=>$l};
     push @CMSAttributeList,$CMSAttribute_asn->encode($CMSAttribute); 
  }
  {
     my $CMSAttributevalue_asn = &asnfind('MessageDigest') ;
     my $l = []; $l->[0] = $CMSAttributevalue_asn->encode($contentDigest);
     my $CMSAttribute={attrType=>'1.2.840.113549.1.9.4', attrValues=>$l};
     push @CMSAttributeList,$CMSAttribute_asn->encode($CMSAttribute); 
  }
  {
     my $CMSAttributevalue_asn = &asnfind('SigningCertificate') ;
     my $SC=[]; $SC->[0] = {certHash=>$certDigest};
     my $l = []; $l->[0] = $CMSAttributevalue_asn->encode({certs=>$SC});