First public contribution.
2 # Copyright (c) 2009 Nokia Corporation and/or its subsidiary(-ies).
4 # This component and the accompanying materials are made available
5 # under the terms of the License "Eclipse Public License v1.0"
6 # which accompanies this distribution, and is available
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html".
9 # Initial Contributors:
10 # Nokia Corporation - initial contribution.
20 use Digest::HMAC_SHA1;
25 # 2 = log parsing + encoding
26 # 3 = really verbose stuff
29 # Turn on validation checks that attempt to only generate
30 # valid DER encodings.
33 my $OID_PKCS = "1.2.840.113549.1";
34 my $OID_PKCS7 ="${OID_PKCS}.7";
35 my $OID_PKCS9 = "${OID_PKCS}.9";
36 my $OID_PKCS9_CERTTYPES = "${OID_PKCS9}.22";
37 my $OID_PKCS12 = "${OID_PKCS}.12";
38 my $OID_PKCS12_BAGTYPES = "${OID_PKCS12}.10.1";
39 my $OID_PKCS12_PBEIDS = "${OID_PKCS12}.1";
43 "MD5" => "1.2.840.113549.2.5",
44 "SHA1" => "1.3.14.3.2.26",
45 "X509CRL" => "1.3.6.1.4.1.3627.4",
47 "PKCS7_DATA" => "${OID_PKCS7}.1",
48 "PKCS7_SIGNEDDATA" => "${OID_PKCS7}.2",
49 "PKCS7_ENVELOPEDDATA" => "${OID_PKCS7}.3",
50 "PKCS7_SIGNEDANDENVELOPEDDATA" => "${OID_PKCS7}.4",
51 "PKCS7_DIGESTEDDATA" => "${OID_PKCS7}.5",
52 "PKCS7_ENCRYPTEDDATA" => "${OID_PKCS7}.6",
54 "PKCS9_CERTTYPES_PKCS12_X509" => "${OID_PKCS9_CERTTYPES}.1",
55 "PKCS9_FRIENDLY_NAME" => "${OID_PKCS9}.20",
56 "PKCS9_LOCAL_KEYID" => "${OID_PKCS9}.21",
58 "PKCS12_BAGTYPES_KEYBAG" => "${OID_PKCS12_BAGTYPES}.1",
59 "PKCS12_BAGTYPES_PKCS8SHROUDEDKEYBAG" => "${OID_PKCS12_BAGTYPES}.2",
60 "PKCS12_BAGTYPES_CERTBAG" => "${OID_PKCS12_BAGTYPES}.3",
61 "PKCS12_BAGTYPES_CRLBAG" => "${OID_PKCS12_BAGTYPES}.4",
62 "PKCS12_BAGTYPES_SECRETBAG" => "${OID_PKCS12_BAGTYPES}.5",
63 "PKCS12_BAGTYPES_SAFECONTENTSBAG" => "${OID_PKCS12_BAGTYPES}.6",
65 "PKCS12_PBEIDS_SHAAND128BITRC4" => "${OID_PKCS12_PBEIDS}.1",
66 "PKCS12_PBEIDS_SHAAND40BITRC4" => "${OID_PKCS12_PBEIDS}.2",
67 "PKCS12_PBEIDS_SHAAND3KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.3",
68 "PKCS12_PBEIDS_SHAAND2KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.4",
69 "PKCS12_PBEIDS_SHAAND128BITRC2CBC" => "${OID_PKCS12_PBEIDS}.5",
70 "PKCS12_PBEIDS_SHAAND40BITRC2CBC" => "${OID_PKCS12_PBEIDS}.6",
72 # Symbian dev cert extensions
73 "SYMBIAN_DEVICE_ID_LIST" => "1.2.826.0.1.1796587.1.1.1.1",
74 "SYMBIAN_SID_LIST" => "1.2.826.0.1.1796587.1.1.1.4",
75 "SYMBIAN_VID_LIST" => "1.2.826.0.1.1796587.1.1.1.5",
76 "SYMBIAN_CAPABILITIES" => "1.2.826.0.1.1796587.1.1.1.6"
80 my $DER_BOOLEAN_TAG="01";
81 my $DER_INTEGER_TAG="02";
82 my $DER_BITSTRING_TAG="03";
83 my $DER_OCTETSTRING_TAG="04";
84 my $DER_NULL_TAG="05";
86 my $DER_ENUMERATED_TAG="0A";
87 my $DER_SEQUENCE_TAG="10";
89 my $DER_UTF8STRING_TAG="0C";
90 my $DER_PRINTABLESTRING_TAG="13";
91 my $DER_IA5STRING_TAG="16";
92 my $DER_UTCTIME_TAG="17";
93 my $DER_BMPSTRING_TAG="1E";
95 my $UNIVERSAL_CLASS="UNIVERSAL";
96 my $APPLICATION_CLASS="APPLICATION";
97 my $CONTEXT_SPECIFIC_CLASS="CONTEXT-SPECIFIC";
98 my $PRIVATE_CLASS="PRIVATE";
102 "BOOL" => \&parseBoolean,
103 "BOOLEAN" => \&parseBoolean,
104 "BIGINTEGER" => \&parseBigInteger,
105 "BITSTRING" => \&parseBitString,
106 "BITSTRING_WRAPPER" => \&parseBitStringWrapper,
107 "BMPSTRING" => \&parseBmpString,
108 "BMPSTRING_FILE" => \&parseBmpStringFile,
109 "ENUMERATED" => \&parseEnumerated,
110 "IA5STRING" => \&parseIA5String,
111 "IA5STRING_FILE" => \&parseIA5StringFile,
112 "INCLUDE" => \&parseInclude,
113 "INCLUDE_BINARY_FILE" => \&parseIncludeBinaryFile,
114 "INTEGER" => \&parseInteger,
115 "INT" => \&parseInteger,
116 "IMPLICIT" => \&parseImplicit,
117 "ENCRYPT" => \&parseEncrypt,
118 "EXPLICIT" => \&parseExplicit,
119 "HASH" => \&parseHash,
120 "HMAC" => \&parseHmac,
121 "NULL" => \&parseNull,
122 "OCTETSTRING" => \&parseOctetString,
123 "OUTPUT_BINARY_FILE" => \&parseOutputFile,
125 "PRINTABLESTRING" => \&parsePrintableString,
126 "PRINTABLESTRING_FILE" => \&parsePrintableStringFile,
128 "SEQUENCE" => \&parseSequence,
129 "SEQ" => \&parseSequence,
131 "SHELL" => \&parseShell,
132 "SIGN" => \&parseSign,
133 "UTCTIME" => \&parseUtcTime,
134 "UTF8STRING" => \&parseUtf8String,
135 "UTF8STRING_FILE" => \&parseUtf8StringFile,
149 GetOptions('debug=i' => \$DEBUG,
158 if (! defined $out) {
163 @lines = readFile($in);
166 die "No input file specified.\n";
170 open OUT, ">$out" || die "Cannot open output file $out";
177 my $asnHex = parseScript(\@lines, \$oc);
178 $asnHex = tidyHex($asnHex);
180 if ((!defined $hex) && (defined $out)) {
182 print OUT toBin($asnHex);
184 elsif (defined $out) {
197 $input =~ s/(^:|:$)//g;
204 $asnHex =~ s/[\s:]//g;
205 $asnHex = uc($asnHex);
207 my $len = length($asnHex);
209 die "toBin: hex string contains an odd number ($len) of octets.\n$asnHex\n";
213 $binary .= pack("H${len}", $asnHex);
214 # for (my $i = 0; $i < length($asnHex); $i+=2) {
215 # $binary .= pack('C', substr($asnHex, $i, 2));
220 sub parseScript($$;$) {
221 my ($lines, $oc, $params) = @_;
225 substVars($lines, $params);
227 while (my $line = shift @$lines) {
230 # Remove leading spaces
234 next if ($line =~ /^\/\//);
237 print "${TABS}:PARSE parseScript: $line\n";
242 if ($line =~ /(\w+)\s*\{/ ) {
243 # parse block commands e.g. large integer
247 while (defined $line && !($line =~ /(^|[^\\]+)\}/) ) {
249 $line = shift(@$lines);
252 # append everything up to the closing curly bracket
253 $line =~ s/(^|[^\\])\}.*/$1/g;
257 elsif ($line =~ /(\w+)\s*=*(.*)/) {
258 # parse commands of the form key = value
260 $argString = defined $2 ? $2 : "";
264 if ($cmd =~ /^END/) {
267 print "${TABS}:PARSE END\n";
271 elsif (! defined $PARSE{$cmd}) {
272 die "parseScript: Unknown command: $cmd\n";
276 print "${TABS}:PARSE CMD=$cmd";
277 if ($argString ne "") {print " ARG: $argString";}
281 # Substitue variables in argString
282 $derHex .= ":" . &{$PARSE{$cmd}}($argString, $oc, $lines);
292 my ($lines, $params) = @_;
294 if (! defined $params) {
298 for (my $i = 0; $i < scalar(@$lines); $i++) {
299 my $line = @$lines[$i];
302 # For each parameter search for the a use of $N where
303 # N is the index of the parameter and replace $N with the
304 # value of the parameter
306 $line =~ s/\$${paramIndex}(\D|$)/$_$1/g;
310 # Remove any unused parameters
321 print "readFile, $fileName\n";
324 open($inFile, $fileName) || die "readFile: cannot open $fileName\n";
325 my @lines = <$inFile>;
331 sub parseBitString($$;$) {
332 my ($argString, $oc, $lines) = @_;
333 return encodeBitString($argString, $oc);
336 sub parseBitStringWrapper($$;$) {
337 my ($argString, $oc, $lines) = @_;
340 my $contents = parseScript($lines, \$contents_oc);
342 my $binary = toBin($contents);
343 my $bitCount = $contents_oc * 8;
344 my $bitStr = unpack("B${bitCount}", $binary);
346 # remove trailing zeros - breaks signatures so disable for the moment
347 # $bitStr =~ s/0*$//g;
349 return encodeBitString($bitStr, $oc);
352 sub parseBmpString($$;$) {
353 my ($argString, $oc, $lines) = @_;
355 my $bmpString_oc = 0;
356 my $bmpString = asciiToBmpString($argString, \$bmpString_oc);
357 return encodeBmpString($bmpString, $bmpString_oc, $oc);
360 sub parseBmpStringFile($$;$) {
361 my ($binFName, $oc, $lines) = @_;
362 $binFName =~ s/\s*//g;
364 my $bmpString_oc = 0;
365 my $bmpString = encodeBinaryFile($binFName, \$bmpString_oc);
367 return encodeBmpString($bmpString, $bmpString_oc, $oc);
370 sub parseBoolean($$;$) {
371 my ($argString, $oc, $lines) = @_;
373 $argString =~ s/\s//g;
374 $argString = lc($argString);
377 if ($argString eq "t" || $argString eq "true" || $argString eq "1") {
380 elsif ($argString eq "f" || $argString eq "false" || $argString eq "0") {
384 die "parseBoolean: Invalid boolean value \'$argString\'";
387 return encodeBoolean($bool, $oc);
390 sub parseHash($$;$) {
391 my ($argString, $oc, $lines) = @_;
392 my ($algorithm) = getArgs($argString);
394 if (! defined $algorithm) {
395 die "parseHash: missing algortithm";
399 my $hashIn = parseScript($lines, \$hashIn_oc);
401 my $hashInFName = '_hashin.tmp';
402 my $hashOutFName = '_hashout.tmp';
404 # Create binary hash file
406 open($hashInFh, ">$hashInFName") or die "Cannot create $hashInFName";
408 print $hashInFh toBin($hashIn);
411 my @command = ("cmd",
412 "/C \"openssl dgst -${algorithm} -binary $hashInFName > $hashOutFName\"");
414 print "${TABS}:parseHash:" . join(" ", @command) . "\n";
417 if ((my $err = system(@command)) != 0) {
418 die "parseHash: " . join(" ", @command) . "\nreturned error $err";
421 my $derHex = parseIncludeBinaryFile($hashOutFName, $oc);
424 unlink($hashInFName);
425 unlink($hashOutFName);
430 sub parseHmac($$;$) {
431 my ($argString, $oc, $lines) = @_;
432 my ($algorithm, $key) = getArgs($argString);
434 if (! defined $algorithm) {
435 die "parseHmac: missing algortithm";
437 $algorithm = uc($algorithm);
438 if (! $algorithm =~ /MD5|SHA1/) {
439 die "parseHmac: invalid algorithm $algorithm";
442 if (! defined $key) {
443 die "parseHmac: missing key";
447 my $hmacIn = toBin(parseScript($lines, \$hmacIn_oc));
449 my $binKey = toBin($key);
451 if ($algorithm eq "SHA1") {
453 $hmac = Digest::HMAC_SHA1->new($binKey);
456 $hmac = Digest::HMAC_MD5->new($binKey);
459 my $digest = $hmac->digest;
460 $$oc += length($digest);
462 return toHex($digest);
465 sub parseIA5String($$;$) {
466 my ($argString, $oc, $lines) = @_;
468 my $ia5String_oc = 0;
469 my $ia5String = asciiToIA5String($argString, \$ia5String_oc);
470 return encodeIA5String($ia5String, $ia5String_oc, $oc);
474 sub parseIA5StringFile($$;$) {
475 my ($binFName, $oc, $lines) = @_;
476 $binFName =~ s/\s*//g;
478 my $ia5String_oc = 0;
479 my $ia5String = encodeBinaryFile($binFName, \$ia5String_oc);
481 return encodeIA5String($ia5String, $ia5String_oc, $oc);
484 sub parseIncludeBinaryFile($$;$) {
485 my ($binFName, $oc, $lines) = @_;
486 $binFName =~ s/\s*//g;
488 return encodeBinaryFile($binFName, $oc);
491 sub parseInclude($$$) {
492 my ($argString, $oc, $lines) = @_;
493 my @args = getArgs($argString);
495 my $fileName = shift(@args);
496 if (! (defined $fileName && $fileName ne "")) {
497 die "parseInclude: Filename not specified\n";
501 my @lines = readFile($fileName);
502 $derHex = parseScript(\@lines, $oc, \@args);
506 sub parseInteger($$;$) {
507 my ($argString, $oc, $lines) = @_;
509 $argString =~ s/\s//g;
510 return encodeInteger($argString, $oc);
513 sub parseBigInteger($$;$) {
514 my ($argString, $oc, $lines) = @_;
516 $argString =~ s/\s//g;
517 return encodeBigInteger($argString, $oc);
520 sub parseEncrypt($$;$) {
521 my ($argString, $oc, $lines) = @_;
522 my ($cipher, $key, $iv) = getArgs($argString);
524 if (! defined $cipher) {
525 die "parseEncrypt: missing cipher\n";
528 if (! defined $key) {
529 die "parseEncrypt: missing key\n";
532 my $plainText_oc = 0;
533 my $plainText = parseScript($lines, \$plainText_oc);
535 my $plainTextFName = '_plaintext.tmp';
536 my $cipherTextFName = '_ciphertext.tmp';
538 # Create binary plaintext file
540 open($plainTextFh, ">$plainTextFName") or die "Cannot create $plainTextFName";
541 binmode($plainTextFh);
542 print $plainTextFh toBin($plainText);
545 my @command = ('openssl',
550 '-in', $plainTextFName,
551 '-out', $cipherTextFName);
554 push @command, '-iv', $iv;
558 print "${TABS}:parseEncrypt:" . join(" ", @command) . "\n";
561 if ((my $err = system(@command)) != 0) {
562 die "parseEncrypt: " . join(" ", @command) . "\nreturned error $err";
565 my $derHex = parseIncludeBinaryFile($cipherTextFName, $oc);
568 unlink($plainTextFName);
569 unlink($cipherTextFName);
574 sub parseEnumerated($$;$) {
575 my ($argString, $oc, $lines) = @_;
577 $argString =~ s/\s//g;
578 return encodeEnumerated($argString, $oc);
581 sub parseExplicit($$;$) {
582 my ($argString, $oc, $lines) = @_;
583 my ($tagNumber, $class) = getArgs($argString);
585 if (! defined $tagNumber || $tagNumber =~ /^\s*$/) {
588 elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) {
589 die "parseExplicit: invalid tag number: \'$tagNumber\'";
591 $tagNumber = hex($tagNumber);
593 if (!defined $class || $class =~ /^\s*$/) {
594 $class = $CONTEXT_SPECIFIC_CLASS;
601 if (! isValidClass($class)) {
602 die "parseExplicit: invalid class \'$class\'";
606 my $nested = parseScript($lines, \$nested_oc);
608 return encodeExplicit($class, $tagNumber, $nested, $nested_oc, $oc);
611 sub parseImplicit($$;$) {
612 my ($argString, $oc, $lines) = @_;
613 my ($tagNumber, $class) = getArgs($argString);
615 if (! defined $tagNumber || $tagNumber =~ /^\s*$/) {
618 elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) {
619 die "parseImplicit: invalid tag number: \'$tagNumber\'";
621 $tagNumber = hex($tagNumber);
623 if (!defined $class || $class =~ /^\s*$/) {
624 $class = $CONTEXT_SPECIFIC_CLASS;
631 if (! isValidClass($class)) {
632 die "parseImplicit: invalid class \'$class\'";
636 my $nested = tidyHex(parseScript($lines, \$nested_oc));
638 # De-construct the nested data to allow the underlying type tag to be
639 # changed. The output of parseScript had better be valid DER or this
640 # will go horribly wrong !
642 my $uConstructed = 0;
646 getTlv($nested, \$uClass, \$uConstructed, \$uTag, \$uLength, \$uValue);
649 print "${TABS}parseImplicit: underlyingType \'$uTag\'\n";
652 # This only works for low tag numbers because we are assuming that the type
653 # tag is a single octet
654 return encodeImplicit($class, $uConstructed, $tagNumber, $uValue, $uLength, $oc);
657 sub parseNull($$;$) {
658 my ($argString, $oc, $lines) = @_;
660 return encodeNull($oc);
663 sub parseOctetString($$;$) {
664 my ($argString, $oc, $lines) = @_;
666 my $octetString_oc = 0;
667 my $octetString = parseScript($lines, \$octetString_oc);
669 return encodeOctetString($octetString, $octetString_oc, $oc);
673 my ($argString, $oc, $lines) = @_;
674 $argString =~ s/\s//g;
675 $argString = uc($argString);
677 if (! defined $argString) {
678 die "parseOid: Missing OID value.";
681 foreach (keys %OIDS) {
682 if ($argString =~ /$_/) {
683 $argString =~ s/\Q$_\E/$OIDS{$_}/g;
686 return encodeOid($argString, $oc);
689 sub parseOutputFile($$;$) {
690 my ($argString, $oc, $lines) = @_;
691 my ($outputFile,$echo) = split(/,/, $argString);
693 if (! defined $outputFile) {
694 die "parseOutputFile: Missing file-name.\n";
698 my $content = parseScript($lines, \$content_oc);
701 if (! open($outFh, ">${outputFile}")) {
702 die "parseOutputFile: Cannot create $outputFile\n";
705 print $outFh toBin($content);
708 # If echo is specified then include then contents of the output
709 # file at this point in the stream.
710 if (defined $echo && $echo =~ /(1|t|true)/i) {
719 sub parsePrintableString($$;$) {
720 my ($argString, $oc, $lines) = @_;
722 my $printableString_oc = 0;
723 my $printableString = asciiToPrintableString($argString, \$printableString_oc);
724 return encodePrintableString($printableString, $printableString_oc, $oc);
727 sub parsePrintableStringFile($$;$) {
728 my ($binFName, $oc, $lines) = @_;
729 $binFName =~ s/\s*//g;
731 my $printableString_oc = 0;
732 my $printableString = encodeBinaryFile($binFName, \$printableString_oc);
734 return encodePrintableString($printableString, $printableString_oc, $oc);
738 my ($argString, $oc, $lines) = @_;
739 $argString =~ s/\s//g;
740 $argString = uc($argString);
743 if (! ($argString =~ /(([A-Fa-f\d][A-Fa-f\d])[ :]*)+/)) {
744 die "parseRaw: Invalid hex string: $argString\n";
746 my $binary = toBin($argString);
747 $$oc += length($binary);
748 return tidyHex(toHex($binary));
751 sub parseSequence($$;$) {
752 my ($argString, $oc, $lines) = @_;
755 my $sequence = parseScript($lines, \$sequence_oc);
757 return encodeSequence($sequence, $sequence_oc, $oc);
761 my ($argString, $oc, $lines) = @_;
764 my $set = parseScript($lines, \$set_oc);
766 return encodeSet($set, $set_oc, $oc);
769 # Create a PKCS#7 signed data object for a chunk of data using
770 # OpenSSL's SMIME command
771 sub parseSign($$;$) {
772 my ($argString, $oc, $lines) = @_;
773 my ($signerCert, $signerKey) = getArgs($argString);
775 if (! defined $signerCert) {
776 die "parseSign: missing signing certificate";
778 elsif (! -f $signerCert) {
779 die "parseSign: signing certificate \'$signerCert\' does not exist.";
782 if (! defined $signerKey) {
783 die "parseSign: missing signing certificate";
785 elsif (! -f $signerKey) {
786 die "parseSign: signing key \'$signerKey\' does not exist.";
790 my $unsigned = parseScript($lines, \$unsigned_oc);
792 my $unsignedFName = '_unsigned.tmp';
793 my $signedFName = '_signed.tmp';
795 # Create binary unsigned data file
797 open($unsignedFh, ">$unsignedFName") or die "Cannot create $unsignedFName";
798 binmode($unsignedFh);
799 print $unsignedFh toBin($unsigned);
802 my @command = ('openssl',
813 '-in', $unsignedFName,
814 '-out', $signedFName);
817 print "${TABS}:parseSign:" . join(" ", @command) . "\n";
820 if ((my $err = system(@command)) != 0) {
821 die "parseSign: " . join(" ", @command) . "\nreturned error $err";
824 my $derHex = parseIncludeBinaryFile($signedFName, $oc);
827 unlink($unsignedFName);
828 unlink($signedFName);
833 sub parseShell($$;$) {
834 my ($argString, $oc, $lines) = @_;
835 my @command = getArgs($argString);
837 if (scalar(@command) < 1) {
838 die "parseShell: no arguments";
842 print "${TABS}:parseShell:" . join(" ", @command) . "\n";
845 if ((my $err = system(@command)) != 0) {
846 die "parseShell: " . join(" ", @command) . "\nreturned error $err";
851 sub parseUtcTime($$;$) {
852 my ($time, $oc, $lines) = @_;
855 my $time_oc = length($time);
856 return encodeUtcTime(toHex($time), $time_oc, $oc);
859 sub parseUtf8String($$;$) {
860 my ($argString, $oc, $lines) = @_;
862 my $utf8String_oc = 0;
863 my $utf8String = asciiToUtf8String($argString, \$utf8String_oc);
864 return encodeUtf8String($utf8String, $utf8String_oc, $oc);
867 sub parseUtf8StringFile($$;$) {
868 my ($binFName, $oc, $lines) = @_;
869 $binFName =~ s/\s*//g;
871 my $utf8String_oc = 0;
872 my $utf8String = encodeBinaryFile($binFName, \$utf8String_oc);
874 return encodeUtf8String($utf8String, $utf8String_oc, $oc);
879 my $hex = unpack("H" . (length($bin) * 2), $bin);
880 $hex =~ s/(..)/$1:/g;
884 sub encodeBinaryFile($$) {
885 my ($binFName, $oc) = @_;
888 open($binFH, "$binFName") || die "encodeBinaryFile: Cannot open $binFName\n";
894 while (my $len = sysread($binFH, $readBuf, 1024)) {
900 return toHex($binBuf);;
903 # Creates a hex representation of the DER encoding of an arbitrary length bit string
904 sub encodeBitString($$) {
905 my ($text, $oc) = @_;
907 # Bit string in hex including padding length octet
909 my $bit_str_oc = 1; # one octet for padding
913 my $len = length($text);
923 # Read the ith character and insert it in the correct place in the byte
924 # (fill from the left)
925 my $c = substr($text, $i, 1);
927 $byte |= (1 << (7 - ($i % 8)));
930 die "Invalid character $c in bit string $text";
934 # Received 8 bits so output byte in hex
935 if ($bit_str ne "") {
938 $bit_str .= sprintf("%2.2x", $byte);
943 # Pad any remaining bits / make sure 0 is output for empty string
944 if ($byte != 0 || $bit_str_oc == 1) {
945 if ($bit_str ne "") {
948 $bit_str .= sprintf("%2.2x", $byte);
952 my $pad_length = "00";
954 # If this isn't a multiple of 8 bits then calculated
955 # the number of padding bits added.
956 $pad_length = sprintf("%2.2x", 8 - ($len % 8));
960 print "${TABS}:ENC:encodeBitString, $bit_str_oc\n";
962 return encodeTlv($oc, $DER_BITSTRING_TAG, $bit_str_oc, "$pad_length:$bit_str");
965 # Creates a hex represenation of the DER encoding of a BMPSTRING
966 sub encodeBmpString($$$) {
967 my ($bmpString, $bmpString_oc, $oc) = @_;
970 print "${TABS}:ENC:encodeBmpString, $bmpString_oc\n";
972 return encodeTlv($oc, $DER_BMPSTRING_TAG, $bmpString_oc, $bmpString);
975 sub encodeBoolean($$) {
976 my ($value, $oc) = @_;
984 print "${TABS}:ENC:encodeBoolean, 1\n";
986 return encodeTlv($oc, $DER_BOOLEAN_TAG, 1, $boolean);
989 sub encodeEnumerated($$) {
994 if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) {
995 die "encodeEnumerated: Invalid argument: $int\n";
998 if ($int =~ s/^0x//) {
1002 # Convert the enumerated to base 256 hex and find out how
1003 # many octets were required
1004 my $hex_enumerated_oc = 0;
1005 my $hex_enumerated = "";
1008 $hex_enumerated = encodeBase256($int, \$hex_enumerated_oc);
1012 print "${TABS}:ENC: , $hex_enumerated_oc\n";
1015 return encodeTlv($oc, $DER_ENUMERATED_TAG, $hex_enumerated_oc, $hex_enumerated);
1018 # explicit tags are always constructed
1019 sub encodeExplicit($$$$) {
1020 my ($class, $tagNumber, $explicit, $explicit_oc, $oc) = @_;
1023 print "${TABS}:ENC: explicit, $explicit_oc\n";
1025 return encodeTlv($oc, $tagNumber, $explicit_oc, $explicit, 1, $class);
1028 # Creates a hex represenation of the DER encoding of an IA5 string
1029 sub encodeIA5String($$) {
1030 my ($ia5String, $ia5String_oc, $oc) = @_;
1033 print "${TABS}:ENC:encodeIA5String, $ia5String_oc\n";
1035 return encodeTlv($oc, $DER_IA5STRING_TAG, $ia5String_oc, $ia5String);
1038 sub encodeImplicit($$$$$) {
1039 my ($class, $constructed, $tagNumber, $implicit, $implicit_oc, $oc) = @_;
1042 print "${TABS}:ENC: implicit, $implicit_oc\n";
1044 return encodeTlv($oc, $tagNumber, $implicit_oc, $implicit, $constructed, $class);
1047 sub encodeBigInteger($$) {
1048 my ($hexString, $oc) = @_;
1050 my $bin = toBin($hexString);
1051 my $int = toHex($bin);
1052 my $int_oc = length($bin);
1055 print "${TABS}:ENC: bigInteger, $int_oc\n";
1057 return encodeTlv($oc, $DER_INTEGER_TAG, $int_oc, $int)
1060 sub encodeInteger($$) {
1061 my ($int, $oc) = @_;
1065 if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) {
1066 die "encodeInteger: Invalid argument: $int\n";
1069 if ($int =~ s/^0x//) {
1073 # Convert the integer to base 256 hex and find out how
1074 # many octets were required
1075 my $hex_integer_oc = 0;
1076 my $hex_integer = "";
1079 $hex_integer = encodeBase256($int, \$hex_integer_oc);
1083 print "${TABS}:ENC: integer, $hex_integer_oc\n";
1086 return encodeTlv($oc, $DER_INTEGER_TAG, $hex_integer_oc, $hex_integer);
1091 return encodeTlv($oc, $DER_NULL_TAG, 0, "");
1094 sub encodeOctetString($$$) {
1095 my ($octetString, $octetString_oc, $oc) = @_;
1098 print "${TABS}:ENC: octetString, $octetString_oc\n";
1100 return encodeTlv($oc, $DER_OCTETSTRING_TAG, $octetString_oc, $octetString);
1104 my ($text, $oc) = @_;
1106 my @fields = split /\./, $text;
1108 if (! ($fields[0] >= 0 && $fields[0] <=2) ) {
1109 die "Invalid OID: $text\n";
1111 if (! ($fields[1] >= 0 && $fields[1] <= 39) ) {
1112 die "Invalid OID: $text";
1115 my $oid = sprintf("%2.2x", (40 * $fields[0]) + $fields[1]);
1121 $oid .= ":" . encodeBase128($_, \$oid_oc);
1125 print "${TABS}:ENC:encodeOid, $oid_oc\n";
1127 return encodeTlv($oc, $DER_OID_TAG, $oid_oc, $oid);
1130 # Creates a hex represenation of the DER encoding of a PRINTABLE string
1131 sub encodePrintableString($$$) {
1132 my ($printableString, $printableString_oc, $oc) = @_;
1135 print "${TABS}:ENC:encodePrintableString, $printableString_oc\n";
1137 return encodeTlv($oc, $DER_PRINTABLESTRING_TAG, $printableString_oc, $printableString);
1140 sub encodeSet($$$) {
1141 my ($set, $set_oc, $oc) = @_;
1144 print "${TABS}:ENC: set, $set_oc\n";
1146 return encodeTlv($oc, $DER_SET_TAG, $set_oc, $set, 1);
1149 sub encodeSequence($$$) {
1150 my ($sequence, $sequence_oc, $oc) = @_;
1153 print "${TABS}:ENC: sequence, $sequence_oc\n";
1155 return encodeTlv($oc, $DER_SEQUENCE_TAG, $sequence_oc, $sequence, 1);
1158 sub encodeUtcTime($$$) {
1159 my ($utcTime, $utcTime_oc, $oc) = @_;
1162 print "${TABS}:ENC: UTCTime, $utcTime_oc\n";
1164 return encodeTlv($oc, $DER_UTCTIME_TAG, $utcTime_oc, $utcTime);
1167 # Creates a hex represenation of the DER encoding of a UTF-8 string.
1168 sub encodeUtf8String($$) {
1169 my ($utf8String, $utf8String_oc, $oc) = @_;
1172 print "${TABS}:ENC:encodeUTF8String, $utf8String_oc\n";
1174 return encodeTlv($oc, $DER_UTF8STRING_TAG, $utf8String_oc, $utf8String);
1177 sub asciiToBmpString($$) {
1178 my ($input, $oc) = @_;
1181 my $input_len = length($input);
1182 $$oc += $input_len * 2;
1184 for (my $i = 0; $i < $input_len; ++$i) {
1185 my $hex_val = ord(substr($input, $i, 1));
1186 if ($bmpString ne "") {
1189 $bmpString .= sprintf(":00:%2.2x", $hex_val);
1194 sub asciiToIA5String($$) {
1195 my ($input, $oc) = @_;
1197 my $printableString = "";
1198 my $input_len = length($input);
1201 for (my $i = 0; $i < $input_len; ++$i) {
1202 my $hex_val = ord(substr($input, $i, 1));
1203 if ($printableString ne "") {
1204 $printableString .= ":";
1206 $printableString .= sprintf(":%2.2x", $hex_val);
1208 return $printableString;
1211 sub asciiToPrintableString($$) {
1212 my ($input, $oc) = @_;
1215 my $input_len = length($input);
1218 for (my $i = 0; $i < $input_len; ++$i) {
1219 my $hex_val = ord(substr($input, $i, 1));
1220 if ($ia5String ne "") {
1223 $ia5String .= sprintf(":%2.2x", $hex_val);
1228 sub asciiToUtf8String($$) {
1229 my ($input, $oc) = @_;
1231 my $utf8String = "";
1232 my $input_len = length($input);
1235 for (my $i = 0; $i < $input_len; ++$i) {
1236 my $hex_val = ord(substr($input, $i, 1));
1237 if ($utf8String ne "") {
1240 $utf8String .= sprintf(":%2.2x", $hex_val);
1245 sub encodeBase128($$$) {
1246 my ($num, $oc) = @_;
1250 my $base128_length = 0;
1255 if ($base128 eq "") {
1256 $hexoctet = sprintf("%2.2x", $num & 0x7f);
1259 $hexoctet = sprintf("%2.2x", ($num & 0x7f) | 0x80);
1262 if ($base128 eq "") {
1263 $base128 = $hexoctet;
1266 $base128 = "$hexoctet:$base128";
1272 if ($base128 eq "") {
1277 $$oc += $base128_length;
1280 print "${TABS}:ENC: base128, $base128_length, $$oc\n";
1286 # Return a hex represenation of the length using DER primitive (definate length encoding)
1287 sub encodeLength($$) {
1288 my ($num, $oc) = @_;
1291 # Number is < 128 so encode in short form
1293 return sprintf("%2.2x", $num);
1296 # Number >= 128 so encode in long form
1298 my $base256 = &encodeBase256($num, \$length_oc, 1);
1299 if ($length_oc > 127) {die "Encoding overflow.";}
1301 $$oc += 1 + $length_oc;
1303 # Set the top bit of the length octet to indicate long form
1304 return "" . sprintf("%2.2x", ($length_oc | 0x80)) . ":$base256";
1308 # Convert an integer into an ascii hex representation in base 256
1309 # $num - the number to encode
1310 # $octets - refernce to the octet count to increment
1311 # $unsigned - assume unsigned
1312 sub encodeBase256($$) {
1313 my ($numIn, $oc, $unsigned) = @_;
1316 my $num = int($numIn);
1319 my $hexoctet = sprintf("%2.2x", $num & 0xFF);
1320 if ($base256 ne "") {
1321 $base256 = "$hexoctet:$base256";
1324 $base256 = $hexoctet;
1329 if ($base256 eq "") {
1334 # If the integer is +ve and the MSB is 1 then padd with a leading zero
1335 # octet otherwise it will look -ve
1336 if ((! $unsigned) && $numIn > 0 && $base256 =~ /^:*[8ABCDEF]/i) {
1337 $base256 = "00:$base256";
1341 # If the first octet is all ones and the msb of the next bit
1342 # is also one then drop the first octet because negative
1343 # numbers should not be padded
1344 while ($base256 =~ s/^(FF:)([8ABCDEF][0-9A-F].*)/$2/i) {
1352 # Only low tag form is supported at the moment
1353 sub encodeType($$;$$) {
1354 my ($oc, $tagNumber, $constructed, $class) = @_;
1356 $tagNumber = hex($tagNumber);
1358 if ($tagNumber < 0 || $tagNumber > 30) {
1359 die "encodeType: Currently, only low tag numbers (0 - 30) are supported.";
1362 if (! defined $class) {
1363 $class = "UNIVERSAL";
1366 $class = uc($class);
1367 if (! isValidClass($class)) {
1368 die "encodeType: invalid class \'$class\'";
1371 # If the type is constructed then set bit 6
1372 if (defined $constructed && $constructed == 1) {
1376 if ($class eq $UNIVERSAL_CLASS) {
1377 # do nothing, bits 7 and 8 are zero
1379 elsif ($class eq $APPLICATION_CLASS) {
1383 elsif ($class eq $CONTEXT_SPECIFIC_CLASS) {
1387 elsif ($class eq $PRIVATE_CLASS) {
1392 return sprintf("%2.2x", $tagNumber);
1395 sub encodeTlv($$$$;$$) {
1396 my ($oc, $tag, $length, $value, $constructed, $class) = @_;
1399 print "${TABS}encodeTlv\n";
1400 print "${TABS}oc=$$oc\n";
1401 print "${TABS}tag=$tag\n";
1402 print "${TABS}length=$length\n";
1403 print "${TABS}value=$value\n";
1404 if (defined $constructed) {
1405 print "${TABS}constructed=$constructed\n";
1407 if (defined $class) {
1408 print "${TABS}class=$class\n";
1413 $hex = encodeType($oc, $tag, $constructed, $class);
1414 $hex .= ":" . encodeLength($length, $oc);
1416 $hex .= ":" . $value;
1419 print "${TABS}oc=$$oc\n";
1420 print "${TABS}encoding=$hex\n";
1421 print "${TABS}end\n";
1428 # increment debug tabbing level
1433 # decrement debug tabbing level
1438 sub isValidClass($) {
1441 if (defined $class &&
1442 $class =~ /^(UNIVERSAL|APPLICATION|CONTEXT-SPECIFIC|PRIVATE)$/) {
1449 sub getTlv($$$$$$) {
1450 my ($input, $class, $constructed, $tag, $length, $value) = @_;
1452 my @hexOctets = split(/:+/,tidyHex($input));
1454 if (scalar(@hexOctets) < 2) {
1455 die "getTlv: too short";
1458 my $type = hex(shift @hexOctets);
1459 if (($type & 0xC0) == 0x00) {
1460 # universal: bit 8 = 0, bit 7 = 0
1461 $$class = $UNIVERSAL_CLASS;
1463 elsif (($type & 0xC0) == 0x40) {
1464 # application: bit 8 = 0, bit 7 = 1
1465 $$class = $APPLICATION_CLASS;
1467 elsif (($type & 0xC0) == 0x80) {
1468 # application: bit 8 = 1, bit 7 = 0
1469 $$class = $CONTEXT_SPECIFIC_CLASS;
1471 elsif (($type & 0xC0) == 0xC0) {
1472 # application: bit 8 = 1, bit 7 = 1
1473 $$class = $PRIVATE_CLASS;
1476 die "getTlv: assert";
1480 # constructed if bit 6 = 1
1487 # We assumme the tag number is in low form
1488 # and just look at the bottom 5 hits
1489 $$tag = $type & 0x1F;
1491 $$length = hex(shift @hexOctets);
1492 if ($$length & 0x80) {
1494 my $length_oc = $$length & 0x7F;
1496 for (my $i = 0; $i < $length_oc; $i++) {
1497 # length is encoded base 256
1499 $$length += hex(shift @hexOctets);
1504 # don't do anything here, length is just bits 7 - 1 and
1505 # we already know bit 8 is zero.
1509 foreach (@hexOctets) {
1514 print "${TABS} class=$$class\n";
1515 print "${TABS} constructed=$$constructed\n";
1516 print "${TABS} tag=$$tag\n";
1517 print "${TABS} length=$$length\n";
1521 # parse an escaped (\) comma seperated argument string
1524 my ($argString) = @_;
1527 while ($argString =~ /(^|.*?[^\\]),(.*)/ ) {
1533 $match =~ s/(\\)([^\\])/$2/g;
1537 if ($argString ne "") {
1538 push @args, $argString;