--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cryptoservices/certificateandkeymgmt/tder/dergen.pl Wed Jul 08 11:25:26 2009 +0100
@@ -0,0 +1,1560 @@
+#
+# Copyright (c) 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:
+#
+#!/bin/perl -w
+
+# 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 "Symbian Foundation License v1.0"
+# which accompanies this distribution, and is available
+# at the URL "http://www.symbianfoundation.org/legal/sfl-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
+#
+#
+
+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;
+}