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