|
1 # |
|
2 # Copyright (c) 2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
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". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # |
|
16 #!/bin/perl -w |
|
17 |
|
18 # Copyright (c) 2005-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
19 # All rights reserved. |
|
20 # This component and the accompanying materials are made available |
|
21 # under the terms of the License "Symbian Foundation License v1.0" |
|
22 # which accompanies this distribution, and is available |
|
23 # at the URL "http://www.symbianfoundation.org/legal/sfl-v10.html". |
|
24 # |
|
25 # Initial Contributors: |
|
26 # Nokia Corporation - initial contribution. |
|
27 # |
|
28 # Contributors: |
|
29 # |
|
30 # Description: |
|
31 # Basic ASN.1 encoding library |
|
32 # Some parts of this program requrie OpenSSL which may be freely downloaded |
|
33 # from www.openssl.org |
|
34 # |
|
35 # |
|
36 |
|
37 use strict; |
|
38 use Digest::HMAC_MD5; |
|
39 use Digest::HMAC_SHA1; |
|
40 use Getopt::Long; |
|
41 |
|
42 # 0 = off |
|
43 # 1 = log parsing |
|
44 # 2 = log parsing + encoding |
|
45 # 3 = really verbose stuff |
|
46 my $DEBUG=0; |
|
47 |
|
48 # Turn on validation checks that attempt to only generate |
|
49 # valid DER encodings. |
|
50 my $VALIDATE=0; |
|
51 |
|
52 my $OID_PKCS = "1.2.840.113549.1"; |
|
53 my $OID_PKCS7 ="${OID_PKCS}.7"; |
|
54 my $OID_PKCS9 = "${OID_PKCS}.9"; |
|
55 my $OID_PKCS9_CERTTYPES = "${OID_PKCS9}.22"; |
|
56 my $OID_PKCS12 = "${OID_PKCS}.12"; |
|
57 my $OID_PKCS12_BAGTYPES = "${OID_PKCS12}.10.1"; |
|
58 my $OID_PKCS12_PBEIDS = "${OID_PKCS12}.1"; |
|
59 |
|
60 my %OIDS = |
|
61 ( |
|
62 "MD5" => "1.2.840.113549.2.5", |
|
63 "SHA1" => "1.3.14.3.2.26", |
|
64 "X509CRL" => "1.3.6.1.4.1.3627.4", |
|
65 |
|
66 "PKCS7_DATA" => "${OID_PKCS7}.1", |
|
67 "PKCS7_SIGNEDDATA" => "${OID_PKCS7}.2", |
|
68 "PKCS7_ENVELOPEDDATA" => "${OID_PKCS7}.3", |
|
69 "PKCS7_SIGNEDANDENVELOPEDDATA" => "${OID_PKCS7}.4", |
|
70 "PKCS7_DIGESTEDDATA" => "${OID_PKCS7}.5", |
|
71 "PKCS7_ENCRYPTEDDATA" => "${OID_PKCS7}.6", |
|
72 |
|
73 "PKCS9_CERTTYPES_PKCS12_X509" => "${OID_PKCS9_CERTTYPES}.1", |
|
74 "PKCS9_FRIENDLY_NAME" => "${OID_PKCS9}.20", |
|
75 "PKCS9_LOCAL_KEYID" => "${OID_PKCS9}.21", |
|
76 |
|
77 "PKCS12_BAGTYPES_KEYBAG" => "${OID_PKCS12_BAGTYPES}.1", |
|
78 "PKCS12_BAGTYPES_PKCS8SHROUDEDKEYBAG" => "${OID_PKCS12_BAGTYPES}.2", |
|
79 "PKCS12_BAGTYPES_CERTBAG" => "${OID_PKCS12_BAGTYPES}.3", |
|
80 "PKCS12_BAGTYPES_CRLBAG" => "${OID_PKCS12_BAGTYPES}.4", |
|
81 "PKCS12_BAGTYPES_SECRETBAG" => "${OID_PKCS12_BAGTYPES}.5", |
|
82 "PKCS12_BAGTYPES_SAFECONTENTSBAG" => "${OID_PKCS12_BAGTYPES}.6", |
|
83 |
|
84 "PKCS12_PBEIDS_SHAAND128BITRC4" => "${OID_PKCS12_PBEIDS}.1", |
|
85 "PKCS12_PBEIDS_SHAAND40BITRC4" => "${OID_PKCS12_PBEIDS}.2", |
|
86 "PKCS12_PBEIDS_SHAAND3KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.3", |
|
87 "PKCS12_PBEIDS_SHAAND2KEYTRIPLEDESCBC" => "${OID_PKCS12_PBEIDS}.4", |
|
88 "PKCS12_PBEIDS_SHAAND128BITRC2CBC" => "${OID_PKCS12_PBEIDS}.5", |
|
89 "PKCS12_PBEIDS_SHAAND40BITRC2CBC" => "${OID_PKCS12_PBEIDS}.6", |
|
90 |
|
91 # Symbian dev cert extensions |
|
92 "SYMBIAN_DEVICE_ID_LIST" => "1.2.826.0.1.1796587.1.1.1.1", |
|
93 "SYMBIAN_SID_LIST" => "1.2.826.0.1.1796587.1.1.1.4", |
|
94 "SYMBIAN_VID_LIST" => "1.2.826.0.1.1796587.1.1.1.5", |
|
95 "SYMBIAN_CAPABILITIES" => "1.2.826.0.1.1796587.1.1.1.6" |
|
96 |
|
97 ); |
|
98 |
|
99 my $DER_BOOLEAN_TAG="01"; |
|
100 my $DER_INTEGER_TAG="02"; |
|
101 my $DER_BITSTRING_TAG="03"; |
|
102 my $DER_OCTETSTRING_TAG="04"; |
|
103 my $DER_NULL_TAG="05"; |
|
104 my $DER_OID_TAG="06"; |
|
105 my $DER_ENUMERATED_TAG="0A"; |
|
106 my $DER_SEQUENCE_TAG="10"; |
|
107 my $DER_SET_TAG="11"; |
|
108 my $DER_UTF8STRING_TAG="0C"; |
|
109 my $DER_PRINTABLESTRING_TAG="13"; |
|
110 my $DER_IA5STRING_TAG="16"; |
|
111 my $DER_UTCTIME_TAG="17"; |
|
112 my $DER_BMPSTRING_TAG="1E"; |
|
113 |
|
114 my $UNIVERSAL_CLASS="UNIVERSAL"; |
|
115 my $APPLICATION_CLASS="APPLICATION"; |
|
116 my $CONTEXT_SPECIFIC_CLASS="CONTEXT-SPECIFIC"; |
|
117 my $PRIVATE_CLASS="PRIVATE"; |
|
118 |
|
119 my %PARSE = |
|
120 ( |
|
121 "BOOL" => \&parseBoolean, |
|
122 "BOOLEAN" => \&parseBoolean, |
|
123 "BIGINTEGER" => \&parseBigInteger, |
|
124 "BITSTRING" => \&parseBitString, |
|
125 "BITSTRING_WRAPPER" => \&parseBitStringWrapper, |
|
126 "BMPSTRING" => \&parseBmpString, |
|
127 "BMPSTRING_FILE" => \&parseBmpStringFile, |
|
128 "ENUMERATED" => \&parseEnumerated, |
|
129 "IA5STRING" => \&parseIA5String, |
|
130 "IA5STRING_FILE" => \&parseIA5StringFile, |
|
131 "INCLUDE" => \&parseInclude, |
|
132 "INCLUDE_BINARY_FILE" => \&parseIncludeBinaryFile, |
|
133 "INTEGER" => \&parseInteger, |
|
134 "INT" => \&parseInteger, |
|
135 "IMPLICIT" => \&parseImplicit, |
|
136 "ENCRYPT" => \&parseEncrypt, |
|
137 "EXPLICIT" => \&parseExplicit, |
|
138 "HASH" => \&parseHash, |
|
139 "HMAC" => \&parseHmac, |
|
140 "NULL" => \&parseNull, |
|
141 "OCTETSTRING" => \&parseOctetString, |
|
142 "OUTPUT_BINARY_FILE" => \&parseOutputFile, |
|
143 "OID" => \&parseOid, |
|
144 "PRINTABLESTRING" => \&parsePrintableString, |
|
145 "PRINTABLESTRING_FILE" => \&parsePrintableStringFile, |
|
146 "RAW" => \&parseRaw, |
|
147 "SEQUENCE" => \&parseSequence, |
|
148 "SEQ" => \&parseSequence, |
|
149 "SET" => \&parseSet, |
|
150 "SHELL" => \&parseShell, |
|
151 "SIGN" => \&parseSign, |
|
152 "UTCTIME" => \&parseUtcTime, |
|
153 "UTF8STRING" => \&parseUtf8String, |
|
154 "UTF8STRING_FILE" => \&parseUtf8StringFile, |
|
155 ); |
|
156 |
|
157 my $TABS = ""; |
|
158 |
|
159 &main; |
|
160 exit(0); |
|
161 |
|
162 sub main() { |
|
163 my $hex; |
|
164 my $out; |
|
165 my $in; |
|
166 my @lines; |
|
167 |
|
168 GetOptions('debug=i' => \$DEBUG, |
|
169 'hex' => \$hex, |
|
170 'in=s' => \$in, |
|
171 'out=s' => \$out); |
|
172 |
|
173 if (! defined $in) { |
|
174 $in = $ARGV[0]; |
|
175 } |
|
176 |
|
177 if (! defined $out) { |
|
178 $out = $ARGV[1]; |
|
179 } |
|
180 |
|
181 if (defined $in) { |
|
182 @lines = readFile($in); |
|
183 } |
|
184 else { |
|
185 die "No input file specified.\n"; |
|
186 } |
|
187 |
|
188 if (defined $out) { |
|
189 open OUT, ">$out" || die "Cannot open output file $out"; |
|
190 } |
|
191 else { |
|
192 *OUT = *STDOUT; |
|
193 } |
|
194 |
|
195 my $oc = 0; |
|
196 my $asnHex = parseScript(\@lines, \$oc); |
|
197 $asnHex = tidyHex($asnHex); |
|
198 |
|
199 if ((!defined $hex) && (defined $out)) { |
|
200 binmode(OUT); |
|
201 print OUT toBin($asnHex); |
|
202 } |
|
203 elsif (defined $out) { |
|
204 print OUT $asnHex; |
|
205 } |
|
206 else { |
|
207 print $asnHex; |
|
208 } |
|
209 |
|
210 close OUT; |
|
211 } |
|
212 |
|
213 sub tidyHex($) { |
|
214 my ($input) = @_; |
|
215 $input =~ s/:+/:/g; |
|
216 $input =~ s/(^:|:$)//g; |
|
217 return uc($input); |
|
218 } |
|
219 |
|
220 sub toBin($) { |
|
221 my ($asnHex) = @_; |
|
222 |
|
223 $asnHex =~ s/[\s:]//g; |
|
224 $asnHex = uc($asnHex); |
|
225 |
|
226 my $len = length($asnHex); |
|
227 if ($len % 2 != 0) { |
|
228 die "toBin: hex string contains an odd number ($len) of octets.\n$asnHex\n"; |
|
229 } |
|
230 |
|
231 my $binary; |
|
232 $binary .= pack("H${len}", $asnHex); |
|
233 # for (my $i = 0; $i < length($asnHex); $i+=2) { |
|
234 # $binary .= pack('C', substr($asnHex, $i, 2)); |
|
235 # } |
|
236 return $binary; |
|
237 } |
|
238 |
|
239 sub parseScript($$;$) { |
|
240 my ($lines, $oc, $params) = @_; |
|
241 my $derHex = ""; |
|
242 |
|
243 nest(); |
|
244 substVars($lines, $params); |
|
245 |
|
246 while (my $line = shift @$lines) { |
|
247 chomp($line); |
|
248 |
|
249 # Remove leading spaces |
|
250 $line =~ s/^\s*//g; |
|
251 |
|
252 # skip comments |
|
253 next if ($line =~ /^\/\//); |
|
254 |
|
255 if ($DEBUG == 3) { |
|
256 print "${TABS}:PARSE parseScript: $line\n"; |
|
257 } |
|
258 |
|
259 my $argString; |
|
260 my $cmd; |
|
261 if ($line =~ /(\w+)\s*\{/ ) { |
|
262 # parse block commands e.g. large integer |
|
263 $cmd = uc($1); |
|
264 |
|
265 $line =~ s/.*\{//g; |
|
266 while (defined $line && !($line =~ /(^|[^\\]+)\}/) ) { |
|
267 $argString .= $line; |
|
268 $line = shift(@$lines); |
|
269 } |
|
270 if (defined $line) { |
|
271 # append everything up to the closing curly bracket |
|
272 $line =~ s/(^|[^\\])\}.*/$1/g; |
|
273 $argString .= $line; |
|
274 } |
|
275 } |
|
276 elsif ($line =~ /(\w+)\s*=*(.*)/) { |
|
277 # parse commands of the form key = value |
|
278 $cmd = uc($1); |
|
279 $argString = defined $2 ? $2 : ""; |
|
280 } |
|
281 |
|
282 if (defined $cmd) { |
|
283 if ($cmd =~ /^END/) { |
|
284 leaveNest(); |
|
285 if ($DEBUG) { |
|
286 print "${TABS}:PARSE END\n"; |
|
287 } |
|
288 return $derHex; |
|
289 } |
|
290 elsif (! defined $PARSE{$cmd}) { |
|
291 die "parseScript: Unknown command: $cmd\n"; |
|
292 } |
|
293 else { |
|
294 if ($DEBUG) { |
|
295 print "${TABS}:PARSE CMD=$cmd"; |
|
296 if ($argString ne "") {print " ARG: $argString";} |
|
297 print "\n"; |
|
298 } |
|
299 |
|
300 # Substitue variables in argString |
|
301 $derHex .= ":" . &{$PARSE{$cmd}}($argString, $oc, $lines); |
|
302 } |
|
303 } |
|
304 |
|
305 } |
|
306 leaveNest(); |
|
307 return $derHex; |
|
308 } |
|
309 |
|
310 sub substVars($$) { |
|
311 my ($lines, $params) = @_; |
|
312 |
|
313 if (! defined $params) { |
|
314 @$params = (); |
|
315 } |
|
316 |
|
317 for (my $i = 0; $i < scalar(@$lines); $i++) { |
|
318 my $line = @$lines[$i]; |
|
319 my $paramIndex = 1; |
|
320 |
|
321 # For each parameter search for the a use of $N where |
|
322 # N is the index of the parameter and replace $N with the |
|
323 # value of the parameter |
|
324 foreach (@$params) { |
|
325 $line =~ s/\$${paramIndex}(\D|$)/$_$1/g; |
|
326 ++$paramIndex; |
|
327 } |
|
328 |
|
329 # Remove any unused parameters |
|
330 $line =~ s/\$\d+//g; |
|
331 @$lines[$i] = $line; |
|
332 } |
|
333 } |
|
334 |
|
335 sub readFile($) { |
|
336 my ($fileName) = @_; |
|
337 my $inFile; |
|
338 |
|
339 if ($DEBUG) { |
|
340 print "readFile, $fileName\n"; |
|
341 } |
|
342 |
|
343 open($inFile, $fileName) || die "readFile: cannot open $fileName\n"; |
|
344 my @lines = <$inFile>; |
|
345 close $inFile; |
|
346 |
|
347 return @lines; |
|
348 } |
|
349 |
|
350 sub parseBitString($$;$) { |
|
351 my ($argString, $oc, $lines) = @_; |
|
352 return encodeBitString($argString, $oc); |
|
353 } |
|
354 |
|
355 sub parseBitStringWrapper($$;$) { |
|
356 my ($argString, $oc, $lines) = @_; |
|
357 |
|
358 my $contents_oc = 0; |
|
359 my $contents = parseScript($lines, \$contents_oc); |
|
360 |
|
361 my $binary = toBin($contents); |
|
362 my $bitCount = $contents_oc * 8; |
|
363 my $bitStr = unpack("B${bitCount}", $binary); |
|
364 |
|
365 # remove trailing zeros - breaks signatures so disable for the moment |
|
366 # $bitStr =~ s/0*$//g; |
|
367 |
|
368 return encodeBitString($bitStr, $oc); |
|
369 } |
|
370 |
|
371 sub parseBmpString($$;$) { |
|
372 my ($argString, $oc, $lines) = @_; |
|
373 |
|
374 my $bmpString_oc = 0; |
|
375 my $bmpString = asciiToBmpString($argString, \$bmpString_oc); |
|
376 return encodeBmpString($bmpString, $bmpString_oc, $oc); |
|
377 } |
|
378 |
|
379 sub parseBmpStringFile($$;$) { |
|
380 my ($binFName, $oc, $lines) = @_; |
|
381 $binFName =~ s/\s*//g; |
|
382 |
|
383 my $bmpString_oc = 0; |
|
384 my $bmpString = encodeBinaryFile($binFName, \$bmpString_oc); |
|
385 |
|
386 return encodeBmpString($bmpString, $bmpString_oc, $oc); |
|
387 } |
|
388 |
|
389 sub parseBoolean($$;$) { |
|
390 my ($argString, $oc, $lines) = @_; |
|
391 |
|
392 $argString =~ s/\s//g; |
|
393 $argString = lc($argString); |
|
394 |
|
395 my $bool; |
|
396 if ($argString eq "t" || $argString eq "true" || $argString eq "1") { |
|
397 $bool = 1; |
|
398 } |
|
399 elsif ($argString eq "f" || $argString eq "false" || $argString eq "0") { |
|
400 $bool = 0; |
|
401 } |
|
402 else { |
|
403 die "parseBoolean: Invalid boolean value \'$argString\'"; |
|
404 } |
|
405 |
|
406 return encodeBoolean($bool, $oc); |
|
407 } |
|
408 |
|
409 sub parseHash($$;$) { |
|
410 my ($argString, $oc, $lines) = @_; |
|
411 my ($algorithm) = getArgs($argString); |
|
412 |
|
413 if (! defined $algorithm) { |
|
414 die "parseHash: missing algortithm"; |
|
415 } |
|
416 |
|
417 my $hashIn_oc = 0; |
|
418 my $hashIn = parseScript($lines, \$hashIn_oc); |
|
419 |
|
420 my $hashInFName = '_hashin.tmp'; |
|
421 my $hashOutFName = '_hashout.tmp'; |
|
422 |
|
423 # Create binary hash file |
|
424 my $hashInFh; |
|
425 open($hashInFh, ">$hashInFName") or die "Cannot create $hashInFName"; |
|
426 binmode($hashInFh); |
|
427 print $hashInFh toBin($hashIn); |
|
428 close $hashInFh; |
|
429 |
|
430 my @command = ("cmd", |
|
431 "/C \"openssl dgst -${algorithm} -binary $hashInFName > $hashOutFName\""); |
|
432 if ($DEBUG == 1) { |
|
433 print "${TABS}:parseHash:" . join(" ", @command) . "\n"; |
|
434 } |
|
435 |
|
436 if ((my $err = system(@command)) != 0) { |
|
437 die "parseHash: " . join(" ", @command) . "\nreturned error $err"; |
|
438 } |
|
439 |
|
440 my $derHex = parseIncludeBinaryFile($hashOutFName, $oc); |
|
441 |
|
442 if (! $DEBUG) { |
|
443 unlink($hashInFName); |
|
444 unlink($hashOutFName); |
|
445 } |
|
446 return $derHex; |
|
447 } |
|
448 |
|
449 sub parseHmac($$;$) { |
|
450 my ($argString, $oc, $lines) = @_; |
|
451 my ($algorithm, $key) = getArgs($argString); |
|
452 |
|
453 if (! defined $algorithm) { |
|
454 die "parseHmac: missing algortithm"; |
|
455 } |
|
456 $algorithm = uc($algorithm); |
|
457 if (! $algorithm =~ /MD5|SHA1/) { |
|
458 die "parseHmac: invalid algorithm $algorithm"; |
|
459 } |
|
460 |
|
461 if (! defined $key) { |
|
462 die "parseHmac: missing key"; |
|
463 } |
|
464 |
|
465 my $hmacIn_oc = 0; |
|
466 my $hmacIn = toBin(parseScript($lines, \$hmacIn_oc)); |
|
467 my $hmac; |
|
468 my $binKey = toBin($key); |
|
469 |
|
470 if ($algorithm eq "SHA1") { |
|
471 |
|
472 $hmac = Digest::HMAC_SHA1->new($binKey); |
|
473 } |
|
474 else { |
|
475 $hmac = Digest::HMAC_MD5->new($binKey); |
|
476 } |
|
477 $hmac->add($hmacIn); |
|
478 my $digest = $hmac->digest; |
|
479 $$oc += length($digest); |
|
480 |
|
481 return toHex($digest); |
|
482 } |
|
483 |
|
484 sub parseIA5String($$;$) { |
|
485 my ($argString, $oc, $lines) = @_; |
|
486 |
|
487 my $ia5String_oc = 0; |
|
488 my $ia5String = asciiToIA5String($argString, \$ia5String_oc); |
|
489 return encodeIA5String($ia5String, $ia5String_oc, $oc); |
|
490 } |
|
491 |
|
492 |
|
493 sub parseIA5StringFile($$;$) { |
|
494 my ($binFName, $oc, $lines) = @_; |
|
495 $binFName =~ s/\s*//g; |
|
496 |
|
497 my $ia5String_oc = 0; |
|
498 my $ia5String = encodeBinaryFile($binFName, \$ia5String_oc); |
|
499 |
|
500 return encodeIA5String($ia5String, $ia5String_oc, $oc); |
|
501 } |
|
502 |
|
503 sub parseIncludeBinaryFile($$;$) { |
|
504 my ($binFName, $oc, $lines) = @_; |
|
505 $binFName =~ s/\s*//g; |
|
506 |
|
507 return encodeBinaryFile($binFName, $oc); |
|
508 } |
|
509 |
|
510 sub parseInclude($$$) { |
|
511 my ($argString, $oc, $lines) = @_; |
|
512 my @args = getArgs($argString); |
|
513 |
|
514 my $fileName = shift(@args); |
|
515 if (! (defined $fileName && $fileName ne "")) { |
|
516 die "parseInclude: Filename not specified\n"; |
|
517 } |
|
518 |
|
519 my $derHex = ""; |
|
520 my @lines = readFile($fileName); |
|
521 $derHex = parseScript(\@lines, $oc, \@args); |
|
522 return $derHex; |
|
523 } |
|
524 |
|
525 sub parseInteger($$;$) { |
|
526 my ($argString, $oc, $lines) = @_; |
|
527 |
|
528 $argString =~ s/\s//g; |
|
529 return encodeInteger($argString, $oc); |
|
530 } |
|
531 |
|
532 sub parseBigInteger($$;$) { |
|
533 my ($argString, $oc, $lines) = @_; |
|
534 |
|
535 $argString =~ s/\s//g; |
|
536 return encodeBigInteger($argString, $oc); |
|
537 } |
|
538 |
|
539 sub parseEncrypt($$;$) { |
|
540 my ($argString, $oc, $lines) = @_; |
|
541 my ($cipher, $key, $iv) = getArgs($argString); |
|
542 |
|
543 if (! defined $cipher) { |
|
544 die "parseEncrypt: missing cipher\n"; |
|
545 } |
|
546 |
|
547 if (! defined $key) { |
|
548 die "parseEncrypt: missing key\n"; |
|
549 } |
|
550 |
|
551 my $plainText_oc = 0; |
|
552 my $plainText = parseScript($lines, \$plainText_oc); |
|
553 |
|
554 my $plainTextFName = '_plaintext.tmp'; |
|
555 my $cipherTextFName = '_ciphertext.tmp'; |
|
556 |
|
557 # Create binary plaintext file |
|
558 my $plainTextFh; |
|
559 open($plainTextFh, ">$plainTextFName") or die "Cannot create $plainTextFName"; |
|
560 binmode($plainTextFh); |
|
561 print $plainTextFh toBin($plainText); |
|
562 close $plainTextFh; |
|
563 |
|
564 my @command = ('openssl', |
|
565 'enc', |
|
566 "-${cipher}", |
|
567 '-e', |
|
568 '-K', $key, |
|
569 '-in', $plainTextFName, |
|
570 '-out', $cipherTextFName); |
|
571 |
|
572 if (defined $iv) { |
|
573 push @command, '-iv', $iv; |
|
574 } |
|
575 |
|
576 if ($DEBUG == 1) { |
|
577 print "${TABS}:parseEncrypt:" . join(" ", @command) . "\n"; |
|
578 } |
|
579 |
|
580 if ((my $err = system(@command)) != 0) { |
|
581 die "parseEncrypt: " . join(" ", @command) . "\nreturned error $err"; |
|
582 } |
|
583 |
|
584 my $derHex = parseIncludeBinaryFile($cipherTextFName, $oc); |
|
585 |
|
586 if (! $DEBUG) { |
|
587 unlink($plainTextFName); |
|
588 unlink($cipherTextFName); |
|
589 } |
|
590 return $derHex; |
|
591 } |
|
592 |
|
593 sub parseEnumerated($$;$) { |
|
594 my ($argString, $oc, $lines) = @_; |
|
595 |
|
596 $argString =~ s/\s//g; |
|
597 return encodeEnumerated($argString, $oc); |
|
598 } |
|
599 |
|
600 sub parseExplicit($$;$) { |
|
601 my ($argString, $oc, $lines) = @_; |
|
602 my ($tagNumber, $class) = getArgs($argString); |
|
603 |
|
604 if (! defined $tagNumber || $tagNumber =~ /^\s*$/) { |
|
605 $tagNumber = "0"; |
|
606 } |
|
607 elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) { |
|
608 die "parseExplicit: invalid tag number: \'$tagNumber\'"; |
|
609 } |
|
610 $tagNumber = hex($tagNumber); |
|
611 |
|
612 if (!defined $class || $class =~ /^\s*$/) { |
|
613 $class = $CONTEXT_SPECIFIC_CLASS; |
|
614 } |
|
615 else { |
|
616 $class =~ s/\s*//g; |
|
617 $class = uc($class); |
|
618 } |
|
619 |
|
620 if (! isValidClass($class)) { |
|
621 die "parseExplicit: invalid class \'$class\'"; |
|
622 } |
|
623 |
|
624 my $nested_oc = 0; |
|
625 my $nested = parseScript($lines, \$nested_oc); |
|
626 |
|
627 return encodeExplicit($class, $tagNumber, $nested, $nested_oc, $oc); |
|
628 } |
|
629 |
|
630 sub parseImplicit($$;$) { |
|
631 my ($argString, $oc, $lines) = @_; |
|
632 my ($tagNumber, $class) = getArgs($argString); |
|
633 |
|
634 if (! defined $tagNumber || $tagNumber =~ /^\s*$/) { |
|
635 $tagNumber = "0"; |
|
636 } |
|
637 elsif (!($tagNumber =~ /^[0-9A-Fa-f]+$/)) { |
|
638 die "parseImplicit: invalid tag number: \'$tagNumber\'"; |
|
639 } |
|
640 $tagNumber = hex($tagNumber); |
|
641 |
|
642 if (!defined $class || $class =~ /^\s*$/) { |
|
643 $class = $CONTEXT_SPECIFIC_CLASS; |
|
644 } |
|
645 else { |
|
646 $class =~ s/\s*//g; |
|
647 $class = uc($class); |
|
648 } |
|
649 |
|
650 if (! isValidClass($class)) { |
|
651 die "parseImplicit: invalid class \'$class\'"; |
|
652 } |
|
653 |
|
654 my $nested_oc = 0; |
|
655 my $nested = tidyHex(parseScript($lines, \$nested_oc)); |
|
656 |
|
657 # De-construct the nested data to allow the underlying type tag to be |
|
658 # changed. The output of parseScript had better be valid DER or this |
|
659 # will go horribly wrong ! |
|
660 my $uClass = ""; |
|
661 my $uConstructed = 0; |
|
662 my $uTag = 0; |
|
663 my $uLength = 0; |
|
664 my $uValue = ""; |
|
665 getTlv($nested, \$uClass, \$uConstructed, \$uTag, \$uLength, \$uValue); |
|
666 |
|
667 if ($DEBUG == 2) { |
|
668 print "${TABS}parseImplicit: underlyingType \'$uTag\'\n"; |
|
669 } |
|
670 |
|
671 # This only works for low tag numbers because we are assuming that the type |
|
672 # tag is a single octet |
|
673 return encodeImplicit($class, $uConstructed, $tagNumber, $uValue, $uLength, $oc); |
|
674 } |
|
675 |
|
676 sub parseNull($$;$) { |
|
677 my ($argString, $oc, $lines) = @_; |
|
678 |
|
679 return encodeNull($oc); |
|
680 } |
|
681 |
|
682 sub parseOctetString($$;$) { |
|
683 my ($argString, $oc, $lines) = @_; |
|
684 |
|
685 my $octetString_oc = 0; |
|
686 my $octetString = parseScript($lines, \$octetString_oc); |
|
687 |
|
688 return encodeOctetString($octetString, $octetString_oc, $oc); |
|
689 } |
|
690 |
|
691 sub parseOid($$;$) { |
|
692 my ($argString, $oc, $lines) = @_; |
|
693 $argString =~ s/\s//g; |
|
694 $argString = uc($argString); |
|
695 |
|
696 if (! defined $argString) { |
|
697 die "parseOid: Missing OID value."; |
|
698 } |
|
699 |
|
700 foreach (keys %OIDS) { |
|
701 if ($argString =~ /$_/) { |
|
702 $argString =~ s/\Q$_\E/$OIDS{$_}/g; |
|
703 } |
|
704 } |
|
705 return encodeOid($argString, $oc); |
|
706 } |
|
707 |
|
708 sub parseOutputFile($$;$) { |
|
709 my ($argString, $oc, $lines) = @_; |
|
710 my ($outputFile,$echo) = split(/,/, $argString); |
|
711 |
|
712 if (! defined $outputFile) { |
|
713 die "parseOutputFile: Missing file-name.\n"; |
|
714 } |
|
715 |
|
716 my $content_oc = 0; |
|
717 my $content = parseScript($lines, \$content_oc); |
|
718 |
|
719 my $outFh; |
|
720 if (! open($outFh, ">${outputFile}")) { |
|
721 die "parseOutputFile: Cannot create $outputFile\n"; |
|
722 } |
|
723 binmode($outFh); |
|
724 print $outFh toBin($content); |
|
725 close $outFh; |
|
726 |
|
727 # If echo is specified then include then contents of the output |
|
728 # file at this point in the stream. |
|
729 if (defined $echo && $echo =~ /(1|t|true)/i) { |
|
730 $$oc += $content_oc; |
|
731 return $content; |
|
732 } |
|
733 else { |
|
734 return ""; |
|
735 } |
|
736 } |
|
737 |
|
738 sub parsePrintableString($$;$) { |
|
739 my ($argString, $oc, $lines) = @_; |
|
740 |
|
741 my $printableString_oc = 0; |
|
742 my $printableString = asciiToPrintableString($argString, \$printableString_oc); |
|
743 return encodePrintableString($printableString, $printableString_oc, $oc); |
|
744 } |
|
745 |
|
746 sub parsePrintableStringFile($$;$) { |
|
747 my ($binFName, $oc, $lines) = @_; |
|
748 $binFName =~ s/\s*//g; |
|
749 |
|
750 my $printableString_oc = 0; |
|
751 my $printableString = encodeBinaryFile($binFName, \$printableString_oc); |
|
752 |
|
753 return encodePrintableString($printableString, $printableString_oc, $oc); |
|
754 } |
|
755 |
|
756 sub parseRaw($$;$) { |
|
757 my ($argString, $oc, $lines) = @_; |
|
758 $argString =~ s/\s//g; |
|
759 $argString = uc($argString); |
|
760 |
|
761 my $asnHex = ""; |
|
762 if (! ($argString =~ /(([A-Fa-f\d][A-Fa-f\d])[ :]*)+/)) { |
|
763 die "parseRaw: Invalid hex string: $argString\n"; |
|
764 } |
|
765 my $binary = toBin($argString); |
|
766 $$oc += length($binary); |
|
767 return tidyHex(toHex($binary)); |
|
768 } |
|
769 |
|
770 sub parseSequence($$;$) { |
|
771 my ($argString, $oc, $lines) = @_; |
|
772 |
|
773 my $sequence_oc = 0; |
|
774 my $sequence = parseScript($lines, \$sequence_oc); |
|
775 |
|
776 return encodeSequence($sequence, $sequence_oc, $oc); |
|
777 } |
|
778 |
|
779 sub parseSet($$;$) { |
|
780 my ($argString, $oc, $lines) = @_; |
|
781 |
|
782 my $set_oc = 0; |
|
783 my $set = parseScript($lines, \$set_oc); |
|
784 |
|
785 return encodeSet($set, $set_oc, $oc); |
|
786 } |
|
787 |
|
788 # Create a PKCS#7 signed data object for a chunk of data using |
|
789 # OpenSSL's SMIME command |
|
790 sub parseSign($$;$) { |
|
791 my ($argString, $oc, $lines) = @_; |
|
792 my ($signerCert, $signerKey) = getArgs($argString); |
|
793 |
|
794 if (! defined $signerCert) { |
|
795 die "parseSign: missing signing certificate"; |
|
796 } |
|
797 elsif (! -f $signerCert) { |
|
798 die "parseSign: signing certificate \'$signerCert\' does not exist."; |
|
799 } |
|
800 |
|
801 if (! defined $signerKey) { |
|
802 die "parseSign: missing signing certificate"; |
|
803 } |
|
804 elsif (! -f $signerKey) { |
|
805 die "parseSign: signing key \'$signerKey\' does not exist."; |
|
806 } |
|
807 |
|
808 my $unsigned_oc = 0; |
|
809 my $unsigned = parseScript($lines, \$unsigned_oc); |
|
810 |
|
811 my $unsignedFName = '_unsigned.tmp'; |
|
812 my $signedFName = '_signed.tmp'; |
|
813 |
|
814 # Create binary unsigned data file |
|
815 my $unsignedFh; |
|
816 open($unsignedFh, ">$unsignedFName") or die "Cannot create $unsignedFName"; |
|
817 binmode($unsignedFh); |
|
818 print $unsignedFh toBin($unsigned); |
|
819 close $unsignedFh; |
|
820 |
|
821 my @command = ('openssl', |
|
822 'smime', |
|
823 '-pk7out', |
|
824 '-nodetach', |
|
825 '-outform', |
|
826 'der', |
|
827 '-sign', |
|
828 '-signer', |
|
829 $signerCert, |
|
830 '-inkey', |
|
831 $signerKey, |
|
832 '-in', $unsignedFName, |
|
833 '-out', $signedFName); |
|
834 |
|
835 if ($DEBUG == 1) { |
|
836 print "${TABS}:parseSign:" . join(" ", @command) . "\n"; |
|
837 } |
|
838 |
|
839 if ((my $err = system(@command)) != 0) { |
|
840 die "parseSign: " . join(" ", @command) . "\nreturned error $err"; |
|
841 } |
|
842 |
|
843 my $derHex = parseIncludeBinaryFile($signedFName, $oc); |
|
844 |
|
845 if (! $DEBUG) { |
|
846 unlink($unsignedFName); |
|
847 unlink($signedFName); |
|
848 } |
|
849 return $derHex; |
|
850 } |
|
851 |
|
852 sub parseShell($$;$) { |
|
853 my ($argString, $oc, $lines) = @_; |
|
854 my @command = getArgs($argString); |
|
855 |
|
856 if (scalar(@command) < 1) { |
|
857 die "parseShell: no arguments"; |
|
858 } |
|
859 |
|
860 if ($DEBUG == 1) { |
|
861 print "${TABS}:parseShell:" . join(" ", @command) . "\n"; |
|
862 } |
|
863 |
|
864 if ((my $err = system(@command)) != 0) { |
|
865 die "parseShell: " . join(" ", @command) . "\nreturned error $err"; |
|
866 } |
|
867 return ""; |
|
868 } |
|
869 |
|
870 sub parseUtcTime($$;$) { |
|
871 my ($time, $oc, $lines) = @_; |
|
872 $time =~ s/\s//g; |
|
873 |
|
874 my $time_oc = length($time); |
|
875 return encodeUtcTime(toHex($time), $time_oc, $oc); |
|
876 } |
|
877 |
|
878 sub parseUtf8String($$;$) { |
|
879 my ($argString, $oc, $lines) = @_; |
|
880 |
|
881 my $utf8String_oc = 0; |
|
882 my $utf8String = asciiToUtf8String($argString, \$utf8String_oc); |
|
883 return encodeUtf8String($utf8String, $utf8String_oc, $oc); |
|
884 } |
|
885 |
|
886 sub parseUtf8StringFile($$;$) { |
|
887 my ($binFName, $oc, $lines) = @_; |
|
888 $binFName =~ s/\s*//g; |
|
889 |
|
890 my $utf8String_oc = 0; |
|
891 my $utf8String = encodeBinaryFile($binFName, \$utf8String_oc); |
|
892 |
|
893 return encodeUtf8String($utf8String, $utf8String_oc, $oc); |
|
894 } |
|
895 |
|
896 sub toHex($) { |
|
897 my ($bin) = @_; |
|
898 my $hex = unpack("H" . (length($bin) * 2), $bin); |
|
899 $hex =~ s/(..)/$1:/g; |
|
900 return $hex; |
|
901 } |
|
902 |
|
903 sub encodeBinaryFile($$) { |
|
904 my ($binFName, $oc) = @_; |
|
905 |
|
906 my $binFH; |
|
907 open($binFH, "$binFName") || die "encodeBinaryFile: Cannot open $binFName\n"; |
|
908 binmode($binFH); |
|
909 |
|
910 my $binBuf; |
|
911 my $readBuf; |
|
912 my $derHex = ""; |
|
913 while (my $len = sysread($binFH, $readBuf, 1024)) { |
|
914 $binBuf .= $readBuf; |
|
915 $$oc += $len; |
|
916 } |
|
917 close $binFH; |
|
918 |
|
919 return toHex($binBuf);; |
|
920 } |
|
921 |
|
922 # Creates a hex representation of the DER encoding of an arbitrary length bit string |
|
923 sub encodeBitString($$) { |
|
924 my ($text, $oc) = @_; |
|
925 |
|
926 # Bit string in hex including padding length octet |
|
927 my $bit_str = ""; |
|
928 my $bit_str_oc = 1; # one octet for padding |
|
929 |
|
930 # Current byte |
|
931 my $byte = 0; |
|
932 my $len = length($text); |
|
933 |
|
934 if ($len == 0) { |
|
935 $$oc+=2; |
|
936 return "03:00"; |
|
937 } |
|
938 |
|
939 my $i = 0; |
|
940 while ($i < $len) { |
|
941 |
|
942 # Read the ith character and insert it in the correct place in the byte |
|
943 # (fill from the left) |
|
944 my $c = substr($text, $i, 1); |
|
945 if ($c eq "1") { |
|
946 $byte |= (1 << (7 - ($i % 8))); |
|
947 } |
|
948 elsif ($c ne "0") { |
|
949 die "Invalid character $c in bit string $text"; |
|
950 } |
|
951 |
|
952 if (++$i % 8 == 0) { |
|
953 # Received 8 bits so output byte in hex |
|
954 if ($bit_str ne "") { |
|
955 $bit_str .= ":"; |
|
956 } |
|
957 $bit_str .= sprintf("%2.2x", $byte); |
|
958 $bit_str_oc++; |
|
959 $byte = 0; |
|
960 } |
|
961 } |
|
962 # Pad any remaining bits / make sure 0 is output for empty string |
|
963 if ($byte != 0 || $bit_str_oc == 1) { |
|
964 if ($bit_str ne "") { |
|
965 $bit_str .= ":"; |
|
966 } |
|
967 $bit_str .= sprintf("%2.2x", $byte); |
|
968 $bit_str_oc++; |
|
969 } |
|
970 |
|
971 my $pad_length = "00"; |
|
972 if ($len % 8 > 0) { |
|
973 # If this isn't a multiple of 8 bits then calculated |
|
974 # the number of padding bits added. |
|
975 $pad_length = sprintf("%2.2x", 8 - ($len % 8)); |
|
976 } |
|
977 |
|
978 if ($DEBUG == 2) { |
|
979 print "${TABS}:ENC:encodeBitString, $bit_str_oc\n"; |
|
980 } |
|
981 return encodeTlv($oc, $DER_BITSTRING_TAG, $bit_str_oc, "$pad_length:$bit_str"); |
|
982 } |
|
983 |
|
984 # Creates a hex represenation of the DER encoding of a BMPSTRING |
|
985 sub encodeBmpString($$$) { |
|
986 my ($bmpString, $bmpString_oc, $oc) = @_; |
|
987 |
|
988 if ($DEBUG == 2) { |
|
989 print "${TABS}:ENC:encodeBmpString, $bmpString_oc\n"; |
|
990 } |
|
991 return encodeTlv($oc, $DER_BMPSTRING_TAG, $bmpString_oc, $bmpString); |
|
992 } |
|
993 |
|
994 sub encodeBoolean($$) { |
|
995 my ($value, $oc) = @_; |
|
996 |
|
997 my $boolean = "00"; |
|
998 if ($value) { |
|
999 $boolean = "FF"; |
|
1000 } |
|
1001 |
|
1002 if ($DEBUG == 2) { |
|
1003 print "${TABS}:ENC:encodeBoolean, 1\n"; |
|
1004 } |
|
1005 return encodeTlv($oc, $DER_BOOLEAN_TAG, 1, $boolean); |
|
1006 } |
|
1007 |
|
1008 sub encodeEnumerated($$) { |
|
1009 my ($int, $oc) = @_; |
|
1010 |
|
1011 $int =~ s/\s//g; |
|
1012 |
|
1013 if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) { |
|
1014 die "encodeEnumerated: Invalid argument: $int\n"; |
|
1015 } |
|
1016 |
|
1017 if ($int =~ s/^0x//) { |
|
1018 $int = hex; |
|
1019 } |
|
1020 |
|
1021 # Convert the enumerated to base 256 hex and find out how |
|
1022 # many octets were required |
|
1023 my $hex_enumerated_oc = 0; |
|
1024 my $hex_enumerated = ""; |
|
1025 |
|
1026 if ($int ne "") { |
|
1027 $hex_enumerated = encodeBase256($int, \$hex_enumerated_oc); |
|
1028 } |
|
1029 |
|
1030 if ($DEBUG == 2) { |
|
1031 print "${TABS}:ENC: , $hex_enumerated_oc\n"; |
|
1032 } |
|
1033 |
|
1034 return encodeTlv($oc, $DER_ENUMERATED_TAG, $hex_enumerated_oc, $hex_enumerated); |
|
1035 } |
|
1036 |
|
1037 # explicit tags are always constructed |
|
1038 sub encodeExplicit($$$$) { |
|
1039 my ($class, $tagNumber, $explicit, $explicit_oc, $oc) = @_; |
|
1040 |
|
1041 if ($DEBUG == 2) { |
|
1042 print "${TABS}:ENC: explicit, $explicit_oc\n"; |
|
1043 } |
|
1044 return encodeTlv($oc, $tagNumber, $explicit_oc, $explicit, 1, $class); |
|
1045 } |
|
1046 |
|
1047 # Creates a hex represenation of the DER encoding of an IA5 string |
|
1048 sub encodeIA5String($$) { |
|
1049 my ($ia5String, $ia5String_oc, $oc) = @_; |
|
1050 |
|
1051 if ($DEBUG == 2) { |
|
1052 print "${TABS}:ENC:encodeIA5String, $ia5String_oc\n"; |
|
1053 } |
|
1054 return encodeTlv($oc, $DER_IA5STRING_TAG, $ia5String_oc, $ia5String); |
|
1055 } |
|
1056 |
|
1057 sub encodeImplicit($$$$$) { |
|
1058 my ($class, $constructed, $tagNumber, $implicit, $implicit_oc, $oc) = @_; |
|
1059 |
|
1060 if ($DEBUG == 2) { |
|
1061 print "${TABS}:ENC: implicit, $implicit_oc\n"; |
|
1062 } |
|
1063 return encodeTlv($oc, $tagNumber, $implicit_oc, $implicit, $constructed, $class); |
|
1064 } |
|
1065 |
|
1066 sub encodeBigInteger($$) { |
|
1067 my ($hexString, $oc) = @_; |
|
1068 |
|
1069 my $bin = toBin($hexString); |
|
1070 my $int = toHex($bin); |
|
1071 my $int_oc = length($bin); |
|
1072 |
|
1073 if ($DEBUG == 2) { |
|
1074 print "${TABS}:ENC: bigInteger, $int_oc\n"; |
|
1075 } |
|
1076 return encodeTlv($oc, $DER_INTEGER_TAG, $int_oc, $int) |
|
1077 } |
|
1078 |
|
1079 sub encodeInteger($$) { |
|
1080 my ($int, $oc) = @_; |
|
1081 |
|
1082 $int =~ s/\s//g; |
|
1083 |
|
1084 if (! ($int =~ /^-??\d+$/ || $int =~ /0x[0-9A-Fa-f]+/)) { |
|
1085 die "encodeInteger: Invalid argument: $int\n"; |
|
1086 } |
|
1087 |
|
1088 if ($int =~ s/^0x//) { |
|
1089 $int = hex; |
|
1090 } |
|
1091 |
|
1092 # Convert the integer to base 256 hex and find out how |
|
1093 # many octets were required |
|
1094 my $hex_integer_oc = 0; |
|
1095 my $hex_integer = ""; |
|
1096 |
|
1097 if ($int ne "") { |
|
1098 $hex_integer = encodeBase256($int, \$hex_integer_oc); |
|
1099 } |
|
1100 |
|
1101 if ($DEBUG == 2) { |
|
1102 print "${TABS}:ENC: integer, $hex_integer_oc\n"; |
|
1103 } |
|
1104 |
|
1105 return encodeTlv($oc, $DER_INTEGER_TAG, $hex_integer_oc, $hex_integer); |
|
1106 } |
|
1107 |
|
1108 sub encodeNull($) { |
|
1109 my ($oc) = @_; |
|
1110 return encodeTlv($oc, $DER_NULL_TAG, 0, ""); |
|
1111 } |
|
1112 |
|
1113 sub encodeOctetString($$$) { |
|
1114 my ($octetString, $octetString_oc, $oc) = @_; |
|
1115 |
|
1116 if ($DEBUG == 2) { |
|
1117 print "${TABS}:ENC: octetString, $octetString_oc\n"; |
|
1118 } |
|
1119 return encodeTlv($oc, $DER_OCTETSTRING_TAG, $octetString_oc, $octetString); |
|
1120 } |
|
1121 |
|
1122 sub encodeOid($$) { |
|
1123 my ($text, $oc) = @_; |
|
1124 |
|
1125 my @fields = split /\./, $text; |
|
1126 |
|
1127 if (! ($fields[0] >= 0 && $fields[0] <=2) ) { |
|
1128 die "Invalid OID: $text\n"; |
|
1129 } |
|
1130 if (! ($fields[1] >= 0 && $fields[1] <= 39) ) { |
|
1131 die "Invalid OID: $text"; |
|
1132 } |
|
1133 |
|
1134 my $oid = sprintf("%2.2x", (40 * $fields[0]) + $fields[1]); |
|
1135 my $oid_oc = 1; |
|
1136 shift @fields; |
|
1137 shift @fields; |
|
1138 |
|
1139 foreach (@fields) { |
|
1140 $oid .= ":" . encodeBase128($_, \$oid_oc); |
|
1141 } |
|
1142 |
|
1143 if ($DEBUG == 2) { |
|
1144 print "${TABS}:ENC:encodeOid, $oid_oc\n"; |
|
1145 } |
|
1146 return encodeTlv($oc, $DER_OID_TAG, $oid_oc, $oid); |
|
1147 } |
|
1148 |
|
1149 # Creates a hex represenation of the DER encoding of a PRINTABLE string |
|
1150 sub encodePrintableString($$$) { |
|
1151 my ($printableString, $printableString_oc, $oc) = @_; |
|
1152 |
|
1153 if ($DEBUG == 2) { |
|
1154 print "${TABS}:ENC:encodePrintableString, $printableString_oc\n"; |
|
1155 } |
|
1156 return encodeTlv($oc, $DER_PRINTABLESTRING_TAG, $printableString_oc, $printableString); |
|
1157 } |
|
1158 |
|
1159 sub encodeSet($$$) { |
|
1160 my ($set, $set_oc, $oc) = @_; |
|
1161 |
|
1162 if ($DEBUG == 2) { |
|
1163 print "${TABS}:ENC: set, $set_oc\n"; |
|
1164 } |
|
1165 return encodeTlv($oc, $DER_SET_TAG, $set_oc, $set, 1); |
|
1166 } |
|
1167 |
|
1168 sub encodeSequence($$$) { |
|
1169 my ($sequence, $sequence_oc, $oc) = @_; |
|
1170 |
|
1171 if ($DEBUG == 2) { |
|
1172 print "${TABS}:ENC: sequence, $sequence_oc\n"; |
|
1173 } |
|
1174 return encodeTlv($oc, $DER_SEQUENCE_TAG, $sequence_oc, $sequence, 1); |
|
1175 } |
|
1176 |
|
1177 sub encodeUtcTime($$$) { |
|
1178 my ($utcTime, $utcTime_oc, $oc) = @_; |
|
1179 |
|
1180 if ($DEBUG == 2) { |
|
1181 print "${TABS}:ENC: UTCTime, $utcTime_oc\n"; |
|
1182 } |
|
1183 return encodeTlv($oc, $DER_UTCTIME_TAG, $utcTime_oc, $utcTime); |
|
1184 } |
|
1185 |
|
1186 # Creates a hex represenation of the DER encoding of a UTF-8 string. |
|
1187 sub encodeUtf8String($$) { |
|
1188 my ($utf8String, $utf8String_oc, $oc) = @_; |
|
1189 |
|
1190 if ($DEBUG == 2) { |
|
1191 print "${TABS}:ENC:encodeUTF8String, $utf8String_oc\n"; |
|
1192 } |
|
1193 return encodeTlv($oc, $DER_UTF8STRING_TAG, $utf8String_oc, $utf8String); |
|
1194 } |
|
1195 |
|
1196 sub asciiToBmpString($$) { |
|
1197 my ($input, $oc) = @_; |
|
1198 |
|
1199 my $bmpString = ""; |
|
1200 my $input_len = length($input); |
|
1201 $$oc += $input_len * 2; |
|
1202 |
|
1203 for (my $i = 0; $i < $input_len; ++$i) { |
|
1204 my $hex_val = ord(substr($input, $i, 1)); |
|
1205 if ($bmpString ne "") { |
|
1206 $bmpString .= ":"; |
|
1207 } |
|
1208 $bmpString .= sprintf(":00:%2.2x", $hex_val); |
|
1209 } |
|
1210 return $bmpString; |
|
1211 } |
|
1212 |
|
1213 sub asciiToIA5String($$) { |
|
1214 my ($input, $oc) = @_; |
|
1215 |
|
1216 my $printableString = ""; |
|
1217 my $input_len = length($input); |
|
1218 $$oc += $input_len; |
|
1219 |
|
1220 for (my $i = 0; $i < $input_len; ++$i) { |
|
1221 my $hex_val = ord(substr($input, $i, 1)); |
|
1222 if ($printableString ne "") { |
|
1223 $printableString .= ":"; |
|
1224 } |
|
1225 $printableString .= sprintf(":%2.2x", $hex_val); |
|
1226 } |
|
1227 return $printableString; |
|
1228 } |
|
1229 |
|
1230 sub asciiToPrintableString($$) { |
|
1231 my ($input, $oc) = @_; |
|
1232 |
|
1233 my $ia5String = ""; |
|
1234 my $input_len = length($input); |
|
1235 $$oc += $input_len; |
|
1236 |
|
1237 for (my $i = 0; $i < $input_len; ++$i) { |
|
1238 my $hex_val = ord(substr($input, $i, 1)); |
|
1239 if ($ia5String ne "") { |
|
1240 $ia5String .= ":"; |
|
1241 } |
|
1242 $ia5String .= sprintf(":%2.2x", $hex_val); |
|
1243 } |
|
1244 return $ia5String; |
|
1245 } |
|
1246 |
|
1247 sub asciiToUtf8String($$) { |
|
1248 my ($input, $oc) = @_; |
|
1249 |
|
1250 my $utf8String = ""; |
|
1251 my $input_len = length($input); |
|
1252 $$oc += $input_len; |
|
1253 |
|
1254 for (my $i = 0; $i < $input_len; ++$i) { |
|
1255 my $hex_val = ord(substr($input, $i, 1)); |
|
1256 if ($utf8String ne "") { |
|
1257 $utf8String .= ":"; |
|
1258 } |
|
1259 $utf8String .= sprintf(":%2.2x", $hex_val); |
|
1260 } |
|
1261 return $utf8String; |
|
1262 } |
|
1263 |
|
1264 sub encodeBase128($$$) { |
|
1265 my ($num, $oc) = @_; |
|
1266 |
|
1267 my $base128 = ""; |
|
1268 $num = int($num); |
|
1269 my $base128_length = 0; |
|
1270 |
|
1271 while ($num > 0) { |
|
1272 my $hexoctet; |
|
1273 |
|
1274 if ($base128 eq "") { |
|
1275 $hexoctet = sprintf("%2.2x", $num & 0x7f); |
|
1276 } |
|
1277 else { |
|
1278 $hexoctet = sprintf("%2.2x", ($num & 0x7f) | 0x80); |
|
1279 } |
|
1280 |
|
1281 if ($base128 eq "") { |
|
1282 $base128 = $hexoctet; |
|
1283 } |
|
1284 else { |
|
1285 $base128 = "$hexoctet:$base128"; |
|
1286 } |
|
1287 |
|
1288 $num >>= 7; |
|
1289 $base128_length++; |
|
1290 } |
|
1291 if ($base128 eq "") { |
|
1292 $base128 = "00"; |
|
1293 $base128_length++; |
|
1294 } |
|
1295 |
|
1296 $$oc += $base128_length; |
|
1297 |
|
1298 if ($DEBUG == 2) { |
|
1299 print "${TABS}:ENC: base128, $base128_length, $$oc\n"; |
|
1300 } |
|
1301 |
|
1302 return $base128; |
|
1303 } |
|
1304 |
|
1305 # Return a hex represenation of the length using DER primitive (definate length encoding) |
|
1306 sub encodeLength($$) { |
|
1307 my ($num, $oc) = @_; |
|
1308 |
|
1309 if ($num < 128) { |
|
1310 # Number is < 128 so encode in short form |
|
1311 $$oc++; |
|
1312 return sprintf("%2.2x", $num); |
|
1313 } |
|
1314 else { |
|
1315 # Number >= 128 so encode in long form |
|
1316 my $length_oc = 0; |
|
1317 my $base256 = &encodeBase256($num, \$length_oc, 1); |
|
1318 if ($length_oc > 127) {die "Encoding overflow.";} |
|
1319 |
|
1320 $$oc += 1 + $length_oc; |
|
1321 |
|
1322 # Set the top bit of the length octet to indicate long form |
|
1323 return "" . sprintf("%2.2x", ($length_oc | 0x80)) . ":$base256"; |
|
1324 } |
|
1325 } |
|
1326 |
|
1327 # Convert an integer into an ascii hex representation in base 256 |
|
1328 # $num - the number to encode |
|
1329 # $octets - refernce to the octet count to increment |
|
1330 # $unsigned - assume unsigned |
|
1331 sub encodeBase256($$) { |
|
1332 my ($numIn, $oc, $unsigned) = @_; |
|
1333 |
|
1334 my $base256 = ""; |
|
1335 my $num = int($numIn); |
|
1336 |
|
1337 while ($num != 0) { |
|
1338 my $hexoctet = sprintf("%2.2x", $num & 0xFF); |
|
1339 if ($base256 ne "") { |
|
1340 $base256 = "$hexoctet:$base256"; |
|
1341 } |
|
1342 else { |
|
1343 $base256 = $hexoctet; |
|
1344 } |
|
1345 $num >>= 8; |
|
1346 $$oc++; |
|
1347 } |
|
1348 if ($base256 eq "") { |
|
1349 $base256 = "00"; |
|
1350 $$oc++; |
|
1351 } |
|
1352 |
|
1353 # If the integer is +ve and the MSB is 1 then padd with a leading zero |
|
1354 # octet otherwise it will look -ve |
|
1355 if ((! $unsigned) && $numIn > 0 && $base256 =~ /^:*[8ABCDEF]/i) { |
|
1356 $base256 = "00:$base256"; |
|
1357 $$oc++; |
|
1358 } |
|
1359 |
|
1360 # If the first octet is all ones and the msb of the next bit |
|
1361 # is also one then drop the first octet because negative |
|
1362 # numbers should not be padded |
|
1363 while ($base256 =~ s/^(FF:)([8ABCDEF][0-9A-F].*)/$2/i) { |
|
1364 $$oc--; |
|
1365 } |
|
1366 |
|
1367 return $base256; |
|
1368 } |
|
1369 |
|
1370 # Encode the Type |
|
1371 # Only low tag form is supported at the moment |
|
1372 sub encodeType($$;$$) { |
|
1373 my ($oc, $tagNumber, $constructed, $class) = @_; |
|
1374 |
|
1375 $tagNumber = hex($tagNumber); |
|
1376 |
|
1377 if ($tagNumber < 0 || $tagNumber > 30) { |
|
1378 die "encodeType: Currently, only low tag numbers (0 - 30) are supported."; |
|
1379 } |
|
1380 |
|
1381 if (! defined $class) { |
|
1382 $class = "UNIVERSAL"; |
|
1383 } |
|
1384 |
|
1385 $class = uc($class); |
|
1386 if (! isValidClass($class)) { |
|
1387 die "encodeType: invalid class \'$class\'"; |
|
1388 } |
|
1389 |
|
1390 # If the type is constructed then set bit 6 |
|
1391 if (defined $constructed && $constructed == 1) { |
|
1392 $tagNumber |= 0x20; |
|
1393 } |
|
1394 |
|
1395 if ($class eq $UNIVERSAL_CLASS) { |
|
1396 # do nothing, bits 7 and 8 are zero |
|
1397 } |
|
1398 elsif ($class eq $APPLICATION_CLASS) { |
|
1399 # set bit 7 |
|
1400 $tagNumber |= 0x40; |
|
1401 } |
|
1402 elsif ($class eq $CONTEXT_SPECIFIC_CLASS) { |
|
1403 # set bit 8 |
|
1404 $tagNumber |= 0x80; |
|
1405 } |
|
1406 elsif ($class eq $PRIVATE_CLASS) { |
|
1407 # set bits 7 and 8 |
|
1408 $tagNumber |= 0xC0; |
|
1409 } |
|
1410 $$oc++; |
|
1411 return sprintf("%2.2x", $tagNumber); |
|
1412 } |
|
1413 |
|
1414 sub encodeTlv($$$$;$$) { |
|
1415 my ($oc, $tag, $length, $value, $constructed, $class) = @_; |
|
1416 |
|
1417 if ($DEBUG == 3) { |
|
1418 print "${TABS}encodeTlv\n"; |
|
1419 print "${TABS}oc=$$oc\n"; |
|
1420 print "${TABS}tag=$tag\n"; |
|
1421 print "${TABS}length=$length\n"; |
|
1422 print "${TABS}value=$value\n"; |
|
1423 if (defined $constructed) { |
|
1424 print "${TABS}constructed=$constructed\n"; |
|
1425 } |
|
1426 if (defined $class) { |
|
1427 print "${TABS}class=$class\n"; |
|
1428 } |
|
1429 } |
|
1430 |
|
1431 my $hex; |
|
1432 $hex = encodeType($oc, $tag, $constructed, $class); |
|
1433 $hex .= ":" . encodeLength($length, $oc); |
|
1434 $$oc += $length; |
|
1435 $hex .= ":" . $value; |
|
1436 |
|
1437 if ($DEBUG == 3) { |
|
1438 print "${TABS}oc=$$oc\n"; |
|
1439 print "${TABS}encoding=$hex\n"; |
|
1440 print "${TABS}end\n"; |
|
1441 |
|
1442 toBin($hex); |
|
1443 } |
|
1444 return $hex; |
|
1445 } |
|
1446 |
|
1447 # increment debug tabbing level |
|
1448 sub nest() { |
|
1449 $TABS .= " "; |
|
1450 } |
|
1451 |
|
1452 # decrement debug tabbing level |
|
1453 sub leaveNest() { |
|
1454 $TABS =~ s/^...//; |
|
1455 } |
|
1456 |
|
1457 sub isValidClass($) { |
|
1458 my ($class) = @_; |
|
1459 |
|
1460 if (defined $class && |
|
1461 $class =~ /^(UNIVERSAL|APPLICATION|CONTEXT-SPECIFIC|PRIVATE)$/) { |
|
1462 return 1; |
|
1463 } |
|
1464 return 0; |
|
1465 } |
|
1466 |
|
1467 # Parse a DER field |
|
1468 sub getTlv($$$$$$) { |
|
1469 my ($input, $class, $constructed, $tag, $length, $value) = @_; |
|
1470 |
|
1471 my @hexOctets = split(/:+/,tidyHex($input)); |
|
1472 |
|
1473 if (scalar(@hexOctets) < 2) { |
|
1474 die "getTlv: too short"; |
|
1475 } |
|
1476 |
|
1477 my $type = hex(shift @hexOctets); |
|
1478 if (($type & 0xC0) == 0x00) { |
|
1479 # universal: bit 8 = 0, bit 7 = 0 |
|
1480 $$class = $UNIVERSAL_CLASS; |
|
1481 } |
|
1482 elsif (($type & 0xC0) == 0x40) { |
|
1483 # application: bit 8 = 0, bit 7 = 1 |
|
1484 $$class = $APPLICATION_CLASS; |
|
1485 } |
|
1486 elsif (($type & 0xC0) == 0x80) { |
|
1487 # application: bit 8 = 1, bit 7 = 0 |
|
1488 $$class = $CONTEXT_SPECIFIC_CLASS; |
|
1489 } |
|
1490 elsif (($type & 0xC0) == 0xC0) { |
|
1491 # application: bit 8 = 1, bit 7 = 1 |
|
1492 $$class = $PRIVATE_CLASS; |
|
1493 } |
|
1494 else { |
|
1495 die "getTlv: assert"; |
|
1496 } |
|
1497 |
|
1498 if ($type & 0x20) { |
|
1499 # constructed if bit 6 = 1 |
|
1500 $$constructed = 1; |
|
1501 } |
|
1502 else { |
|
1503 $$constructed = 0; |
|
1504 } |
|
1505 |
|
1506 # We assumme the tag number is in low form |
|
1507 # and just look at the bottom 5 hits |
|
1508 $$tag = $type & 0x1F; |
|
1509 |
|
1510 $$length = hex(shift @hexOctets); |
|
1511 if ($$length & 0x80) { |
|
1512 # long form |
|
1513 my $length_oc = $$length & 0x7F; |
|
1514 $$length = 0; |
|
1515 for (my $i = 0; $i < $length_oc; $i++) { |
|
1516 # length is encoded base 256 |
|
1517 $$length *= 256; |
|
1518 $$length += hex(shift @hexOctets); |
|
1519 } |
|
1520 } |
|
1521 else { |
|
1522 # short form |
|
1523 # don't do anything here, length is just bits 7 - 1 and |
|
1524 # we already know bit 8 is zero. |
|
1525 } |
|
1526 |
|
1527 $$value = ""; |
|
1528 foreach (@hexOctets) { |
|
1529 $$value .= ":$_"; |
|
1530 } |
|
1531 |
|
1532 if ($DEBUG == 3) { |
|
1533 print "${TABS} class=$$class\n"; |
|
1534 print "${TABS} constructed=$$constructed\n"; |
|
1535 print "${TABS} tag=$$tag\n"; |
|
1536 print "${TABS} length=$$length\n"; |
|
1537 } |
|
1538 } |
|
1539 |
|
1540 # parse an escaped (\) comma seperated argument string |
|
1541 # into an array |
|
1542 sub getArgs($) { |
|
1543 my ($argString) = @_; |
|
1544 my @args = (); |
|
1545 |
|
1546 while ($argString =~ /(^|.*?[^\\]),(.*)/ ) { |
|
1547 my $match = $1; |
|
1548 $argString = $2; |
|
1549 if ($match ne "") { |
|
1550 |
|
1551 # unescape |
|
1552 $match =~ s/(\\)([^\\])/$2/g; |
|
1553 push @args, $match; |
|
1554 } |
|
1555 } |
|
1556 if ($argString ne "") { |
|
1557 push @args, $argString; |
|
1558 } |
|
1559 return @args; |
|
1560 } |