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