1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/security/cryptoservices/certificateandkeymgmt/tder/dergen.pl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1541 @@
1.4 +#
1.5 +# Copyright (c) 2009 Nokia Corporation and/or its subsidiary(-ies).
1.6 +# All rights reserved.
1.7 +# This component and the accompanying materials are made available
1.8 +# under the terms of the License "Eclipse Public License v1.0"
1.9 +# which accompanies this distribution, and is available
1.10 +# at the URL "http://www.eclipse.org/legal/epl-v10.html".
1.11 +#
1.12 +# Initial Contributors:
1.13 +# Nokia Corporation - initial contribution.
1.14 +#
1.15 +# Contributors:
1.16 +#
1.17 +# Description:
1.18 +#
1.19 +#!/bin/perl -w
1.20 +
1.21 +use strict;
1.22 +use Digest::HMAC_MD5;
1.23 +use Digest::HMAC_SHA1;
1.24 +use Getopt::Long;
1.25 +
1.26 +# 0 = off
1.27 +# 1 = log parsing
1.28 +# 2 = log parsing + encoding
1.29 +# 3 = really verbose stuff
1.30 +my $DEBUG=0;
1.31 +
1.32 +# Turn on validation checks that attempt to only generate
1.33 +# valid DER encodings.
1.34 +my $VALIDATE=0;
1.35 +
1.36 +my $OID_PKCS = "1.2.840.113549.1";
1.37 +my $OID_PKCS7 ="${OID_PKCS}.7";
1.38 +my $OID_PKCS9 = "${OID_PKCS}.9";
1.39 +my $OID_PKCS9_CERTTYPES = "${OID_PKCS9}.22";
1.40 +my $OID_PKCS12 = "${OID_PKCS}.12";
1.41 +my $OID_PKCS12_BAGTYPES = "${OID_PKCS12}.10.1";
1.42 +my $OID_PKCS12_PBEIDS = "${OID_PKCS12}.1";
1.43 +
1.44 +my %OIDS =
1.45 + (
1.46 + "MD5" => "1.2.840.113549.2.5",
1.47 + "SHA1" => "1.3.14.3.2.26",
1.48 + "X509CRL" => "1.3.6.1.4.1.3627.4",
1.49 +
1.50 + "PKCS7_DATA" => "${OID_PKCS7}.1",
1.51 + "PKCS7_SIGNEDDATA" => "${OID_PKCS7}.2",
1.52 + "PKCS7_ENVELOPEDDATA" => "${OID_PKCS7}.3",
1.53 + "PKCS7_SIGNEDANDENVELOPEDDATA" => "${OID_PKCS7}.4",
1.54 + "PKCS7_DIGESTEDDATA" => "${OID_PKCS7}.5",
1.55 + "PKCS7_ENCRYPTEDDATA" => "${OID_PKCS7}.6",
1.56 +
1.57 + "PKCS9_CERTTYPES_PKCS12_X509" => "${OID_PKCS9_CERTTYPES}.1",
1.58 + "PKCS9_FRIENDLY_NAME" => "${OID_PKCS9}.20",
1.59 + "PKCS9_LOCAL_KEYID" => "${OID_PKCS9}.21",
1.60 +
1.61 + "PKCS12_BAGTYPES_KEYBAG" => "${OID_PKCS12_BAGTYPES}.1",
1.62 + "PKCS12_BAGTYPES_PKCS8SHROUDEDKEYBAG" => "${OID_PKCS12_BAGTYPES}.2",
1.63 + "PKCS12_BAGTYPES_CERTBAG" => "${OID_PKCS12_BAGTYPES}.3",
1.64 + "PKCS12_BAGTYPES_CRLBAG" => "${OID_PKCS12_BAGTYPES}.4",
1.65 + "PKCS12_BAGTYPES_SECRETBAG" => "${OID_PKCS12_BAGTYPES}.5",
1.66 + "PKCS12_BAGTYPES_SAFECONTENTSBAG" => "${OID_PKCS12_BAGTYPES}.6",
1.67 +
1.68 + "PKCS12_PBEIDS_SHAAND128BITRC4" => "${OID_PKCS12_PBEIDS}.1",
1.69 + "PKCS12_PBEIDS_SHAAND40BITRC4" => "${OID_PKCS12_PBEIDS}.2",
1.70 + "PKCS12_PBEIDS_SHAAND3KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.3",
1.71 + "PKCS12_PBEIDS_SHAAND2KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.4",
1.72 + "PKCS12_PBEIDS_SHAAND128BITRC2CBC" => "${OID_PKCS12_PBEIDS}.5",
1.73 + "PKCS12_PBEIDS_SHAAND40BITRC2CBC" => "${OID_PKCS12_PBEIDS}.6",
1.74 +
1.75 + # Symbian dev cert extensions
1.76 + "SYMBIAN_DEVICE_ID_LIST" => "1.2.826.0.1.1796587.1.1.1.1",
1.77 + "SYMBIAN_SID_LIST" => "1.2.826.0.1.1796587.1.1.1.4",
1.78 + "SYMBIAN_VID_LIST" => "1.2.826.0.1.1796587.1.1.1.5",
1.79 + "SYMBIAN_CAPABILITIES" => "1.2.826.0.1.1796587.1.1.1.6"
1.80 +
1.81 +);
1.82 +
1.83 +my $DER_BOOLEAN_TAG="01";
1.84 +my $DER_INTEGER_TAG="02";
1.85 +my $DER_BITSTRING_TAG="03";
1.86 +my $DER_OCTETSTRING_TAG="04";
1.87 +my $DER_NULL_TAG="05";
1.88 +my $DER_OID_TAG="06";
1.89 +my $DER_ENUMERATED_TAG="0A";
1.90 +my $DER_SEQUENCE_TAG="10";
1.91 +my $DER_SET_TAG="11";
1.92 +my $DER_UTF8STRING_TAG="0C";
1.93 +my $DER_PRINTABLESTRING_TAG="13";
1.94 +my $DER_IA5STRING_TAG="16";
1.95 +my $DER_UTCTIME_TAG="17";
1.96 +my $DER_BMPSTRING_TAG="1E";
1.97 +
1.98 +my $UNIVERSAL_CLASS="UNIVERSAL";
1.99 +my $APPLICATION_CLASS="APPLICATION";
1.100 +my $CONTEXT_SPECIFIC_CLASS="CONTEXT-SPECIFIC";
1.101 +my $PRIVATE_CLASS="PRIVATE";
1.102 +
1.103 +my %PARSE =
1.104 + (
1.105 + "BOOL" => \&parseBoolean,
1.106 + "BOOLEAN" => \&parseBoolean,
1.107 + "BIGINTEGER" => \&parseBigInteger,
1.108 + "BITSTRING" => \&parseBitString,
1.109 + "BITSTRING_WRAPPER" => \&parseBitStringWrapper,
1.110 + "BMPSTRING" => \&parseBmpString,
1.111 + "BMPSTRING_FILE" => \&parseBmpStringFile,
1.112 + "ENUMERATED" => \&parseEnumerated,
1.113 + "IA5STRING" => \&parseIA5String,
1.114 + "IA5STRING_FILE" => \&parseIA5StringFile,
1.115 + "INCLUDE" => \&parseInclude,
1.116 + "INCLUDE_BINARY_FILE" => \&parseIncludeBinaryFile,
1.117 + "INTEGER" => \&parseInteger,
1.118 + "INT" => \&parseInteger,
1.119 + "IMPLICIT" => \&parseImplicit,
1.120 + "ENCRYPT" => \&parseEncrypt,
1.121 + "EXPLICIT" => \&parseExplicit,
1.122 + "HASH" => \&parseHash,
1.123 + "HMAC" => \&parseHmac,
1.124 + "NULL" => \&parseNull,
1.125 + "OCTETSTRING" => \&parseOctetString,
1.126 + "OUTPUT_BINARY_FILE" => \&parseOutputFile,
1.127 + "OID" => \&parseOid,
1.128 + "PRINTABLESTRING" => \&parsePrintableString,
1.129 + "PRINTABLESTRING_FILE" => \&parsePrintableStringFile,
1.130 + "RAW" => \&parseRaw,
1.131 + "SEQUENCE" => \&parseSequence,
1.132 + "SEQ" => \&parseSequence,
1.133 + "SET" => \&parseSet,
1.134 + "SHELL" => \&parseShell,
1.135 + "SIGN" => \&parseSign,
1.136 + "UTCTIME" => \&parseUtcTime,
1.137 + "UTF8STRING" => \&parseUtf8String,
1.138 + "UTF8STRING_FILE" => \&parseUtf8StringFile,
1.139 + );
1.140 +
1.141 +my $TABS = "";
1.142 +
1.143 +&main;
1.144 +exit(0);
1.145 +
1.146 +sub main() {
1.147 + my $hex;
1.148 + my $out;
1.149 + my $in;
1.150 + my @lines;
1.151 +
1.152 + GetOptions('debug=i' => \$DEBUG,
1.153 + 'hex' => \$hex,
1.154 + 'in=s' => \$in,
1.155 + 'out=s' => \$out);
1.156 +
1.157 + if (! defined $in) {
1.158 + $in = $ARGV[0];
1.159 + }
1.160 +
1.161 + if (! defined $out) {
1.162 + $out = $ARGV[1];
1.163 + }
1.164 +
1.165 + if (defined $in) {
1.166 + @lines = readFile($in);
1.167 + }
1.168 + else {
1.169 + die "No input file specified.\n";
1.170 + }
1.171 +
1.172 + if (defined $out) {
1.173 + open OUT, ">$out" || die "Cannot open output file $out";
1.174 + }
1.175 + else {
1.176 + *OUT = *STDOUT;
1.177 + }
1.178 +
1.179 + my $oc = 0;
1.180 + my $asnHex = parseScript(\@lines, \$oc);
1.181 + $asnHex = tidyHex($asnHex);
1.182 +
1.183 + if ((!defined $hex) && (defined $out)) {
1.184 + binmode(OUT);
1.185 + print OUT toBin($asnHex);
1.186 + }
1.187 + elsif (defined $out) {
1.188 + print OUT $asnHex;
1.189 + }
1.190 + else {
1.191 + print $asnHex;
1.192 + }
1.193 +
1.194 + close OUT;
1.195 +}
1.196 +
1.197 +sub tidyHex($) {
1.198 + my ($input) = @_;
1.199 + $input =~ s/:+/:/g;
1.200 + $input =~ s/(^:|:$)//g;
1.201 + return uc($input);
1.202 +}
1.203 +
1.204 +sub toBin($) {
1.205 + my ($asnHex) = @_;
1.206 +
1.207 + $asnHex =~ s/[\s:]//g;
1.208 + $asnHex = uc($asnHex);
1.209 +
1.210 + my $len = length($asnHex);
1.211 + if ($len % 2 != 0) {
1.212 + die "toBin: hex string contains an odd number ($len) of octets.\n$asnHex\n";
1.213 + }
1.214 +
1.215 + my $binary;
1.216 + $binary .= pack("H${len}", $asnHex);
1.217 +# for (my $i = 0; $i < length($asnHex); $i+=2) {
1.218 +# $binary .= pack('C', substr($asnHex, $i, 2));
1.219 +# }
1.220 + return $binary;
1.221 +}
1.222 +
1.223 +sub parseScript($$;$) {
1.224 + my ($lines, $oc, $params) = @_;
1.225 + my $derHex = "";
1.226 +
1.227 + nest();
1.228 + substVars($lines, $params);
1.229 +
1.230 + while (my $line = shift @$lines) {
1.231 + chomp($line);
1.232 +
1.233 + # Remove leading spaces
1.234 + $line =~ s/^\s*//g;
1.235 +
1.236 + # skip comments
1.237 + next if ($line =~ /^\/\//);
1.238 +
1.239 + if ($DEBUG == 3) {
1.240 + print "${TABS}:PARSE parseScript: $line\n";
1.241 + }
1.242 +
1.243 + my $argString;
1.244 + my $cmd;
1.245 + if ($line =~ /(\w+)\s*\{/ ) {
1.246 + # parse block commands e.g. large integer
1.247 + $cmd = uc($1);
1.248 +
1.249 + $line =~ s/.*\{//g;
1.250 + while (defined $line && !($line =~ /(^|[^\\]+)\}/) ) {
1.251 + $argString .= $line;
1.252 + $line = shift(@$lines);
1.253 + }
1.254 + if (defined $line) {
1.255 + # append everything up to the closing curly bracket
1.256 + $line =~ s/(^|[^\\])\}.*/$1/g;
1.257 + $argString .= $line;
1.258 + }
1.259 + }
1.260 + elsif ($line =~ /(\w+)\s*=*(.*)/) {
1.261 + # parse commands of the form key = value
1.262 + $cmd = uc($1);
1.263 + $argString = defined $2 ? $2 : "";
1.264 + }
1.265 +
1.266 + if (defined $cmd) {
1.267 + if ($cmd =~ /^END/) {
1.268 + leaveNest();
1.269 + if ($DEBUG) {
1.270 + print "${TABS}:PARSE END\n";
1.271 + }
1.272 + return $derHex;
1.273 + }
1.274 + elsif (! defined $PARSE{$cmd}) {
1.275 + die "parseScript: Unknown command: $cmd\n";
1.276 + }
1.277 + else {
1.278 + if ($DEBUG) {
1.279 + print "${TABS}:PARSE CMD=$cmd";
1.280 + if ($argString ne "") {print " ARG: $argString";}
1.281 + print "\n";
1.282 + }
1.283 +
1.284 + # Substitue variables in argString
1.285 + $derHex .= ":" . &{$PARSE{$cmd}}($argString, $oc, $lines);
1.286 + }
1.287 + }
1.288 +
1.289 + }
1.290 + leaveNest();
1.291 + return $derHex;
1.292 +}
1.293 +
1.294 +sub substVars($$) {
1.295 + my ($lines, $params) = @_;
1.296 +
1.297 + if (! defined $params) {
1.298 + @$params = ();
1.299 + }
1.300 +
1.301 + for (my $i = 0; $i < scalar(@$lines); $i++) {
1.302 + my $line = @$lines[$i];
1.303 + my $paramIndex = 1;
1.304 +
1.305 + # For each parameter search for the a use of $N where
1.306 + # N is the index of the parameter and replace $N with the
1.307 + # value of the parameter
1.308 + foreach (@$params) {
1.309 + $line =~ s/\$${paramIndex}(\D|$)/$_$1/g;
1.310 + ++$paramIndex;
1.311 + }
1.312 +
1.313 + # Remove any unused parameters
1.314 + $line =~ s/\$\d+//g;
1.315 + @$lines[$i] = $line;
1.316 + }
1.317 +}
1.318 +
1.319 +sub readFile($) {
1.320 + my ($fileName) = @_;
1.321 + my $inFile;
1.322 +
1.323 + if ($DEBUG) {
1.324 + print "readFile, $fileName\n";
1.325 + }
1.326 +
1.327 + open($inFile, $fileName) || die "readFile: cannot open $fileName\n";
1.328 + my @lines = <$inFile>;
1.329 + close $inFile;
1.330 +
1.331 + return @lines;
1.332 +}
1.333 +
1.334 +sub parseBitString($$;$) {
1.335 + my ($argString, $oc, $lines) = @_;
1.336 + return encodeBitString($argString, $oc);
1.337 +}
1.338 +
1.339 +sub parseBitStringWrapper($$;$) {
1.340 + my ($argString, $oc, $lines) = @_;
1.341 +
1.342 + my $contents_oc = 0;
1.343 + my $contents = parseScript($lines, \$contents_oc);
1.344 +
1.345 + my $binary = toBin($contents);
1.346 + my $bitCount = $contents_oc * 8;
1.347 + my $bitStr = unpack("B${bitCount}", $binary);
1.348 +
1.349 + # remove trailing zeros - breaks signatures so disable for the moment
1.350 + # $bitStr =~ s/0*$//g;
1.351 +
1.352 + return encodeBitString($bitStr, $oc);
1.353 +}
1.354 +
1.355 +sub parseBmpString($$;$) {
1.356 + my ($argString, $oc, $lines) = @_;
1.357 +
1.358 + my $bmpString_oc = 0;
1.359 + my $bmpString = asciiToBmpString($argString, \$bmpString_oc);
1.360 + return encodeBmpString($bmpString, $bmpString_oc, $oc);
1.361 +}
1.362 +
1.363 +sub parseBmpStringFile($$;$) {
1.364 + my ($binFName, $oc, $lines) = @_;
1.365 + $binFName =~ s/\s*//g;
1.366 +
1.367 + my $bmpString_oc = 0;
1.368 + my $bmpString = encodeBinaryFile($binFName, \$bmpString_oc);
1.369 +
1.370 + return encodeBmpString($bmpString, $bmpString_oc, $oc);
1.371 +}
1.372 +
1.373 +sub parseBoolean($$;$) {
1.374 + my ($argString, $oc, $lines) = @_;
1.375 +
1.376 + $argString =~ s/\s//g;
1.377 + $argString = lc($argString);
1.378 +
1.379 + my $bool;
1.380 + if ($argString eq "t" || $argString eq "true" || $argString eq "1") {
1.381 + $bool = 1;
1.382 + }
1.383 + elsif ($argString eq "f" || $argString eq "false" || $argString eq "0") {
1.384 + $bool = 0;
1.385 + }
1.386 + else {
1.387 + die "parseBoolean: Invalid boolean value \'$argString\'";
1.388 + }
1.389 +
1.390 + return encodeBoolean($bool, $oc);
1.391 +}
1.392 +
1.393 +sub parseHash($$;$) {
1.394 + my ($argString, $oc, $lines) = @_;
1.395 + my ($algorithm) = getArgs($argString);
1.396 +
1.397 + if (! defined $algorithm) {
1.398 + die "parseHash: missing algortithm";
1.399 + }
1.400 +
1.401 + my $hashIn_oc = 0;
1.402 + my $hashIn = parseScript($lines, \$hashIn_oc);
1.403 +
1.404 + my $hashInFName = '_hashin.tmp';
1.405 + my $hashOutFName = '_hashout.tmp';
1.406 +
1.407 + # Create binary hash file
1.408 + my $hashInFh;
1.409 + open($hashInFh, ">$hashInFName") or die "Cannot create $hashInFName";
1.410 + binmode($hashInFh);
1.411 + print $hashInFh toBin($hashIn);
1.412 + close $hashInFh;
1.413 +
1.414 + my @command = ("cmd",
1.415 + "/C \"openssl dgst -${algorithm} -binary $hashInFName > $hashOutFName\"");
1.416 + if ($DEBUG == 1) {
1.417 + print "${TABS}:parseHash:" . join(" ", @command) . "\n";
1.418 + }
1.419 +
1.420 + if ((my $err = system(@command)) != 0) {
1.421 + die "parseHash: " . join(" ", @command) . "\nreturned error $err";
1.422 + }
1.423 +
1.424 + my $derHex = parseIncludeBinaryFile($hashOutFName, $oc);
1.425 +
1.426 + if (! $DEBUG) {
1.427 + unlink($hashInFName);
1.428 + unlink($hashOutFName);
1.429 + }
1.430 + return $derHex;
1.431 +}
1.432 +
1.433 +sub parseHmac($$;$) {
1.434 + my ($argString, $oc, $lines) = @_;
1.435 + my ($algorithm, $key) = getArgs($argString);
1.436 +
1.437 + if (! defined $algorithm) {
1.438 + die "parseHmac: missing algortithm";
1.439 + }
1.440 + $algorithm = uc($algorithm);
1.441 + if (! $algorithm =~ /MD5|SHA1/) {
1.442 + die "parseHmac: invalid algorithm $algorithm";
1.443 + }
1.444 +
1.445 + if (! defined $key) {
1.446 + die "parseHmac: missing key";
1.447 + }
1.448 +
1.449 + my $hmacIn_oc = 0;
1.450 + my $hmacIn = toBin(parseScript($lines, \$hmacIn_oc));
1.451 + my $hmac;
1.452 + my $binKey = toBin($key);
1.453 +
1.454 + if ($algorithm eq "SHA1") {
1.455 +
1.456 + $hmac = Digest::HMAC_SHA1->new($binKey);
1.457 + }
1.458 + else {
1.459 + $hmac = Digest::HMAC_MD5->new($binKey);
1.460 + }
1.461 + $hmac->add($hmacIn);
1.462 + my $digest = $hmac->digest;
1.463 + $$oc += length($digest);
1.464 +
1.465 + return toHex($digest);
1.466 +}
1.467 +
1.468 +sub parseIA5String($$;$) {
1.469 + my ($argString, $oc, $lines) = @_;
1.470 +
1.471 + my $ia5String_oc = 0;
1.472 + my $ia5String = asciiToIA5String($argString, \$ia5String_oc);
1.473 + return encodeIA5String($ia5String, $ia5String_oc, $oc);
1.474 +}
1.475 +
1.476 +
1.477 +sub parseIA5StringFile($$;$) {
1.478 + my ($binFName, $oc, $lines) = @_;
1.479 + $binFName =~ s/\s*//g;
1.480 +
1.481 + my $ia5String_oc = 0;
1.482 + my $ia5String = encodeBinaryFile($binFName, \$ia5String_oc);
1.483 +
1.484 + return encodeIA5String($ia5String, $ia5String_oc, $oc);
1.485 +}
1.486 +
1.487 +sub parseIncludeBinaryFile($$;$) {
1.488 + my ($binFName, $oc, $lines) = @_;
1.489 + $binFName =~ s/\s*//g;
1.490 +
1.491 + return encodeBinaryFile($binFName, $oc);
1.492 +}
1.493 +
1.494 +sub parseInclude($$$) {
1.495 + my ($argString, $oc, $lines) = @_;
1.496 + my @args = getArgs($argString);
1.497 +
1.498 + my $fileName = shift(@args);
1.499 + if (! (defined $fileName && $fileName ne "")) {
1.500 + die "parseInclude: Filename not specified\n";
1.501 + }
1.502 +
1.503 + my $derHex = "";
1.504 + my @lines = readFile($fileName);
1.505 + $derHex = parseScript(\@lines, $oc, \@args);
1.506 + return $derHex;
1.507 +}
1.508 +
1.509 +sub parseInteger($$;$) {
1.510 + my ($argString, $oc, $lines) = @_;
1.511 +
1.512 + $argString =~ s/\s//g;
1.513 + return encodeInteger($argString, $oc);
1.514 +}
1.515 +
1.516 +sub parseBigInteger($$;$) {
1.517 + my ($argString, $oc, $lines) = @_;
1.518 +
1.519 + $argString =~ s/\s//g;
1.520 + return encodeBigInteger($argString, $oc);
1.521 +}
1.522 +
1.523 +sub parseEncrypt($$;$) {
1.524 + my ($argString, $oc, $lines) = @_;
1.525 + my ($cipher, $key, $iv) = getArgs($argString);
1.526 +
1.527 + if (! defined $cipher) {
1.528 + die "parseEncrypt: missing cipher\n";
1.529 + }
1.530 +
1.531 + if (! defined $key) {
1.532 + die "parseEncrypt: missing key\n";
1.533 + }
1.534 +
1.535 + my $plainText_oc = 0;
1.536 + my $plainText = parseScript($lines, \$plainText_oc);
1.537 +
1.538 + my $plainTextFName = '_plaintext.tmp';
1.539 + my $cipherTextFName = '_ciphertext.tmp';
1.540 +
1.541 + # Create binary plaintext file
1.542 + my $plainTextFh;
1.543 + open($plainTextFh, ">$plainTextFName") or die "Cannot create $plainTextFName";
1.544 + binmode($plainTextFh);
1.545 + print $plainTextFh toBin($plainText);
1.546 + close $plainTextFh;
1.547 +
1.548 + my @command = ('openssl',
1.549 + 'enc',
1.550 + "-${cipher}",
1.551 + '-e',
1.552 + '-K', $key,
1.553 + '-in', $plainTextFName,
1.554 + '-out', $cipherTextFName);
1.555 +
1.556 + if (defined $iv) {
1.557 + push @command, '-iv', $iv;
1.558 + }
1.559 +
1.560 + if ($DEBUG == 1) {
1.561 + print "${TABS}:parseEncrypt:" . join(" ", @command) . "\n";
1.562 + }
1.563 +
1.564 + if ((my $err = system(@command)) != 0) {
1.565 + die "parseEncrypt: " . join(" ", @command) . "\nreturned error $err";
1.566 + }
1.567 +
1.568 + my $derHex = parseIncludeBinaryFile($cipherTextFName, $oc);
1.569 +
1.570 + if (! $DEBUG) {
1.571 + unlink($plainTextFName);
1.572 + unlink($cipherTextFName);
1.573 + }
1.574 + return $derHex;
1.575 +}
1.576 +
1.577 +sub parseEnumerated($$;$) {
1.578 + my ($argString, $oc, $lines) = @_;
1.579 +
1.580 + $argString =~ s/\s//g;
1.581 + return encodeEnumerated($argString, $oc);
1.582 +}
1.583 +
1.584 +sub parseExplicit($$;$) {
1.585 + my ($argString, $oc, $lines) = @_;
1.586 + my ($tagNumber, $class) = getArgs($argString);
1.587 +
1.588 + if (! defined $tagNumber || $tagNumber =~ /^\s*$/) {
1.589 + $tagNumber = "0";
1.590 + }
1.591 + elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) {
1.592 + die "parseExplicit: invalid tag number: \'$tagNumber\'";
1.593 + }
1.594 + $tagNumber = hex($tagNumber);
1.595 +
1.596 + if (!defined $class || $class =~ /^\s*$/) {
1.597 + $class = $CONTEXT_SPECIFIC_CLASS;
1.598 + }
1.599 + else {
1.600 + $class =~ s/\s*//g;
1.601 + $class = uc($class);
1.602 + }
1.603 +
1.604 + if (! isValidClass($class)) {
1.605 + die "parseExplicit: invalid class \'$class\'";
1.606 + }
1.607 +
1.608 + my $nested_oc = 0;
1.609 + my $nested = parseScript($lines, \$nested_oc);
1.610 +
1.611 + return encodeExplicit($class, $tagNumber, $nested, $nested_oc, $oc);
1.612 +}
1.613 +
1.614 +sub parseImplicit($$;$) {
1.615 + my ($argString, $oc, $lines) = @_;
1.616 + my ($tagNumber, $class) = getArgs($argString);
1.617 +
1.618 + if (! defined $tagNumber || $tagNumber =~ /^\s*$/) {
1.619 + $tagNumber = "0";
1.620 + }
1.621 + elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) {
1.622 + die "parseImplicit: invalid tag number: \'$tagNumber\'";
1.623 + }
1.624 + $tagNumber = hex($tagNumber);
1.625 +
1.626 + if (!defined $class || $class =~ /^\s*$/) {
1.627 + $class = $CONTEXT_SPECIFIC_CLASS;
1.628 + }
1.629 + else {
1.630 + $class =~ s/\s*//g;
1.631 + $class = uc($class);
1.632 + }
1.633 +
1.634 + if (! isValidClass($class)) {
1.635 + die "parseImplicit: invalid class \'$class\'";
1.636 + }
1.637 +
1.638 + my $nested_oc = 0;
1.639 + my $nested = tidyHex(parseScript($lines, \$nested_oc));
1.640 +
1.641 + # De-construct the nested data to allow the underlying type tag to be
1.642 + # changed. The output of parseScript had better be valid DER or this
1.643 + # will go horribly wrong !
1.644 + my $uClass = "";
1.645 + my $uConstructed = 0;
1.646 + my $uTag = 0;
1.647 + my $uLength = 0;
1.648 + my $uValue = "";
1.649 + getTlv($nested, \$uClass, \$uConstructed, \$uTag, \$uLength, \$uValue);
1.650 +
1.651 + if ($DEBUG == 2) {
1.652 + print "${TABS}parseImplicit: underlyingType \'$uTag\'\n";
1.653 + }
1.654 +
1.655 + # This only works for low tag numbers because we are assuming that the type
1.656 + # tag is a single octet
1.657 + return encodeImplicit($class, $uConstructed, $tagNumber, $uValue, $uLength, $oc);
1.658 +}
1.659 +
1.660 +sub parseNull($$;$) {
1.661 + my ($argString, $oc, $lines) = @_;
1.662 +
1.663 + return encodeNull($oc);
1.664 +}
1.665 +
1.666 +sub parseOctetString($$;$) {
1.667 + my ($argString, $oc, $lines) = @_;
1.668 +
1.669 + my $octetString_oc = 0;
1.670 + my $octetString = parseScript($lines, \$octetString_oc);
1.671 +
1.672 + return encodeOctetString($octetString, $octetString_oc, $oc);
1.673 +}
1.674 +
1.675 +sub parseOid($$;$) {
1.676 + my ($argString, $oc, $lines) = @_;
1.677 + $argString =~ s/\s//g;
1.678 + $argString = uc($argString);
1.679 +
1.680 + if (! defined $argString) {
1.681 + die "parseOid: Missing OID value.";
1.682 + }
1.683 +
1.684 + foreach (keys %OIDS) {
1.685 + if ($argString =~ /$_/) {
1.686 + $argString =~ s/\Q$_\E/$OIDS{$_}/g;
1.687 + }
1.688 + }
1.689 + return encodeOid($argString, $oc);
1.690 +}
1.691 +
1.692 +sub parseOutputFile($$;$) {
1.693 + my ($argString, $oc, $lines) = @_;
1.694 + my ($outputFile,$echo) = split(/,/, $argString);
1.695 +
1.696 + if (! defined $outputFile) {
1.697 + die "parseOutputFile: Missing file-name.\n";
1.698 + }
1.699 +
1.700 + my $content_oc = 0;
1.701 + my $content = parseScript($lines, \$content_oc);
1.702 +
1.703 + my $outFh;
1.704 + if (! open($outFh, ">${outputFile}")) {
1.705 + die "parseOutputFile: Cannot create $outputFile\n";
1.706 + }
1.707 + binmode($outFh);
1.708 + print $outFh toBin($content);
1.709 + close $outFh;
1.710 +
1.711 + # If echo is specified then include then contents of the output
1.712 + # file at this point in the stream.
1.713 + if (defined $echo && $echo =~ /(1|t|true)/i) {
1.714 + $$oc += $content_oc;
1.715 + return $content;
1.716 + }
1.717 + else {
1.718 + return "";
1.719 + }
1.720 +}
1.721 +
1.722 +sub parsePrintableString($$;$) {
1.723 + my ($argString, $oc, $lines) = @_;
1.724 +
1.725 + my $printableString_oc = 0;
1.726 + my $printableString = asciiToPrintableString($argString, \$printableString_oc);
1.727 + return encodePrintableString($printableString, $printableString_oc, $oc);
1.728 +}
1.729 +
1.730 +sub parsePrintableStringFile($$;$) {
1.731 + my ($binFName, $oc, $lines) = @_;
1.732 + $binFName =~ s/\s*//g;
1.733 +
1.734 + my $printableString_oc = 0;
1.735 + my $printableString = encodeBinaryFile($binFName, \$printableString_oc);
1.736 +
1.737 + return encodePrintableString($printableString, $printableString_oc, $oc);
1.738 +}
1.739 +
1.740 +sub parseRaw($$;$) {
1.741 + my ($argString, $oc, $lines) = @_;
1.742 + $argString =~ s/\s//g;
1.743 + $argString = uc($argString);
1.744 +
1.745 + my $asnHex = "";
1.746 + if (! ($argString =~ /(([A-Fa-f\d][A-Fa-f\d])[ :]*)+/)) {
1.747 + die "parseRaw: Invalid hex string: $argString\n";
1.748 + }
1.749 + my $binary = toBin($argString);
1.750 + $$oc += length($binary);
1.751 + return tidyHex(toHex($binary));
1.752 +}
1.753 +
1.754 +sub parseSequence($$;$) {
1.755 + my ($argString, $oc, $lines) = @_;
1.756 +
1.757 + my $sequence_oc = 0;
1.758 + my $sequence = parseScript($lines, \$sequence_oc);
1.759 +
1.760 + return encodeSequence($sequence, $sequence_oc, $oc);
1.761 +}
1.762 +
1.763 +sub parseSet($$;$) {
1.764 + my ($argString, $oc, $lines) = @_;
1.765 +
1.766 + my $set_oc = 0;
1.767 + my $set = parseScript($lines, \$set_oc);
1.768 +
1.769 + return encodeSet($set, $set_oc, $oc);
1.770 +}
1.771 +
1.772 +# Create a PKCS#7 signed data object for a chunk of data using
1.773 +# OpenSSL's SMIME command
1.774 +sub parseSign($$;$) {
1.775 + my ($argString, $oc, $lines) = @_;
1.776 + my ($signerCert, $signerKey) = getArgs($argString);
1.777 +
1.778 + if (! defined $signerCert) {
1.779 + die "parseSign: missing signing certificate";
1.780 + }
1.781 + elsif (! -f $signerCert) {
1.782 + die "parseSign: signing certificate \'$signerCert\' does not exist.";
1.783 + }
1.784 +
1.785 + if (! defined $signerKey) {
1.786 + die "parseSign: missing signing certificate";
1.787 + }
1.788 + elsif (! -f $signerKey) {
1.789 + die "parseSign: signing key \'$signerKey\' does not exist.";
1.790 + }
1.791 +
1.792 + my $unsigned_oc = 0;
1.793 + my $unsigned = parseScript($lines, \$unsigned_oc);
1.794 +
1.795 + my $unsignedFName = '_unsigned.tmp';
1.796 + my $signedFName = '_signed.tmp';
1.797 +
1.798 + # Create binary unsigned data file
1.799 + my $unsignedFh;
1.800 + open($unsignedFh, ">$unsignedFName") or die "Cannot create $unsignedFName";
1.801 + binmode($unsignedFh);
1.802 + print $unsignedFh toBin($unsigned);
1.803 + close $unsignedFh;
1.804 +
1.805 + my @command = ('openssl',
1.806 + 'smime',
1.807 + '-pk7out',
1.808 + '-nodetach',
1.809 + '-outform',
1.810 + 'der',
1.811 + '-sign',
1.812 + '-signer',
1.813 + $signerCert,
1.814 + '-inkey',
1.815 + $signerKey,
1.816 + '-in', $unsignedFName,
1.817 + '-out', $signedFName);
1.818 +
1.819 + if ($DEBUG == 1) {
1.820 + print "${TABS}:parseSign:" . join(" ", @command) . "\n";
1.821 + }
1.822 +
1.823 + if ((my $err = system(@command)) != 0) {
1.824 + die "parseSign: " . join(" ", @command) . "\nreturned error $err";
1.825 + }
1.826 +
1.827 + my $derHex = parseIncludeBinaryFile($signedFName, $oc);
1.828 +
1.829 + if (! $DEBUG) {
1.830 + unlink($unsignedFName);
1.831 + unlink($signedFName);
1.832 + }
1.833 + return $derHex;
1.834 +}
1.835 +
1.836 +sub parseShell($$;$) {
1.837 + my ($argString, $oc, $lines) = @_;
1.838 + my @command = getArgs($argString);
1.839 +
1.840 + if (scalar(@command) < 1) {
1.841 + die "parseShell: no arguments";
1.842 + }
1.843 +
1.844 + if ($DEBUG == 1) {
1.845 + print "${TABS}:parseShell:" . join(" ", @command) . "\n";
1.846 + }
1.847 +
1.848 + if ((my $err = system(@command)) != 0) {
1.849 + die "parseShell: " . join(" ", @command) . "\nreturned error $err";
1.850 + }
1.851 + return "";
1.852 +}
1.853 +
1.854 +sub parseUtcTime($$;$) {
1.855 + my ($time, $oc, $lines) = @_;
1.856 + $time =~ s/\s//g;
1.857 +
1.858 + my $time_oc = length($time);
1.859 + return encodeUtcTime(toHex($time), $time_oc, $oc);
1.860 +}
1.861 +
1.862 +sub parseUtf8String($$;$) {
1.863 + my ($argString, $oc, $lines) = @_;
1.864 +
1.865 + my $utf8String_oc = 0;
1.866 + my $utf8String = asciiToUtf8String($argString, \$utf8String_oc);
1.867 + return encodeUtf8String($utf8String, $utf8String_oc, $oc);
1.868 +}
1.869 +
1.870 +sub parseUtf8StringFile($$;$) {
1.871 + my ($binFName, $oc, $lines) = @_;
1.872 + $binFName =~ s/\s*//g;
1.873 +
1.874 + my $utf8String_oc = 0;
1.875 + my $utf8String = encodeBinaryFile($binFName, \$utf8String_oc);
1.876 +
1.877 + return encodeUtf8String($utf8String, $utf8String_oc, $oc);
1.878 +}
1.879 +
1.880 +sub toHex($) {
1.881 + my ($bin) = @_;
1.882 + my $hex = unpack("H" . (length($bin) * 2), $bin);
1.883 + $hex =~ s/(..)/$1:/g;
1.884 + return $hex;
1.885 +}
1.886 +
1.887 +sub encodeBinaryFile($$) {
1.888 + my ($binFName, $oc) = @_;
1.889 +
1.890 + my $binFH;
1.891 + open($binFH, "$binFName") || die "encodeBinaryFile: Cannot open $binFName\n";
1.892 + binmode($binFH);
1.893 +
1.894 + my $binBuf;
1.895 + my $readBuf;
1.896 + my $derHex = "";
1.897 + while (my $len = sysread($binFH, $readBuf, 1024)) {
1.898 + $binBuf .= $readBuf;
1.899 + $$oc += $len;
1.900 + }
1.901 + close $binFH;
1.902 +
1.903 + return toHex($binBuf);;
1.904 +}
1.905 +
1.906 +# Creates a hex representation of the DER encoding of an arbitrary length bit string
1.907 +sub encodeBitString($$) {
1.908 + my ($text, $oc) = @_;
1.909 +
1.910 + # Bit string in hex including padding length octet
1.911 + my $bit_str = "";
1.912 + my $bit_str_oc = 1; # one octet for padding
1.913 +
1.914 + # Current byte
1.915 + my $byte = 0;
1.916 + my $len = length($text);
1.917 +
1.918 + if ($len == 0) {
1.919 + $$oc+=2;
1.920 + return "03:00";
1.921 + }
1.922 +
1.923 + my $i = 0;
1.924 + while ($i < $len) {
1.925 +
1.926 + # Read the ith character and insert it in the correct place in the byte
1.927 + # (fill from the left)
1.928 + my $c = substr($text, $i, 1);
1.929 + if ($c eq "1") {
1.930 + $byte |= (1 << (7 - ($i % 8)));
1.931 + }
1.932 + elsif ($c ne "0") {
1.933 + die "Invalid character $c in bit string $text";
1.934 + }
1.935 +
1.936 + if (++$i % 8 == 0) {
1.937 + # Received 8 bits so output byte in hex
1.938 + if ($bit_str ne "") {
1.939 + $bit_str .= ":";
1.940 + }
1.941 + $bit_str .= sprintf("%2.2x", $byte);
1.942 + $bit_str_oc++;
1.943 + $byte = 0;
1.944 + }
1.945 + }
1.946 + # Pad any remaining bits / make sure 0 is output for empty string
1.947 + if ($byte != 0 || $bit_str_oc == 1) {
1.948 + if ($bit_str ne "") {
1.949 + $bit_str .= ":";
1.950 + }
1.951 + $bit_str .= sprintf("%2.2x", $byte);
1.952 + $bit_str_oc++;
1.953 + }
1.954 +
1.955 + my $pad_length = "00";
1.956 + if ($len % 8 > 0) {
1.957 + # If this isn't a multiple of 8 bits then calculated
1.958 + # the number of padding bits added.
1.959 + $pad_length = sprintf("%2.2x", 8 - ($len % 8));
1.960 + }
1.961 +
1.962 + if ($DEBUG == 2) {
1.963 + print "${TABS}:ENC:encodeBitString, $bit_str_oc\n";
1.964 + }
1.965 + return encodeTlv($oc, $DER_BITSTRING_TAG, $bit_str_oc, "$pad_length:$bit_str");
1.966 +}
1.967 +
1.968 +# Creates a hex represenation of the DER encoding of a BMPSTRING
1.969 +sub encodeBmpString($$$) {
1.970 + my ($bmpString, $bmpString_oc, $oc) = @_;
1.971 +
1.972 + if ($DEBUG == 2) {
1.973 + print "${TABS}:ENC:encodeBmpString, $bmpString_oc\n";
1.974 + }
1.975 + return encodeTlv($oc, $DER_BMPSTRING_TAG, $bmpString_oc, $bmpString);
1.976 +}
1.977 +
1.978 +sub encodeBoolean($$) {
1.979 + my ($value, $oc) = @_;
1.980 +
1.981 + my $boolean = "00";
1.982 + if ($value) {
1.983 + $boolean = "FF";
1.984 + }
1.985 +
1.986 + if ($DEBUG == 2) {
1.987 + print "${TABS}:ENC:encodeBoolean, 1\n";
1.988 + }
1.989 + return encodeTlv($oc, $DER_BOOLEAN_TAG, 1, $boolean);
1.990 +}
1.991 +
1.992 +sub encodeEnumerated($$) {
1.993 + my ($int, $oc) = @_;
1.994 +
1.995 + $int =~ s/\s//g;
1.996 +
1.997 + if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) {
1.998 + die "encodeEnumerated: Invalid argument: $int\n";
1.999 + }
1.1000 +
1.1001 + if ($int =~ s/^0x//) {
1.1002 + $int = hex;
1.1003 + }
1.1004 +
1.1005 + # Convert the enumerated to base 256 hex and find out how
1.1006 + # many octets were required
1.1007 + my $hex_enumerated_oc = 0;
1.1008 + my $hex_enumerated = "";
1.1009 +
1.1010 + if ($int ne "") {
1.1011 + $hex_enumerated = encodeBase256($int, \$hex_enumerated_oc);
1.1012 + }
1.1013 +
1.1014 + if ($DEBUG == 2) {
1.1015 + print "${TABS}:ENC: , $hex_enumerated_oc\n";
1.1016 + }
1.1017 +
1.1018 + return encodeTlv($oc, $DER_ENUMERATED_TAG, $hex_enumerated_oc, $hex_enumerated);
1.1019 +}
1.1020 +
1.1021 +# explicit tags are always constructed
1.1022 +sub encodeExplicit($$$$) {
1.1023 + my ($class, $tagNumber, $explicit, $explicit_oc, $oc) = @_;
1.1024 +
1.1025 + if ($DEBUG == 2) {
1.1026 + print "${TABS}:ENC: explicit, $explicit_oc\n";
1.1027 + }
1.1028 + return encodeTlv($oc, $tagNumber, $explicit_oc, $explicit, 1, $class);
1.1029 +}
1.1030 +
1.1031 +# Creates a hex represenation of the DER encoding of an IA5 string
1.1032 +sub encodeIA5String($$) {
1.1033 + my ($ia5String, $ia5String_oc, $oc) = @_;
1.1034 +
1.1035 + if ($DEBUG == 2) {
1.1036 + print "${TABS}:ENC:encodeIA5String, $ia5String_oc\n";
1.1037 + }
1.1038 + return encodeTlv($oc, $DER_IA5STRING_TAG, $ia5String_oc, $ia5String);
1.1039 +}
1.1040 +
1.1041 +sub encodeImplicit($$$$$) {
1.1042 + my ($class, $constructed, $tagNumber, $implicit, $implicit_oc, $oc) = @_;
1.1043 +
1.1044 + if ($DEBUG == 2) {
1.1045 + print "${TABS}:ENC: implicit, $implicit_oc\n";
1.1046 + }
1.1047 + return encodeTlv($oc, $tagNumber, $implicit_oc, $implicit, $constructed, $class);
1.1048 +}
1.1049 +
1.1050 +sub encodeBigInteger($$) {
1.1051 + my ($hexString, $oc) = @_;
1.1052 +
1.1053 + my $bin = toBin($hexString);
1.1054 + my $int = toHex($bin);
1.1055 + my $int_oc = length($bin);
1.1056 +
1.1057 + if ($DEBUG == 2) {
1.1058 + print "${TABS}:ENC: bigInteger, $int_oc\n";
1.1059 + }
1.1060 + return encodeTlv($oc, $DER_INTEGER_TAG, $int_oc, $int)
1.1061 +}
1.1062 +
1.1063 +sub encodeInteger($$) {
1.1064 + my ($int, $oc) = @_;
1.1065 +
1.1066 + $int =~ s/\s//g;
1.1067 +
1.1068 + if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) {
1.1069 + die "encodeInteger: Invalid argument: $int\n";
1.1070 + }
1.1071 +
1.1072 + if ($int =~ s/^0x//) {
1.1073 + $int = hex;
1.1074 + }
1.1075 +
1.1076 + # Convert the integer to base 256 hex and find out how
1.1077 + # many octets were required
1.1078 + my $hex_integer_oc = 0;
1.1079 + my $hex_integer = "";
1.1080 +
1.1081 + if ($int ne "") {
1.1082 + $hex_integer = encodeBase256($int, \$hex_integer_oc);
1.1083 + }
1.1084 +
1.1085 + if ($DEBUG == 2) {
1.1086 + print "${TABS}:ENC: integer, $hex_integer_oc\n";
1.1087 + }
1.1088 +
1.1089 + return encodeTlv($oc, $DER_INTEGER_TAG, $hex_integer_oc, $hex_integer);
1.1090 +}
1.1091 +
1.1092 +sub encodeNull($) {
1.1093 + my ($oc) = @_;
1.1094 + return encodeTlv($oc, $DER_NULL_TAG, 0, "");
1.1095 +}
1.1096 +
1.1097 +sub encodeOctetString($$$) {
1.1098 + my ($octetString, $octetString_oc, $oc) = @_;
1.1099 +
1.1100 + if ($DEBUG == 2) {
1.1101 + print "${TABS}:ENC: octetString, $octetString_oc\n";
1.1102 + }
1.1103 + return encodeTlv($oc, $DER_OCTETSTRING_TAG, $octetString_oc, $octetString);
1.1104 +}
1.1105 +
1.1106 +sub encodeOid($$) {
1.1107 + my ($text, $oc) = @_;
1.1108 +
1.1109 + my @fields = split /\./, $text;
1.1110 +
1.1111 + if (! ($fields[0] >= 0 && $fields[0] <=2) ) {
1.1112 + die "Invalid OID: $text\n";
1.1113 + }
1.1114 + if (! ($fields[1] >= 0 && $fields[1] <= 39) ) {
1.1115 + die "Invalid OID: $text";
1.1116 + }
1.1117 +
1.1118 + my $oid = sprintf("%2.2x", (40 * $fields[0]) + $fields[1]);
1.1119 + my $oid_oc = 1;
1.1120 + shift @fields;
1.1121 + shift @fields;
1.1122 +
1.1123 + foreach (@fields) {
1.1124 + $oid .= ":" . encodeBase128($_, \$oid_oc);
1.1125 + }
1.1126 +
1.1127 + if ($DEBUG == 2) {
1.1128 + print "${TABS}:ENC:encodeOid, $oid_oc\n";
1.1129 + }
1.1130 + return encodeTlv($oc, $DER_OID_TAG, $oid_oc, $oid);
1.1131 +}
1.1132 +
1.1133 +# Creates a hex represenation of the DER encoding of a PRINTABLE string
1.1134 +sub encodePrintableString($$$) {
1.1135 + my ($printableString, $printableString_oc, $oc) = @_;
1.1136 +
1.1137 + if ($DEBUG == 2) {
1.1138 + print "${TABS}:ENC:encodePrintableString, $printableString_oc\n";
1.1139 + }
1.1140 + return encodeTlv($oc, $DER_PRINTABLESTRING_TAG, $printableString_oc, $printableString);
1.1141 +}
1.1142 +
1.1143 +sub encodeSet($$$) {
1.1144 + my ($set, $set_oc, $oc) = @_;
1.1145 +
1.1146 + if ($DEBUG == 2) {
1.1147 + print "${TABS}:ENC: set, $set_oc\n";
1.1148 + }
1.1149 + return encodeTlv($oc, $DER_SET_TAG, $set_oc, $set, 1);
1.1150 +}
1.1151 +
1.1152 +sub encodeSequence($$$) {
1.1153 + my ($sequence, $sequence_oc, $oc) = @_;
1.1154 +
1.1155 + if ($DEBUG == 2) {
1.1156 + print "${TABS}:ENC: sequence, $sequence_oc\n";
1.1157 + }
1.1158 + return encodeTlv($oc, $DER_SEQUENCE_TAG, $sequence_oc, $sequence, 1);
1.1159 +}
1.1160 +
1.1161 +sub encodeUtcTime($$$) {
1.1162 + my ($utcTime, $utcTime_oc, $oc) = @_;
1.1163 +
1.1164 + if ($DEBUG == 2) {
1.1165 + print "${TABS}:ENC: UTCTime, $utcTime_oc\n";
1.1166 + }
1.1167 + return encodeTlv($oc, $DER_UTCTIME_TAG, $utcTime_oc, $utcTime);
1.1168 +}
1.1169 +
1.1170 +# Creates a hex represenation of the DER encoding of a UTF-8 string.
1.1171 +sub encodeUtf8String($$) {
1.1172 + my ($utf8String, $utf8String_oc, $oc) = @_;
1.1173 +
1.1174 + if ($DEBUG == 2) {
1.1175 + print "${TABS}:ENC:encodeUTF8String, $utf8String_oc\n";
1.1176 + }
1.1177 + return encodeTlv($oc, $DER_UTF8STRING_TAG, $utf8String_oc, $utf8String);
1.1178 +}
1.1179 +
1.1180 +sub asciiToBmpString($$) {
1.1181 + my ($input, $oc) = @_;
1.1182 +
1.1183 + my $bmpString = "";
1.1184 + my $input_len = length($input);
1.1185 + $$oc += $input_len * 2;
1.1186 +
1.1187 + for (my $i = 0; $i < $input_len; ++$i) {
1.1188 + my $hex_val = ord(substr($input, $i, 1));
1.1189 + if ($bmpString ne "") {
1.1190 + $bmpString .= ":";
1.1191 + }
1.1192 + $bmpString .= sprintf(":00:%2.2x", $hex_val);
1.1193 + }
1.1194 + return $bmpString;
1.1195 +}
1.1196 +
1.1197 +sub asciiToIA5String($$) {
1.1198 + my ($input, $oc) = @_;
1.1199 +
1.1200 + my $printableString = "";
1.1201 + my $input_len = length($input);
1.1202 + $$oc += $input_len;
1.1203 +
1.1204 + for (my $i = 0; $i < $input_len; ++$i) {
1.1205 + my $hex_val = ord(substr($input, $i, 1));
1.1206 + if ($printableString ne "") {
1.1207 + $printableString .= ":";
1.1208 + }
1.1209 + $printableString .= sprintf(":%2.2x", $hex_val);
1.1210 + }
1.1211 + return $printableString;
1.1212 +}
1.1213 +
1.1214 +sub asciiToPrintableString($$) {
1.1215 + my ($input, $oc) = @_;
1.1216 +
1.1217 + my $ia5String = "";
1.1218 + my $input_len = length($input);
1.1219 + $$oc += $input_len;
1.1220 +
1.1221 + for (my $i = 0; $i < $input_len; ++$i) {
1.1222 + my $hex_val = ord(substr($input, $i, 1));
1.1223 + if ($ia5String ne "") {
1.1224 + $ia5String .= ":";
1.1225 + }
1.1226 + $ia5String .= sprintf(":%2.2x", $hex_val);
1.1227 + }
1.1228 + return $ia5String;
1.1229 +}
1.1230 +
1.1231 +sub asciiToUtf8String($$) {
1.1232 + my ($input, $oc) = @_;
1.1233 +
1.1234 + my $utf8String = "";
1.1235 + my $input_len = length($input);
1.1236 + $$oc += $input_len;
1.1237 +
1.1238 + for (my $i = 0; $i < $input_len; ++$i) {
1.1239 + my $hex_val = ord(substr($input, $i, 1));
1.1240 + if ($utf8String ne "") {
1.1241 + $utf8String .= ":";
1.1242 + }
1.1243 + $utf8String .= sprintf(":%2.2x", $hex_val);
1.1244 + }
1.1245 + return $utf8String;
1.1246 +}
1.1247 +
1.1248 +sub encodeBase128($$$) {
1.1249 + my ($num, $oc) = @_;
1.1250 +
1.1251 + my $base128 = "";
1.1252 + $num = int($num);
1.1253 + my $base128_length = 0;
1.1254 +
1.1255 + while ($num > 0) {
1.1256 + my $hexoctet;
1.1257 +
1.1258 + if ($base128 eq "") {
1.1259 + $hexoctet = sprintf("%2.2x", $num & 0x7f);
1.1260 + }
1.1261 + else {
1.1262 + $hexoctet = sprintf("%2.2x", ($num & 0x7f) | 0x80);
1.1263 + }
1.1264 +
1.1265 + if ($base128 eq "") {
1.1266 + $base128 = $hexoctet;
1.1267 + }
1.1268 + else {
1.1269 + $base128 = "$hexoctet:$base128";
1.1270 + }
1.1271 +
1.1272 + $num >>= 7;
1.1273 + $base128_length++;
1.1274 + }
1.1275 + if ($base128 eq "") {
1.1276 + $base128 = "00";
1.1277 + $base128_length++;
1.1278 + }
1.1279 +
1.1280 + $$oc += $base128_length;
1.1281 +
1.1282 + if ($DEBUG == 2) {
1.1283 + print "${TABS}:ENC: base128, $base128_length, $$oc\n";
1.1284 + }
1.1285 +
1.1286 + return $base128;
1.1287 +}
1.1288 +
1.1289 +# Return a hex represenation of the length using DER primitive (definate length encoding)
1.1290 +sub encodeLength($$) {
1.1291 + my ($num, $oc) = @_;
1.1292 +
1.1293 + if ($num < 128) {
1.1294 + # Number is < 128 so encode in short form
1.1295 + $$oc++;
1.1296 + return sprintf("%2.2x", $num);
1.1297 + }
1.1298 + else {
1.1299 + # Number >= 128 so encode in long form
1.1300 + my $length_oc = 0;
1.1301 + my $base256 = &encodeBase256($num, \$length_oc, 1);
1.1302 + if ($length_oc > 127) {die "Encoding overflow.";}
1.1303 +
1.1304 + $$oc += 1 + $length_oc;
1.1305 +
1.1306 + # Set the top bit of the length octet to indicate long form
1.1307 + return "" . sprintf("%2.2x", ($length_oc | 0x80)) . ":$base256";
1.1308 + }
1.1309 +}
1.1310 +
1.1311 +# Convert an integer into an ascii hex representation in base 256
1.1312 +# $num - the number to encode
1.1313 +# $octets - refernce to the octet count to increment
1.1314 +# $unsigned - assume unsigned
1.1315 +sub encodeBase256($$) {
1.1316 + my ($numIn, $oc, $unsigned) = @_;
1.1317 +
1.1318 + my $base256 = "";
1.1319 + my $num = int($numIn);
1.1320 +
1.1321 + while ($num != 0) {
1.1322 + my $hexoctet = sprintf("%2.2x", $num & 0xFF);
1.1323 + if ($base256 ne "") {
1.1324 + $base256 = "$hexoctet:$base256";
1.1325 + }
1.1326 + else {
1.1327 + $base256 = $hexoctet;
1.1328 + }
1.1329 + $num >>= 8;
1.1330 + $$oc++;
1.1331 + }
1.1332 + if ($base256 eq "") {
1.1333 + $base256 = "00";
1.1334 + $$oc++;
1.1335 + }
1.1336 +
1.1337 + # If the integer is +ve and the MSB is 1 then padd with a leading zero
1.1338 + # octet otherwise it will look -ve
1.1339 + if ((! $unsigned) && $numIn > 0 && $base256 =~ /^:*[8ABCDEF]/i) {
1.1340 + $base256 = "00:$base256";
1.1341 + $$oc++;
1.1342 + }
1.1343 +
1.1344 + # If the first octet is all ones and the msb of the next bit
1.1345 + # is also one then drop the first octet because negative
1.1346 + # numbers should not be padded
1.1347 + while ($base256 =~ s/^(FF:)([8ABCDEF][0-9A-F].*)/$2/i) {
1.1348 + $$oc--;
1.1349 + }
1.1350 +
1.1351 + return $base256;
1.1352 +}
1.1353 +
1.1354 +# Encode the Type
1.1355 +# Only low tag form is supported at the moment
1.1356 +sub encodeType($$;$$) {
1.1357 + my ($oc, $tagNumber, $constructed, $class) = @_;
1.1358 +
1.1359 + $tagNumber = hex($tagNumber);
1.1360 +
1.1361 + if ($tagNumber < 0 || $tagNumber > 30) {
1.1362 + die "encodeType: Currently, only low tag numbers (0 - 30) are supported.";
1.1363 + }
1.1364 +
1.1365 + if (! defined $class) {
1.1366 + $class = "UNIVERSAL";
1.1367 + }
1.1368 +
1.1369 + $class = uc($class);
1.1370 + if (! isValidClass($class)) {
1.1371 + die "encodeType: invalid class \'$class\'";
1.1372 + }
1.1373 +
1.1374 + # If the type is constructed then set bit 6
1.1375 + if (defined $constructed && $constructed == 1) {
1.1376 + $tagNumber |= 0x20;
1.1377 + }
1.1378 +
1.1379 + if ($class eq $UNIVERSAL_CLASS) {
1.1380 + # do nothing, bits 7 and 8 are zero
1.1381 + }
1.1382 + elsif ($class eq $APPLICATION_CLASS) {
1.1383 + # set bit 7
1.1384 + $tagNumber |= 0x40;
1.1385 + }
1.1386 + elsif ($class eq $CONTEXT_SPECIFIC_CLASS) {
1.1387 + # set bit 8
1.1388 + $tagNumber |= 0x80;
1.1389 + }
1.1390 + elsif ($class eq $PRIVATE_CLASS) {
1.1391 + # set bits 7 and 8
1.1392 + $tagNumber |= 0xC0;
1.1393 + }
1.1394 + $$oc++;
1.1395 + return sprintf("%2.2x", $tagNumber);
1.1396 +}
1.1397 +
1.1398 +sub encodeTlv($$$$;$$) {
1.1399 + my ($oc, $tag, $length, $value, $constructed, $class) = @_;
1.1400 +
1.1401 + if ($DEBUG == 3) {
1.1402 + print "${TABS}encodeTlv\n";
1.1403 + print "${TABS}oc=$$oc\n";
1.1404 + print "${TABS}tag=$tag\n";
1.1405 + print "${TABS}length=$length\n";
1.1406 + print "${TABS}value=$value\n";
1.1407 + if (defined $constructed) {
1.1408 + print "${TABS}constructed=$constructed\n";
1.1409 + }
1.1410 + if (defined $class) {
1.1411 + print "${TABS}class=$class\n";
1.1412 + }
1.1413 + }
1.1414 +
1.1415 + my $hex;
1.1416 + $hex = encodeType($oc, $tag, $constructed, $class);
1.1417 + $hex .= ":" . encodeLength($length, $oc);
1.1418 + $$oc += $length;
1.1419 + $hex .= ":" . $value;
1.1420 +
1.1421 + if ($DEBUG == 3) {
1.1422 + print "${TABS}oc=$$oc\n";
1.1423 + print "${TABS}encoding=$hex\n";
1.1424 + print "${TABS}end\n";
1.1425 +
1.1426 + toBin($hex);
1.1427 + }
1.1428 + return $hex;
1.1429 +}
1.1430 +
1.1431 +# increment debug tabbing level
1.1432 +sub nest() {
1.1433 + $TABS .= " ";
1.1434 +}
1.1435 +
1.1436 +# decrement debug tabbing level
1.1437 +sub leaveNest() {
1.1438 + $TABS =~ s/^...//;
1.1439 +}
1.1440 +
1.1441 +sub isValidClass($) {
1.1442 + my ($class) = @_;
1.1443 +
1.1444 + if (defined $class &&
1.1445 + $class =~ /^(UNIVERSAL|APPLICATION|CONTEXT-SPECIFIC|PRIVATE)$/) {
1.1446 + return 1;
1.1447 + }
1.1448 + return 0;
1.1449 +}
1.1450 +
1.1451 +# Parse a DER field
1.1452 +sub getTlv($$$$$$) {
1.1453 + my ($input, $class, $constructed, $tag, $length, $value) = @_;
1.1454 +
1.1455 + my @hexOctets = split(/:+/,tidyHex($input));
1.1456 +
1.1457 + if (scalar(@hexOctets) < 2) {
1.1458 + die "getTlv: too short";
1.1459 + }
1.1460 +
1.1461 + my $type = hex(shift @hexOctets);
1.1462 + if (($type & 0xC0) == 0x00) {
1.1463 + # universal: bit 8 = 0, bit 7 = 0
1.1464 + $$class = $UNIVERSAL_CLASS;
1.1465 + }
1.1466 + elsif (($type & 0xC0) == 0x40) {
1.1467 + # application: bit 8 = 0, bit 7 = 1
1.1468 + $$class = $APPLICATION_CLASS;
1.1469 + }
1.1470 + elsif (($type & 0xC0) == 0x80) {
1.1471 + # application: bit 8 = 1, bit 7 = 0
1.1472 + $$class = $CONTEXT_SPECIFIC_CLASS;
1.1473 + }
1.1474 + elsif (($type & 0xC0) == 0xC0) {
1.1475 + # application: bit 8 = 1, bit 7 = 1
1.1476 + $$class = $PRIVATE_CLASS;
1.1477 + }
1.1478 + else {
1.1479 + die "getTlv: assert";
1.1480 + }
1.1481 +
1.1482 + if ($type & 0x20) {
1.1483 + # constructed if bit 6 = 1
1.1484 + $$constructed = 1;
1.1485 + }
1.1486 + else {
1.1487 + $$constructed = 0;
1.1488 + }
1.1489 +
1.1490 + # We assumme the tag number is in low form
1.1491 + # and just look at the bottom 5 hits
1.1492 + $$tag = $type & 0x1F;
1.1493 +
1.1494 + $$length = hex(shift @hexOctets);
1.1495 + if ($$length & 0x80) {
1.1496 + # long form
1.1497 + my $length_oc = $$length & 0x7F;
1.1498 + $$length = 0;
1.1499 + for (my $i = 0; $i < $length_oc; $i++) {
1.1500 + # length is encoded base 256
1.1501 + $$length *= 256;
1.1502 + $$length += hex(shift @hexOctets);
1.1503 + }
1.1504 + }
1.1505 + else {
1.1506 + # short form
1.1507 + # don't do anything here, length is just bits 7 - 1 and
1.1508 + # we already know bit 8 is zero.
1.1509 + }
1.1510 +
1.1511 + $$value = "";
1.1512 + foreach (@hexOctets) {
1.1513 + $$value .= ":$_";
1.1514 + }
1.1515 +
1.1516 + if ($DEBUG == 3) {
1.1517 + print "${TABS} class=$$class\n";
1.1518 + print "${TABS} constructed=$$constructed\n";
1.1519 + print "${TABS} tag=$$tag\n";
1.1520 + print "${TABS} length=$$length\n";
1.1521 + }
1.1522 +}
1.1523 +
1.1524 +# parse an escaped (\) comma seperated argument string
1.1525 +# into an array
1.1526 +sub getArgs($) {
1.1527 + my ($argString) = @_;
1.1528 + my @args = ();
1.1529 +
1.1530 + while ($argString =~ /(^|.*?[^\\]),(.*)/ ) {
1.1531 + my $match = $1;
1.1532 + $argString = $2;
1.1533 + if ($match ne "") {
1.1534 +
1.1535 + # unescape
1.1536 + $match =~ s/(\\)([^\\])/$2/g;
1.1537 + push @args, $match;
1.1538 + }
1.1539 + }
1.1540 + if ($argString ne "") {
1.1541 + push @args, $argString;
1.1542 + }
1.1543 + return @args;
1.1544 +}