--- a/cryptoservices/certificateandkeymgmt/tder/dergen.pl Tue Jul 21 01:04:32 2009 +0100
+++ b/cryptoservices/certificateandkeymgmt/tder/dergen.pl Thu Sep 10 14:01:51 2009 +0300
@@ -1,1560 +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;
-}
+#
+# 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;
+}