#!/usr/bin/perl
#
# EdelStamp (C) 2000-2016, ON-X, All rights reserved.
# Author: Peter Sylvester <peter.sylvester@gmail.com>
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Function: Create RFC 3161 time stamps
# Runs as CGI when REQUEST_METHOD is present.
#
# Input: The program needs three environment variables:
# TSAKeyFile name of a pem encoded RS private key
# TSACertificateFile name of a der encoded certficate for the key
# TSAPolicy a list of dot separated numbers
#
# If the program finds REQUEST_METHOD, httpd context is assumed
# program reads a time stamp request from STDIN
# The REQUEST_METHOD must be POST
#
# Output: A time stamp response (if http response is 200) to STDOUT.
# if under http context headers are prepended.
# Not details of errors are provided when status=2=rejected
#
# Errors: Error details are written to STDERR and can be written to Syslog in
# and httpd context:
# Environement varibles SyslogOptions and SyslogFacility are used for parameterization
# See perl module Sys::Syslog fpr details
# Notes: Policy on input is ignored, hash algorithms are not checked and copied as is.
# Since the maximim size of a request is limited, it is unlikely that a request
# contains the data instead of a hash.
# Example: The following example are for the apache httpd server configuration
#
# ScriptAlias "/tsa/" "/var/www/cgi-bin/"
# <Directory "/var/www/cgi-bin">
# AllowOverride None
# Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch
# Require all granted
# SetEnv TSACertificateFile /etc/apache2/pki/TSA.der
# SetEnv TSAKeyFile /etc/apache2/pki/TSA.key
# SetEnv TSAPolicy 1.2.3.4.1
# SetEnv TSATimeout 15
# SetEnv TSARequestLimit 500
# SetEnv SyslogOptions "nofatal,ndelay,pid"
# SetEnv SyslogFacility "user"
# </Directory>
use strict;
use warnings;
use Convert::ASN1;
use Time::HiRes;
use Digest::SHA qw(sha256 sha1);
use Crypt::OpenSSL::RSA;
#{status=> {status=>2}} hard coded.
my $rejected = "\x30\x05\x30\x03\x02\x01\x02";
binmode(STDOUT);
binmode(STDIN);
binmode(STDERR,':utf8');
# we like to test out a web server.
my $HTTP = defined $ENV{'REQUEST_METHOD'} ;
# and we can do syslog
my $SYSLOG = ($HTTP && defined $ENV{'SyslogOptions'});
if ($SYSLOG) {
use Sys::Syslog ;
$ENV{'SyslogFacility'} = 'user' unless $ENV{'SyslogFacility'} ;
openlog('EdelStamp', $ENV{'SyslogOptions'}, $ENV{'SyslogFacility'}) or dieif(1,'Cannot open Syslog');
}
print "Content-Type: application/timestamp-response\n"
."Content-Transfer-Encoding: binary\n" if $HTTP;
# To be or not to be sorry
sub dieif {
my ($cond,$text) = @_;
return unless $cond;
print "Content-Length: ".length($rejected)."\n\n" if $HTTP;
print $rejected;
print STDERR "$text\n";
syslog("info", $ENV{'REMOTE_ADDR'} . " $text") if $SYSLOG;
exit ;
}
# To leave some traces
sub log {
my ($text) = @_;
print STDERR "$text\n";
syslog("info", $ENV{'REMOTE_ADDR'} . " $text") if $SYSLOG;
}
# Ok, start parse the ASN. It would be nice to have them directly.
my $asn = Convert::ASN1->new;
$asn->prepare(q<
TimeStampReq ::= SEQUENCE {
version INTEGER ,
messageImprint MessageImprint,
reqPolicy TSAPolicyId OPTIONAL,
nonce INTEGER OPTIONAL,
certReq BOOLEAN OPTIONAL,
extensions [0] IMPLICIT Extensions OPTIONAL
}
MessageImprint ::= SEQUENCE {
hashAlgorithm AlgorithmIdentifier,
hashedMessage OCTET STRING }
AlgorithmIdentifier ::= SEQUENCE {
algorithm OBJECT IDENTIFIER,
parameters NULL }
TSAPolicyId ::= OBJECT IDENTIFIER
Extensions ::= SEQUENCE OF Extension
Extension ::= SEQUENCE {
extnID OBJECT IDENTIFIER,
critical BOOLEAN OPTIONAL,
extnValue OCTET STRING }
TimeStampResp ::= SEQUENCE {
status PKIStatusInfo,
timeStampToken TimeStampToken OPTIONAL }
PKIStatusInfo ::= SEQUENCE {
status PKIStatus,
statusString PKIFreeText OPTIONAL,
failInfo PKIFailureInfo OPTIONAL }
PKIStatus ::= INTEGER
PKIFailureInfo ::= BIT STRING
PKIFreeText ::= SEQUENCE OF UTF8String
TimeStampToken ::= SEQUENCE {
contentType ContentType,
content [0] EXPLICIT SignedData }
ContentType ::= OBJECT IDENTIFIER
TSTInfo ::= SEQUENCE {
version INTEGER ,
policy TSAPolicyId,
messageImprint MessageImprint,
serialNumber INTEGER,
genTime GeneralizedTime,
accuracy Accuracy OPTIONAL,
ordering BOOLEAN OPTIONAL,
nonce INTEGER OPTIONAL,
tsa [0] GeneralName OPTIONAL,
extensions [1] IMPLICIT Extensions OPTIONAL
}
Accuracy ::= SEQUENCE {
seconds INTEGER OPTIONAL,
millis [0] INTEGER OPTIONAL,
micros [1] INTEGER OPTIONAL
}
Attribute ::= SEQUENCE {
type AttributeType,
values SET OF AttributeValue
}
AttributeType ::= OBJECT IDENTIFIER
AttributeValue ::= ANY
AttributeTypeAndValue ::= SEQUENCE {
type AttributeType,
value AttributeValue
}
Name ::= CHOICE { -- only one possibility for now
rdnSequence RDNSequence
}
RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
DistinguishedName ::= RDNSequence
RelativeDistinguishedName ::=
SET OF AttributeTypeAndValue --SET SIZE (1 .. MAX) OF
DirectoryString ::= CHOICE {
teletexString TeletexString, --(SIZE (1..MAX)),
printableString PrintableString, --(SIZE (1..MAX)),
bmpString BMPString, --(SIZE (1..MAX)),
universalString UniversalString, --(SIZE (1..MAX)),
utf8String UTF8String, --(SIZE (1..MAX)),
ia5String IA5String --added for EmailAddress
}
Certificate ::= SEQUENCE {
tbsCertificate TBSCertificate,
signatureAlgorithm AlgorithmIdentifier,
signature BIT STRING
}
TBSCertificate ::= SEQUENCE {
version [0] EXPLICIT Version OPTIONAL, --DEFAULT v1
serialNumber CertificateSerialNumber,
signature AlgorithmIdentifier,
issuer Name,
validity Validity,
subject Name,
subjectPublicKeyInfo SubjectPublicKeyInfo,
issuerUniqueID [1] IMPLICIT UniqueIdentifier OPTIONAL,
-- If present, version shall be v2 or v3
subjectUniqueID [2] IMPLICIT UniqueIdentifier OPTIONAL,
-- If present, version shall be v2 or v3
extensions [3] EXPLICIT Extensions OPTIONAL
-- If present, version shall be v3
}
Version ::= INTEGER --{ v1(0), v2(1), v3(2) }
CertificateSerialNumber ::= INTEGER
Validity ::= SEQUENCE {
notBefore Time,
notAfter Time
}
UniqueIdentifier ::= BIT STRING
SubjectPublicKeyInfo ::= SEQUENCE {
algorithm AlgorithmIdentifier,
subjectPublicKey BIT STRING
}
AlgorithmIdentifier ::= SEQUENCE {
algorithm OBJECT IDENTIFIER,
parameters ANY
}
GeneralNames ::= SEQUENCE OF GeneralName
GeneralName ::= CHOICE {
otherName [0] AnotherName,
rfc822Name [1] IA5String,
dNSName [2] IA5String,
x400Address [3] ANY, --ORAddress,
directoryName [4] Name,
ediPartyName [5] EDIPartyName,
uniformResourceIdentifier [6] IA5String,
iPAddress [7] OCTET STRING,
registeredID [8] OBJECT IDENTIFIER }
AnotherName ::= SEQUENCE {
type OBJECT IDENTIFIER,
value [0] EXPLICIT ANY } --DEFINED BY type-id }
EDIPartyName ::= SEQUENCE {
nameAssigner [0] DirectoryString OPTIONAL,
partyName [1] DirectoryString }
IssuerAltName ::= GeneralNames
SubjectDirectoryAttributes ::= SEQUENCE OF Attribute
EncapsulatedContentInfo ::= SEQUENCE {
eContentType ContentType,
eContent [0] EXPLICIT OCTET STRING OPTIONAL }
ContentType ::= OBJECT IDENTIFIER
CMSVersion ::= INTEGER
DigestAlgorithmIdentifiers ::= SET OF DigestAlgorithmIdentifier
DigestAlgorithmIdentifier ::= AlgorithmIdentifier
SignerInfo ::= SEQUENCE {
version CMSVersion,
sid SignerIdentifier,
digestAlgorithm DigestAlgorithmIdentifier,
signedAttrs [0] IMPLICIT SignedAttributes OPTIONAL,
signatureAlgorithm SignatureAlgorithmIdentifier,
signature SignatureValue,
unsignedAttrs [1] IMPLICIT UnsignedAttributes OPTIONAL }
SignerIdentifier ::= CHOICE {
issuerAndSerialNumber IssuerAndSerialNumber,
subjectKeyIdentifier [0] OCTET STRING }
SignatureAlgorithmIdentifier ::= AlgorithmIdentifier
SignedAttributes ::= SET OF ANY
UnsignedAttributes ::= SET OF ANY
CMSAttribute ::= SEQUENCE {
attrType OBJECT IDENTIFIER,
attrValues SET OF CMSAttributeValue }
CMSAttributeValue ::= ANY
SignatureValue ::= OCTET STRING
IssuerAndSerialNumber ::= SEQUENCE {
issuer Name,
serialNumber CertificateSerialNumber }
CertificateSerialNumber ::= INTEGER
SigningTime ::= Time
Time ::= CHOICE {
utcTime UTCTime,
generalTime GeneralizedTime }
MessageDigest ::= OCTET STRING
SignedData ::= SEQUENCE {
version CMSVersion,
digestAlgorithms DigestAlgorithmIdentifiers,
encapContentInfo EncapsulatedContentInfo,
certificates [0] IMPLICIT CertificateSet OPTIONAL,
-- crls [1] IMPLICIT RevocationInfoChoices OPTIONAL,
signerInfos SignerInfos }
DigestAlgorithmIdentifiers ::= SET OF DigestAlgorithmIdentifier
SignerInfos ::= SET OF SignerInfo
CertificateSet ::= SET OF CertificateChoices
SigningCertificate ::= SEQUENCE {
certs SEQUENCE OF ESSCertID,
policies SEQUENCE OF PolicyInformation OPTIONAL }
PolicyInformation ::= SEQUENCE {
policyIdentifier CertPolicyId,
policyQualifiers SEQUENCE OF
PolicyQualifierInfo } --OPTIONAL }
CertPolicyId ::= OBJECT IDENTIFIER
PolicyQualifierInfo ::= SEQUENCE {
policyQualifierId PolicyQualifierId,
qualifier ANY } --DEFINED BY policyQualifierId }
PolicyQualifierId ::=
OBJECT IDENTIFIER --( id-qt-cps | id-qt-unotice )
-- CPS pointer qualifier
CPSuri ::= IA5String
-- user notice qualifier
UserNotice ::= SEQUENCE {
noticeRef NoticeReference OPTIONAL,
explicitText DisplayText OPTIONAL}
NoticeReference ::= SEQUENCE {
organization DisplayText,
noticeNumbers SEQUENCE OF INTEGER }
DisplayText ::= CHOICE {
visibleString VisibleString ,
bmpString BMPString ,
utf8String UTF8String }
ESSCertID ::= SEQUENCE {
certHash OCTET STRING, -- SHA1 hash of entire certificate
issuerSerial IssuerSerial OPTIONAL }
IssuerSerial ::= SEQUENCE {
issuer GeneralNames,
serialNumber CertificateSerialNumber }
CertificateChoices ::= CHOICE {
certificate ANY -- we already have it encoded
-- v2AttrCert [2] IMPLICIT AttributeCertificateV2,
-- other [3] IMPLICIT OtherCertificateFormat
}
>) or &dieif(1, "Bad ASN1 definitions: " . $asn->error) ;
# a little helper
sub asnfind {
my ($macro) = @_;
my $asn_macro = $asn->find($macro) or &dieif(1,"No ASN1 syntax for '$macro'");
return $asn_macro;
}
# can we give a response?
my $asn_resp = &asnfind('TimeStampResp');
$asn_resp->configure('encoding','DER');
# can we parse?
my $asn_tspreq = &asnfind('TimeStampReq');
&dieif(!$HTTP || $ENV{CONTENT_TYPE} ne 'application/timestamp-query',"Invalid content type received");
&dieif(!$HTTP || $ENV{'REQUEST_METHOD'} ne 'POST',"Request Method is not POST");
# 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});
my $CMSAttribute={attrType=>'1.2.840.113549.1 9.16.2.12', attrValues=>$l};
push @CMSAttributeList,$CMSAttribute_asn->encode($CMSAttribute);
}
my @SortedAttributes = sort @CMSAttributeList; # needed for DER, just to be sure.
my $CMSAttributes_asn = &asnfind('SignedAttributes') ;
my $TBSattrs=$CMSAttributes_asn->encode(\@SortedAttributes) or &dieif(1,$CMSAttributes_asn->error());
# create and sign a signerinfo
$tsa_key->use_sha256_hash();
my $SignerInfos=[]; $SignerInfos->[0] = {
version =>1,
digestAlgorithm=>$DigestAlgorithmIdentifiers->[0],
sid=>{issuerAndSerialNumber=>{issuer=>$tsa_cert->{'tbsCertificate'}->{'issuer'},
serialNumber=>$tsa_cert->{'tbsCertificate'}->{'serialNumber'},}},
signedAttrs=>\@SortedAttributes,
signatureAlgorithm=>$DigestAlgorithmIdentifiers->[0],
signature=>$tsa_key->sign($TBSattrs),
};
# finish the token and response
my $CertificateSet=[]; $CertificateSet->[0]={certificate=>$tsa_cert_asn};
my $TimeStampToken={
contentType=>'1 2 840 113549 1 7 2',
content=>{
version=>3,
digestAlgorithms=>$DigestAlgorithmIdentifiers,
encapContentInfo=>{
eContentType=>'1.2.840.113549.1.9.16.1.4',
eContent=>$tstinfostr
},
certificates=>$CertificateSet,
signerInfos=>$SignerInfos,
}};
my $response = $asn_resp->encode({status=> {status=>0},timeStampToken=>$TimeStampToken}) or &dieif(1,"Cannot create Timestampresponse");
print STDOUT "Content-Disposition: Attachment; filename=$now-$$.tsr\n";
print STDOUT "Content-Length:" .length($response) . "\n\n" if $HTTP; print STDOUT $response;
my $messageImprint_asn = &asnfind('MessageImprint');
my $messageImprint= $messageImprint_asn->encode($tspreq->{'messageImprint'}) or &dieif(1,$messageImprint_asn->error());
&log('ReceivedHash ' . unpack('H*', $messageImprint) . ' SignedAtributes ' . unpack("H*",$TBSattrs) ) ;
# This is the end (for now)
Generated by dwww version 1.15 on Sat May 18 06:08:27 CEST 2024.