#
# Copyright (c) 2005-2009 Nokia Corporation and/or its subsidiary(-ies).
# All rights reserved.
# This component and the accompanying materials are made available
# under the terms of the License "Eclipse Public License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
#
# Initial Contributors:
# Nokia Corporation - initial contribution.
#
# Contributors:
#
# Description:
# Basic ASN.1 encoding library
# Some parts of this program requrie OpenSSL which may be freely downloaded
# from www.openssl.org
#
#!/bin/perl -w
use strict;
use Digest::HMAC_MD5;
use Digest::HMAC_SHA1;
use Getopt::Long;
# 0 = off
# 1 = log parsing
# 2 = log parsing + encoding
# 3 = really verbose stuff
my $DEBUG=0;
# Turn on validation checks that attempt to only generate
# valid DER encodings.
my $VALIDATE=0;
my $OID_PKCS = "1.2.840.113549.1";
my $OID_PKCS7 ="${OID_PKCS}.7";
my $OID_PKCS9 = "${OID_PKCS}.9";
my $OID_PKCS9_CERTTYPES = "${OID_PKCS9}.22";
my $OID_PKCS12 = "${OID_PKCS}.12";
my $OID_PKCS12_BAGTYPES = "${OID_PKCS12}.10.1";
my $OID_PKCS12_PBEIDS = "${OID_PKCS12}.1";
my %OIDS =
(
"MD5" => "1.2.840.113549.2.5",
"SHA1" => "1.3.14.3.2.26",
"X509CRL" => "1.3.6.1.4.1.3627.4",
"PKCS7_DATA" => "${OID_PKCS7}.1",
"PKCS7_SIGNEDDATA" => "${OID_PKCS7}.2",
"PKCS7_ENVELOPEDDATA" => "${OID_PKCS7}.3",
"PKCS7_SIGNEDANDENVELOPEDDATA" => "${OID_PKCS7}.4",
"PKCS7_DIGESTEDDATA" => "${OID_PKCS7}.5",
"PKCS7_ENCRYPTEDDATA" => "${OID_PKCS7}.6",
"PKCS9_CERTTYPES_PKCS12_X509" => "${OID_PKCS9_CERTTYPES}.1",
"PKCS9_FRIENDLY_NAME" => "${OID_PKCS9}.20",
"PKCS9_LOCAL_KEYID" => "${OID_PKCS9}.21",
"PKCS12_BAGTYPES_KEYBAG" => "${OID_PKCS12_BAGTYPES}.1",
"PKCS12_BAGTYPES_PKCS8SHROUDEDKEYBAG" => "${OID_PKCS12_BAGTYPES}.2",
"PKCS12_BAGTYPES_CERTBAG" => "${OID_PKCS12_BAGTYPES}.3",
"PKCS12_BAGTYPES_CRLBAG" => "${OID_PKCS12_BAGTYPES}.4",
"PKCS12_BAGTYPES_SECRETBAG" => "${OID_PKCS12_BAGTYPES}.5",
"PKCS12_BAGTYPES_SAFECONTENTSBAG" => "${OID_PKCS12_BAGTYPES}.6",
"PKCS12_PBEIDS_SHAAND128BITRC4" => "${OID_PKCS12_PBEIDS}.1",
"PKCS12_PBEIDS_SHAAND40BITRC4" => "${OID_PKCS12_PBEIDS}.2",
"PKCS12_PBEIDS_SHAAND3KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.3",
"PKCS12_PBEIDS_SHAAND2KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.4",
"PKCS12_PBEIDS_SHAAND128BITRC2CBC" => "${OID_PKCS12_PBEIDS}.5",
"PKCS12_PBEIDS_SHAAND40BITRC2CBC" => "${OID_PKCS12_PBEIDS}.6",
# Symbian dev cert extensions
"SYMBIAN_DEVICE_ID_LIST" => "1.2.826.0.1.1796587.1.1.1.1",
"SYMBIAN_SID_LIST" => "1.2.826.0.1.1796587.1.1.1.4",
"SYMBIAN_VID_LIST" => "1.2.826.0.1.1796587.1.1.1.5",
"SYMBIAN_CAPABILITIES" => "1.2.826.0.1.1796587.1.1.1.6"
);
my $DER_BOOLEAN_TAG="01";
my $DER_INTEGER_TAG="02";
my $DER_BITSTRING_TAG="03";
my $DER_OCTETSTRING_TAG="04";
my $DER_NULL_TAG="05";
my $DER_OID_TAG="06";
my $DER_ENUMERATED_TAG="0A";
my $DER_SEQUENCE_TAG="10";
my $DER_SET_TAG="11";
my $DER_UTF8STRING_TAG="0C";
my $DER_PRINTABLESTRING_TAG="13";
my $DER_IA5STRING_TAG="16";
my $DER_UTCTIME_TAG="17";
my $DER_BMPSTRING_TAG="1E";
my $UNIVERSAL_CLASS="UNIVERSAL";
my $APPLICATION_CLASS="APPLICATION";
my $CONTEXT_SPECIFIC_CLASS="CONTEXT-SPECIFIC";
my $PRIVATE_CLASS="PRIVATE";
my %PARSE =
(
"BOOL" => \&parseBoolean,
"BOOLEAN" => \&parseBoolean,
"BIGINTEGER" => \&parseBigInteger,
"BITSTRING" => \&parseBitString,
"BITSTRING_WRAPPER" => \&parseBitStringWrapper,
"BMPSTRING" => \&parseBmpString,
"BMPSTRING_FILE" => \&parseBmpStringFile,
"ENUMERATED" => \&parseEnumerated,
"IA5STRING" => \&parseIA5String,
"IA5STRING_FILE" => \&parseIA5StringFile,
"INCLUDE" => \&parseInclude,
"INCLUDE_BINARY_FILE" => \&parseIncludeBinaryFile,
"INTEGER" => \&parseInteger,
"INT" => \&parseInteger,
"IMPLICIT" => \&parseImplicit,
"ENCRYPT" => \&parseEncrypt,
"EXPLICIT" => \&parseExplicit,
"HASH" => \&parseHash,
"HMAC" => \&parseHmac,
"NULL" => \&parseNull,
"OCTETSTRING" => \&parseOctetString,
"OUTPUT_BINARY_FILE" => \&parseOutputFile,
"OID" => \&parseOid,
"PRINTABLESTRING" => \&parsePrintableString,
"PRINTABLESTRING_FILE" => \&parsePrintableStringFile,
"RAW" => \&parseRaw,
"SEQUENCE" => \&parseSequence,
"SEQ" => \&parseSequence,
"SET" => \&parseSet,
"SHELL" => \&parseShell,
"SIGN" => \&parseSign,
"UTCTIME" => \&parseUtcTime,
"UTF8STRING" => \&parseUtf8String,
"UTF8STRING_FILE" => \&parseUtf8StringFile,
);
my $TABS = "";
&main;
exit(0);
sub main() {
my $hex;
my $out;
my $in;
my @lines;
GetOptions('debug=i' => \$DEBUG,
'hex' => \$hex,
'in=s' => \$in,
'out=s' => \$out);
if (! defined $in) {
$in = $ARGV[0];
}
if (! defined $out) {
$out = $ARGV[1];
}
if (defined $in) {
@lines = readFile($in);
}
else {
die "No input file specified.\n";
}
if (defined $out) {
open OUT, ">$out" || die "Cannot open output file $out";
}
else {
*OUT = *STDOUT;
}
my $oc = 0;
my $asnHex = parseScript(\@lines, \$oc);
$asnHex = tidyHex($asnHex);
if ((!defined $hex) && (defined $out)) {
binmode(OUT);
print OUT toBin($asnHex);
}
elsif (defined $out) {
print OUT $asnHex;
}
else {
print $asnHex;
}
close OUT;
}
sub tidyHex($) {
my ($input) = @_;
$input =~ s/:+/:/g;
$input =~ s/(^:|:$)//g;
return uc($input);
}
sub toBin($) {
my ($asnHex) = @_;
$asnHex =~ s/[\s:]//g;
$asnHex = uc($asnHex);
my $len = length($asnHex);
if ($len % 2 != 0) {
die "toBin: hex string contains an odd number ($len) of octets.\n$asnHex\n";
}
my $binary;
$binary .= pack("H${len}", $asnHex);
# for (my $i = 0; $i < length($asnHex); $i+=2) {
# $binary .= pack('C', substr($asnHex, $i, 2));
# }
return $binary;
}
sub parseScript($$;$) {
my ($lines, $oc, $params) = @_;
my $derHex = "";
nest();
substVars($lines, $params);
while (my $line = shift @$lines) {
chomp($line);
# Remove leading spaces
$line =~ s/^\s*//g;
# skip comments
next if ($line =~ /^\/\//);
if ($DEBUG == 3) {
print "${TABS}:PARSE parseScript: $line\n";
}
my $argString;
my $cmd;
if ($line =~ /(\w+)\s*\{/ ) {
# parse block commands e.g. large integer
$cmd = uc($1);
$line =~ s/.*\{//g;
while (defined $line && !($line =~ /(^|[^\\]+)\}/) ) {
$argString .= $line;
$line = shift(@$lines);
}
if (defined $line) {
# append everything up to the closing curly bracket
$line =~ s/(^|[^\\])\}.*/$1/g;
$argString .= $line;
}
}
elsif ($line =~ /(\w+)\s*=*(.*)/) {
# parse commands of the form key = value
$cmd = uc($1);
$argString = defined $2 ? $2 : "";
}
if (defined $cmd) {
if ($cmd =~ /^END/) {
leaveNest();
if ($DEBUG) {
print "${TABS}:PARSE END\n";
}
return $derHex;
}
elsif (! defined $PARSE{$cmd}) {
die "parseScript: Unknown command: $cmd\n";
}
else {
if ($DEBUG) {
print "${TABS}:PARSE CMD=$cmd";
if ($argString ne "") {print " ARG: $argString";}
print "\n";
}
# Substitue variables in argString
$derHex .= ":" . &{$PARSE{$cmd}}($argString, $oc, $lines);
}
}
}
leaveNest();
return $derHex;
}
sub substVars($$) {
my ($lines, $params) = @_;
if (! defined $params) {
@$params = ();
}
for (my $i = 0; $i < scalar(@$lines); $i++) {
my $line = @$lines[$i];
my $paramIndex = 1;
# For each parameter search for the a use of $N where
# N is the index of the parameter and replace $N with the
# value of the parameter
foreach (@$params) {
$line =~ s/\$${paramIndex}(\D|$)/$_$1/g;
++$paramIndex;
}
# Remove any unused parameters
$line =~ s/\$\d+//g;
@$lines[$i] = $line;
}
}
sub readFile($) {
my ($fileName) = @_;
my $inFile;
if ($DEBUG) {
print "readFile, $fileName\n";
}
open($inFile, $fileName) || die "readFile: cannot open $fileName\n";
my @lines = <$inFile>;
close $inFile;
return @lines;
}
sub parseBitString($$;$) {
my ($argString, $oc, $lines) = @_;
return encodeBitString($argString, $oc);
}
sub parseBitStringWrapper($$;$) {
my ($argString, $oc, $lines) = @_;
my $contents_oc = 0;
my $contents = parseScript($lines, \$contents_oc);
my $binary = toBin($contents);
my $bitCount = $contents_oc * 8;
my $bitStr = unpack("B${bitCount}", $binary);
# remove trailing zeros - breaks signatures so disable for the moment
# $bitStr =~ s/0*$//g;
return encodeBitString($bitStr, $oc);
}
sub parseBmpString($$;$) {
my ($argString, $oc, $lines) = @_;
my $bmpString_oc = 0;
my $bmpString = asciiToBmpString($argString, \$bmpString_oc);
return encodeBmpString($bmpString, $bmpString_oc, $oc);
}
sub parseBmpStringFile($$;$) {
my ($binFName, $oc, $lines) = @_;
$binFName =~ s/\s*//g;
my $bmpString_oc = 0;
my $bmpString = encodeBinaryFile($binFName, \$bmpString_oc);
return encodeBmpString($bmpString, $bmpString_oc, $oc);
}
sub parseBoolean($$;$) {
my ($argString, $oc, $lines) = @_;
$argString =~ s/\s//g;
$argString = lc($argString);
my $bool;
if ($argString eq "t" || $argString eq "true" || $argString eq "1") {
$bool = 1;
}
elsif ($argString eq "f" || $argString eq "false" || $argString eq "0") {
$bool = 0;
}
else {
die "parseBoolean: Invalid boolean value \'$argString\'";
}
return encodeBoolean($bool, $oc);
}
sub parseHash($$;$) {
my ($argString, $oc, $lines) = @_;
my ($algorithm) = getArgs($argString);
if (! defined $algorithm) {
die "parseHash: missing algortithm";
}
my $hashIn_oc = 0;
my $hashIn = parseScript($lines, \$hashIn_oc);
my $hashInFName = '_hashin.tmp';
my $hashOutFName = '_hashout.tmp';
# Create binary hash file
my $hashInFh;
open($hashInFh, ">$hashInFName") or die "Cannot create $hashInFName";
binmode($hashInFh);
print $hashInFh toBin($hashIn);
close $hashInFh;
my @command = ("cmd",
"/C \"openssl dgst -${algorithm} -binary $hashInFName > $hashOutFName\"");
if ($DEBUG == 1) {
print "${TABS}:parseHash:" . join(" ", @command) . "\n";
}
if ((my $err = system(@command)) != 0) {
die "parseHash: " . join(" ", @command) . "\nreturned error $err";
}
my $derHex = parseIncludeBinaryFile($hashOutFName, $oc);
if (! $DEBUG) {
unlink($hashInFName);
unlink($hashOutFName);
}
return $derHex;
}
sub parseHmac($$;$) {
my ($argString, $oc, $lines) = @_;
my ($algorithm, $key) = getArgs($argString);
if (! defined $algorithm) {
die "parseHmac: missing algortithm";
}
$algorithm = uc($algorithm);
if (! $algorithm =~ /MD5|SHA1/) {
die "parseHmac: invalid algorithm $algorithm";
}
if (! defined $key) {
die "parseHmac: missing key";
}
my $hmacIn_oc = 0;
my $hmacIn = toBin(parseScript($lines, \$hmacIn_oc));
my $hmac;
my $binKey = toBin($key);
if ($algorithm eq "SHA1") {
$hmac = Digest::HMAC_SHA1->new($binKey);
}
else {
$hmac = Digest::HMAC_MD5->new($binKey);
}
$hmac->add($hmacIn);
my $digest = $hmac->digest;
$$oc += length($digest);
return toHex($digest);
}
sub parseIA5String($$;$) {
my ($argString, $oc, $lines) = @_;
my $ia5String_oc = 0;
my $ia5String = asciiToIA5String($argString, \$ia5String_oc);
return encodeIA5String($ia5String, $ia5String_oc, $oc);
}
sub parseIA5StringFile($$;$) {
my ($binFName, $oc, $lines) = @_;
$binFName =~ s/\s*//g;
my $ia5String_oc = 0;
my $ia5String = encodeBinaryFile($binFName, \$ia5String_oc);
return encodeIA5String($ia5String, $ia5String_oc, $oc);
}
sub parseIncludeBinaryFile($$;$) {
my ($binFName, $oc, $lines) = @_;
$binFName =~ s/\s*//g;
return encodeBinaryFile($binFName, $oc);
}
sub parseInclude($$$) {
my ($argString, $oc, $lines) = @_;
my @args = getArgs($argString);
my $fileName = shift(@args);
if (! (defined $fileName && $fileName ne "")) {
die "parseInclude: Filename not specified\n";
}
my $derHex = "";
my @lines = readFile($fileName);
$derHex = parseScript(\@lines, $oc, \@args);
return $derHex;
}
sub parseInteger($$;$) {
my ($argString, $oc, $lines) = @_;
$argString =~ s/\s//g;
return encodeInteger($argString, $oc);
}
sub parseBigInteger($$;$) {
my ($argString, $oc, $lines) = @_;
$argString =~ s/\s//g;
return encodeBigInteger($argString, $oc);
}
sub parseEncrypt($$;$) {
my ($argString, $oc, $lines) = @_;
my ($cipher, $key, $iv) = getArgs($argString);
if (! defined $cipher) {
die "parseEncrypt: missing cipher\n";
}
if (! defined $key) {
die "parseEncrypt: missing key\n";
}
my $plainText_oc = 0;
my $plainText = parseScript($lines, \$plainText_oc);
my $plainTextFName = '_plaintext.tmp';
my $cipherTextFName = '_ciphertext.tmp';
# Create binary plaintext file
my $plainTextFh;
open($plainTextFh, ">$plainTextFName") or die "Cannot create $plainTextFName";
binmode($plainTextFh);
print $plainTextFh toBin($plainText);
close $plainTextFh;
my @command = ('openssl',
'enc',
"-${cipher}",
'-e',
'-K', $key,
'-in', $plainTextFName,
'-out', $cipherTextFName);
if (defined $iv) {
push @command, '-iv', $iv;
}
if ($DEBUG == 1) {
print "${TABS}:parseEncrypt:" . join(" ", @command) . "\n";
}
if ((my $err = system(@command)) != 0) {
die "parseEncrypt: " . join(" ", @command) . "\nreturned error $err";
}
my $derHex = parseIncludeBinaryFile($cipherTextFName, $oc);
if (! $DEBUG) {
unlink($plainTextFName);
unlink($cipherTextFName);
}
return $derHex;
}
sub parseEnumerated($$;$) {
my ($argString, $oc, $lines) = @_;
$argString =~ s/\s//g;
return encodeEnumerated($argString, $oc);
}
sub parseExplicit($$;$) {
my ($argString, $oc, $lines) = @_;
my ($tagNumber, $class) = getArgs($argString);
if (! defined $tagNumber || $tagNumber =~ /^\s*$/) {
$tagNumber = "0";
}
elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) {
die "parseExplicit: invalid tag number: \'$tagNumber\'";
}
$tagNumber = hex($tagNumber);
if (!defined $class || $class =~ /^\s*$/) {
$class = $CONTEXT_SPECIFIC_CLASS;
}
else {
$class =~ s/\s*//g;
$class = uc($class);
}
if (! isValidClass($class)) {
die "parseExplicit: invalid class \'$class\'";
}
my $nested_oc = 0;
my $nested = parseScript($lines, \$nested_oc);
return encodeExplicit($class, $tagNumber, $nested, $nested_oc, $oc);
}
sub parseImplicit($$;$) {
my ($argString, $oc, $lines) = @_;
my ($tagNumber, $class) = getArgs($argString);
if (! defined $tagNumber || $tagNumber =~ /^\s*$/) {
$tagNumber = "0";
}
elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) {
die "parseImplicit: invalid tag number: \'$tagNumber\'";
}
$tagNumber = hex($tagNumber);
if (!defined $class || $class =~ /^\s*$/) {
$class = $CONTEXT_SPECIFIC_CLASS;
}
else {
$class =~ s/\s*//g;
$class = uc($class);
}
if (! isValidClass($class)) {
die "parseImplicit: invalid class \'$class\'";
}
my $nested_oc = 0;
my $nested = tidyHex(parseScript($lines, \$nested_oc));
# De-construct the nested data to allow the underlying type tag to be
# changed. The output of parseScript had better be valid DER or this
# will go horribly wrong !
my $uClass = "";
my $uConstructed = 0;
my $uTag = 0;
my $uLength = 0;
my $uValue = "";
getTlv($nested, \$uClass, \$uConstructed, \$uTag, \$uLength, \$uValue);
if ($DEBUG == 2) {
print "${TABS}parseImplicit: underlyingType \'$uTag\'\n";
}
# This only works for low tag numbers because we are assuming that the type
# tag is a single octet
return encodeImplicit($class, $uConstructed, $tagNumber, $uValue, $uLength, $oc);
}
sub parseNull($$;$) {
my ($argString, $oc, $lines) = @_;
return encodeNull($oc);
}
sub parseOctetString($$;$) {
my ($argString, $oc, $lines) = @_;
my $octetString_oc = 0;
my $octetString = parseScript($lines, \$octetString_oc);
return encodeOctetString($octetString, $octetString_oc, $oc);
}
sub parseOid($$;$) {
my ($argString, $oc, $lines) = @_;
$argString =~ s/\s//g;
$argString = uc($argString);
if (! defined $argString) {
die "parseOid: Missing OID value.";
}
foreach (keys %OIDS) {
if ($argString =~ /$_/) {
$argString =~ s/\Q$_\E/$OIDS{$_}/g;
}
}
return encodeOid($argString, $oc);
}
sub parseOutputFile($$;$) {
my ($argString, $oc, $lines) = @_;
my ($outputFile,$echo) = split(/,/, $argString);
if (! defined $outputFile) {
die "parseOutputFile: Missing file-name.\n";
}
my $content_oc = 0;
my $content = parseScript($lines, \$content_oc);
my $outFh;
if (! open($outFh, ">${outputFile}")) {
die "parseOutputFile: Cannot create $outputFile\n";
}
binmode($outFh);
print $outFh toBin($content);
close $outFh;
# If echo is specified then include then contents of the output
# file at this point in the stream.
if (defined $echo && $echo =~ /(1|t|true)/i) {
$$oc += $content_oc;
return $content;
}
else {
return "";
}
}
sub parsePrintableString($$;$) {
my ($argString, $oc, $lines) = @_;
my $printableString_oc = 0;
my $printableString = asciiToPrintableString($argString, \$printableString_oc);
return encodePrintableString($printableString, $printableString_oc, $oc);
}
sub parsePrintableStringFile($$;$) {
my ($binFName, $oc, $lines) = @_;
$binFName =~ s/\s*//g;
my $printableString_oc = 0;
my $printableString = encodeBinaryFile($binFName, \$printableString_oc);
return encodePrintableString($printableString, $printableString_oc, $oc);
}
sub parseRaw($$;$) {
my ($argString, $oc, $lines) = @_;
$argString =~ s/\s//g;
$argString = uc($argString);
my $asnHex = "";
if (! ($argString =~ /(([A-Fa-f\d][A-Fa-f\d])[ :]*)+/)) {
die "parseRaw: Invalid hex string: $argString\n";
}
my $binary = toBin($argString);
$$oc += length($binary);
return tidyHex(toHex($binary));
}
sub parseSequence($$;$) {
my ($argString, $oc, $lines) = @_;
my $sequence_oc = 0;
my $sequence = parseScript($lines, \$sequence_oc);
return encodeSequence($sequence, $sequence_oc, $oc);
}
sub parseSet($$;$) {
my ($argString, $oc, $lines) = @_;
my $set_oc = 0;
my $set = parseScript($lines, \$set_oc);
return encodeSet($set, $set_oc, $oc);
}
# Create a PKCS#7 signed data object for a chunk of data using
# OpenSSL's SMIME command
sub parseSign($$;$) {
my ($argString, $oc, $lines) = @_;
my ($signerCert, $signerKey) = getArgs($argString);
if (! defined $signerCert) {
die "parseSign: missing signing certificate";
}
elsif (! -f $signerCert) {
die "parseSign: signing certificate \'$signerCert\' does not exist.";
}
if (! defined $signerKey) {
die "parseSign: missing signing certificate";
}
elsif (! -f $signerKey) {
die "parseSign: signing key \'$signerKey\' does not exist.";
}
my $unsigned_oc = 0;
my $unsigned = parseScript($lines, \$unsigned_oc);
my $unsignedFName = '_unsigned.tmp';
my $signedFName = '_signed.tmp';
# Create binary unsigned data file
my $unsignedFh;
open($unsignedFh, ">$unsignedFName") or die "Cannot create $unsignedFName";
binmode($unsignedFh);
print $unsignedFh toBin($unsigned);
close $unsignedFh;
my @command = ('openssl',
'smime',
'-pk7out',
'-nodetach',
'-outform',
'der',
'-sign',
'-signer',
$signerCert,
'-inkey',
$signerKey,
'-in', $unsignedFName,
'-out', $signedFName);
if ($DEBUG == 1) {
print "${TABS}:parseSign:" . join(" ", @command) . "\n";
}
if ((my $err = system(@command)) != 0) {
die "parseSign: " . join(" ", @command) . "\nreturned error $err";
}
my $derHex = parseIncludeBinaryFile($signedFName, $oc);
if (! $DEBUG) {
unlink($unsignedFName);
unlink($signedFName);
}
return $derHex;
}
sub parseShell($$;$) {
my ($argString, $oc, $lines) = @_;
my @command = getArgs($argString);
if (scalar(@command) < 1) {
die "parseShell: no arguments";
}
if ($DEBUG == 1) {
print "${TABS}:parseShell:" . join(" ", @command) . "\n";
}
if ((my $err = system(@command)) != 0) {
die "parseShell: " . join(" ", @command) . "\nreturned error $err";
}
return "";
}
sub parseUtcTime($$;$) {
my ($time, $oc, $lines) = @_;
$time =~ s/\s//g;
my $time_oc = length($time);
return encodeUtcTime(toHex($time), $time_oc, $oc);
}
sub parseUtf8String($$;$) {
my ($argString, $oc, $lines) = @_;
my $utf8String_oc = 0;
my $utf8String = asciiToUtf8String($argString, \$utf8String_oc);
return encodeUtf8String($utf8String, $utf8String_oc, $oc);
}
sub parseUtf8StringFile($$;$) {
my ($binFName, $oc, $lines) = @_;
$binFName =~ s/\s*//g;
my $utf8String_oc = 0;
my $utf8String = encodeBinaryFile($binFName, \$utf8String_oc);
return encodeUtf8String($utf8String, $utf8String_oc, $oc);
}
sub toHex($) {
my ($bin) = @_;
my $hex = unpack("H" . (length($bin) * 2), $bin);
$hex =~ s/(..)/$1:/g;
return $hex;
}
sub encodeBinaryFile($$) {
my ($binFName, $oc) = @_;
my $binFH;
open($binFH, "$binFName") || die "encodeBinaryFile: Cannot open $binFName\n";
binmode($binFH);
my $binBuf;
my $readBuf;
my $derHex = "";
while (my $len = sysread($binFH, $readBuf, 1024)) {
$binBuf .= $readBuf;
$$oc += $len;
}
close $binFH;
return toHex($binBuf);;
}
# Creates a hex representation of the DER encoding of an arbitrary length bit string
sub encodeBitString($$) {
my ($text, $oc) = @_;
# Bit string in hex including padding length octet
my $bit_str = "";
my $bit_str_oc = 1; # one octet for padding
# Current byte
my $byte = 0;
my $len = length($text);
if ($len == 0) {
$$oc+=2;
return "03:00";
}
my $i = 0;
while ($i < $len) {
# Read the ith character and insert it in the correct place in the byte
# (fill from the left)
my $c = substr($text, $i, 1);
if ($c eq "1") {
$byte |= (1 << (7 - ($i % 8)));
}
elsif ($c ne "0") {
die "Invalid character $c in bit string $text";
}
if (++$i % 8 == 0) {
# Received 8 bits so output byte in hex
if ($bit_str ne "") {
$bit_str .= ":";
}
$bit_str .= sprintf("%2.2x", $byte);
$bit_str_oc++;
$byte = 0;
}
}
# Pad any remaining bits / make sure 0 is output for empty string
if ($byte != 0 || $bit_str_oc == 1) {
if ($bit_str ne "") {
$bit_str .= ":";
}
$bit_str .= sprintf("%2.2x", $byte);
$bit_str_oc++;
}
my $pad_length = "00";
if ($len % 8 > 0) {
# If this isn't a multiple of 8 bits then calculated
# the number of padding bits added.
$pad_length = sprintf("%2.2x", 8 - ($len % 8));
}
if ($DEBUG == 2) {
print "${TABS}:ENC:encodeBitString, $bit_str_oc\n";
}
return encodeTlv($oc, $DER_BITSTRING_TAG, $bit_str_oc, "$pad_length:$bit_str");
}
# Creates a hex represenation of the DER encoding of a BMPSTRING
sub encodeBmpString($$$) {
my ($bmpString, $bmpString_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC:encodeBmpString, $bmpString_oc\n";
}
return encodeTlv($oc, $DER_BMPSTRING_TAG, $bmpString_oc, $bmpString);
}
sub encodeBoolean($$) {
my ($value, $oc) = @_;
my $boolean = "00";
if ($value) {
$boolean = "FF";
}
if ($DEBUG == 2) {
print "${TABS}:ENC:encodeBoolean, 1\n";
}
return encodeTlv($oc, $DER_BOOLEAN_TAG, 1, $boolean);
}
sub encodeEnumerated($$) {
my ($int, $oc) = @_;
$int =~ s/\s//g;
if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) {
die "encodeEnumerated: Invalid argument: $int\n";
}
if ($int =~ s/^0x//) {
$int = hex;
}
# Convert the enumerated to base 256 hex and find out how
# many octets were required
my $hex_enumerated_oc = 0;
my $hex_enumerated = "";
if ($int ne "") {
$hex_enumerated = encodeBase256($int, \$hex_enumerated_oc);
}
if ($DEBUG == 2) {
print "${TABS}:ENC: , $hex_enumerated_oc\n";
}
return encodeTlv($oc, $DER_ENUMERATED_TAG, $hex_enumerated_oc, $hex_enumerated);
}
# explicit tags are always constructed
sub encodeExplicit($$$$) {
my ($class, $tagNumber, $explicit, $explicit_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC: explicit, $explicit_oc\n";
}
return encodeTlv($oc, $tagNumber, $explicit_oc, $explicit, 1, $class);
}
# Creates a hex represenation of the DER encoding of an IA5 string
sub encodeIA5String($$) {
my ($ia5String, $ia5String_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC:encodeIA5String, $ia5String_oc\n";
}
return encodeTlv($oc, $DER_IA5STRING_TAG, $ia5String_oc, $ia5String);
}
sub encodeImplicit($$$$$) {
my ($class, $constructed, $tagNumber, $implicit, $implicit_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC: implicit, $implicit_oc\n";
}
return encodeTlv($oc, $tagNumber, $implicit_oc, $implicit, $constructed, $class);
}
sub encodeBigInteger($$) {
my ($hexString, $oc) = @_;
my $bin = toBin($hexString);
my $int = toHex($bin);
my $int_oc = length($bin);
if ($DEBUG == 2) {
print "${TABS}:ENC: bigInteger, $int_oc\n";
}
return encodeTlv($oc, $DER_INTEGER_TAG, $int_oc, $int)
}
sub encodeInteger($$) {
my ($int, $oc) = @_;
$int =~ s/\s//g;
if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) {
die "encodeInteger: Invalid argument: $int\n";
}
if ($int =~ s/^0x//) {
$int = hex;
}
# Convert the integer to base 256 hex and find out how
# many octets were required
my $hex_integer_oc = 0;
my $hex_integer = "";
if ($int ne "") {
$hex_integer = encodeBase256($int, \$hex_integer_oc);
}
if ($DEBUG == 2) {
print "${TABS}:ENC: integer, $hex_integer_oc\n";
}
return encodeTlv($oc, $DER_INTEGER_TAG, $hex_integer_oc, $hex_integer);
}
sub encodeNull($) {
my ($oc) = @_;
return encodeTlv($oc, $DER_NULL_TAG, 0, "");
}
sub encodeOctetString($$$) {
my ($octetString, $octetString_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC: octetString, $octetString_oc\n";
}
return encodeTlv($oc, $DER_OCTETSTRING_TAG, $octetString_oc, $octetString);
}
sub encodeOid($$) {
my ($text, $oc) = @_;
my @fields = split /\./, $text;
if (! ($fields[0] >= 0 && $fields[0] <=2) ) {
die "Invalid OID: $text\n";
}
if (! ($fields[1] >= 0 && $fields[1] <= 39) ) {
die "Invalid OID: $text";
}
my $oid = sprintf("%2.2x", (40 * $fields[0]) + $fields[1]);
my $oid_oc = 1;
shift @fields;
shift @fields;
foreach (@fields) {
$oid .= ":" . encodeBase128($_, \$oid_oc);
}
if ($DEBUG == 2) {
print "${TABS}:ENC:encodeOid, $oid_oc\n";
}
return encodeTlv($oc, $DER_OID_TAG, $oid_oc, $oid);
}
# Creates a hex represenation of the DER encoding of a PRINTABLE string
sub encodePrintableString($$$) {
my ($printableString, $printableString_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC:encodePrintableString, $printableString_oc\n";
}
return encodeTlv($oc, $DER_PRINTABLESTRING_TAG, $printableString_oc, $printableString);
}
sub encodeSet($$$) {
my ($set, $set_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC: set, $set_oc\n";
}
return encodeTlv($oc, $DER_SET_TAG, $set_oc, $set, 1);
}
sub encodeSequence($$$) {
my ($sequence, $sequence_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC: sequence, $sequence_oc\n";
}
return encodeTlv($oc, $DER_SEQUENCE_TAG, $sequence_oc, $sequence, 1);
}
sub encodeUtcTime($$$) {
my ($utcTime, $utcTime_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC: UTCTime, $utcTime_oc\n";
}
return encodeTlv($oc, $DER_UTCTIME_TAG, $utcTime_oc, $utcTime);
}
# Creates a hex represenation of the DER encoding of a UTF-8 string.
sub encodeUtf8String($$) {
my ($utf8String, $utf8String_oc, $oc) = @_;
if ($DEBUG == 2) {
print "${TABS}:ENC:encodeUTF8String, $utf8String_oc\n";
}
return encodeTlv($oc, $DER_UTF8STRING_TAG, $utf8String_oc, $utf8String);
}
sub asciiToBmpString($$) {
my ($input, $oc) = @_;
my $bmpString = "";
my $input_len = length($input);
$$oc += $input_len * 2;
for (my $i = 0; $i < $input_len; ++$i) {
my $hex_val = ord(substr($input, $i, 1));
if ($bmpString ne "") {
$bmpString .= ":";
}
$bmpString .= sprintf(":00:%2.2x", $hex_val);
}
return $bmpString;
}
sub asciiToIA5String($$) {
my ($input, $oc) = @_;
my $printableString = "";
my $input_len = length($input);
$$oc += $input_len;
for (my $i = 0; $i < $input_len; ++$i) {
my $hex_val = ord(substr($input, $i, 1));
if ($printableString ne "") {
$printableString .= ":";
}
$printableString .= sprintf(":%2.2x", $hex_val);
}
return $printableString;
}
sub asciiToPrintableString($$) {
my ($input, $oc) = @_;
my $ia5String = "";
my $input_len = length($input);
$$oc += $input_len;
for (my $i = 0; $i < $input_len; ++$i) {
my $hex_val = ord(substr($input, $i, 1));
if ($ia5String ne "") {
$ia5String .= ":";
}
$ia5String .= sprintf(":%2.2x", $hex_val);
}
return $ia5String;
}
sub asciiToUtf8String($$) {
my ($input, $oc) = @_;
my $utf8String = "";
my $input_len = length($input);
$$oc += $input_len;
for (my $i = 0; $i < $input_len; ++$i) {
my $hex_val = ord(substr($input, $i, 1));
if ($utf8String ne "") {
$utf8String .= ":";
}
$utf8String .= sprintf(":%2.2x", $hex_val);
}
return $utf8String;
}
sub encodeBase128($$$) {
my ($num, $oc) = @_;
my $base128 = "";
$num = int($num);
my $base128_length = 0;
while ($num > 0) {
my $hexoctet;
if ($base128 eq "") {
$hexoctet = sprintf("%2.2x", $num & 0x7f);
}
else {
$hexoctet = sprintf("%2.2x", ($num & 0x7f) | 0x80);
}
if ($base128 eq "") {
$base128 = $hexoctet;
}
else {
$base128 = "$hexoctet:$base128";
}
$num >>= 7;
$base128_length++;
}
if ($base128 eq "") {
$base128 = "00";
$base128_length++;
}
$$oc += $base128_length;
if ($DEBUG == 2) {
print "${TABS}:ENC: base128, $base128_length, $$oc\n";
}
return $base128;
}
# Return a hex represenation of the length using DER primitive (definate length encoding)
sub encodeLength($$) {
my ($num, $oc) = @_;
if ($num < 128) {
# Number is < 128 so encode in short form
$$oc++;
return sprintf("%2.2x", $num);
}
else {
# Number >= 128 so encode in long form
my $length_oc = 0;
my $base256 = &encodeBase256($num, \$length_oc, 1);
if ($length_oc > 127) {die "Encoding overflow.";}
$$oc += 1 + $length_oc;
# Set the top bit of the length octet to indicate long form
return "" . sprintf("%2.2x", ($length_oc | 0x80)) . ":$base256";
}
}
# Convert an integer into an ascii hex representation in base 256
# $num - the number to encode
# $octets - refernce to the octet count to increment
# $unsigned - assume unsigned
sub encodeBase256($$) {
my ($numIn, $oc, $unsigned) = @_;
my $base256 = "";
my $num = int($numIn);
while ($num != 0) {
my $hexoctet = sprintf("%2.2x", $num & 0xFF);
if ($base256 ne "") {
$base256 = "$hexoctet:$base256";
}
else {
$base256 = $hexoctet;
}
$num >>= 8;
$$oc++;
}
if ($base256 eq "") {
$base256 = "00";
$$oc++;
}
# If the integer is +ve and the MSB is 1 then padd with a leading zero
# octet otherwise it will look -ve
if ((! $unsigned) && $numIn > 0 && $base256 =~ /^:*[8ABCDEF]/i) {
$base256 = "00:$base256";
$$oc++;
}
# If the first octet is all ones and the msb of the next bit
# is also one then drop the first octet because negative
# numbers should not be padded
while ($base256 =~ s/^(FF:)([8ABCDEF][0-9A-F].*)/$2/i) {
$$oc--;
}
return $base256;
}
# Encode the Type
# Only low tag form is supported at the moment
sub encodeType($$;$$) {
my ($oc, $tagNumber, $constructed, $class) = @_;
$tagNumber = hex($tagNumber);
if ($tagNumber < 0 || $tagNumber > 30) {
die "encodeType: Currently, only low tag numbers (0 - 30) are supported.";
}
if (! defined $class) {
$class = "UNIVERSAL";
}
$class = uc($class);
if (! isValidClass($class)) {
die "encodeType: invalid class \'$class\'";
}
# If the type is constructed then set bit 6
if (defined $constructed && $constructed == 1) {
$tagNumber |= 0x20;
}
if ($class eq $UNIVERSAL_CLASS) {
# do nothing, bits 7 and 8 are zero
}
elsif ($class eq $APPLICATION_CLASS) {
# set bit 7
$tagNumber |= 0x40;
}
elsif ($class eq $CONTEXT_SPECIFIC_CLASS) {
# set bit 8
$tagNumber |= 0x80;
}
elsif ($class eq $PRIVATE_CLASS) {
# set bits 7 and 8
$tagNumber |= 0xC0;
}
$$oc++;
return sprintf("%2.2x", $tagNumber);
}
sub encodeTlv($$$$;$$) {
my ($oc, $tag, $length, $value, $constructed, $class) = @_;
if ($DEBUG == 3) {
print "${TABS}encodeTlv\n";
print "${TABS}oc=$$oc\n";
print "${TABS}tag=$tag\n";
print "${TABS}length=$length\n";
print "${TABS}value=$value\n";
if (defined $constructed) {
print "${TABS}constructed=$constructed\n";
}
if (defined $class) {
print "${TABS}class=$class\n";
}
}
my $hex;
$hex = encodeType($oc, $tag, $constructed, $class);
$hex .= ":" . encodeLength($length, $oc);
$$oc += $length;
$hex .= ":" . $value;
if ($DEBUG == 3) {
print "${TABS}oc=$$oc\n";
print "${TABS}encoding=$hex\n";
print "${TABS}end\n";
toBin($hex);
}
return $hex;
}
# increment debug tabbing level
sub nest() {
$TABS .= " ";
}
# decrement debug tabbing level
sub leaveNest() {
$TABS =~ s/^...//;
}
sub isValidClass($) {
my ($class) = @_;
if (defined $class &&
$class =~ /^(UNIVERSAL|APPLICATION|CONTEXT-SPECIFIC|PRIVATE)$/) {
return 1;
}
return 0;
}
# Parse a DER field
sub getTlv($$$$$$) {
my ($input, $class, $constructed, $tag, $length, $value) = @_;
my @hexOctets = split(/:+/,tidyHex($input));
if (scalar(@hexOctets) < 2) {
die "getTlv: too short";
}
my $type = hex(shift @hexOctets);
if (($type & 0xC0) == 0x00) {
# universal: bit 8 = 0, bit 7 = 0
$$class = $UNIVERSAL_CLASS;
}
elsif (($type & 0xC0) == 0x40) {
# application: bit 8 = 0, bit 7 = 1
$$class = $APPLICATION_CLASS;
}
elsif (($type & 0xC0) == 0x80) {
# application: bit 8 = 1, bit 7 = 0
$$class = $CONTEXT_SPECIFIC_CLASS;
}
elsif (($type & 0xC0) == 0xC0) {
# application: bit 8 = 1, bit 7 = 1
$$class = $PRIVATE_CLASS;
}
else {
die "getTlv: assert";
}
if ($type & 0x20) {
# constructed if bit 6 = 1
$$constructed = 1;
}
else {
$$constructed = 0;
}
# We assumme the tag number is in low form
# and just look at the bottom 5 hits
$$tag = $type & 0x1F;
$$length = hex(shift @hexOctets);
if ($$length & 0x80) {
# long form
my $length_oc = $$length & 0x7F;
$$length = 0;
for (my $i = 0; $i < $length_oc; $i++) {
# length is encoded base 256
$$length *= 256;
$$length += hex(shift @hexOctets);
}
}
else {
# short form
# don't do anything here, length is just bits 7 - 1 and
# we already know bit 8 is zero.
}
$$value = "";
foreach (@hexOctets) {
$$value .= ":$_";
}
if ($DEBUG == 3) {
print "${TABS} class=$$class\n";
print "${TABS} constructed=$$constructed\n";
print "${TABS} tag=$$tag\n";
print "${TABS} length=$$length\n";
}
}
# parse an escaped (\) comma seperated argument string
# into an array
sub getArgs($) {
my ($argString) = @_;
my @args = ();
while ($argString =~ /(^|.*?[^\\]),(.*)/ ) {
my $match = $1;
$argString = $2;
if ($match ne "") {
# unescape
$match =~ s/(\\)([^\\])/$2/g;
push @args, $match;
}
}
if ($argString ne "") {
push @args, $argString;
}
return @args;
}