CACreateCert: let --dni serial=# relocate the random serial number
[ezcert.git] / CACreateCert
blobcdf3a8007b91fa76d0f528f4ee53c48dd2e1e7d3
1 #!/usr/bin/env perl
3 # CACreateCert - Create various types of certificates
4 # Copyright (C) 2011-2015 Kyle J. McKay. All rights reserved.
6 # This program is free software: you can redistribute it and/or modify
7 # it under the terms of the GNU Affero General Public License as published by
8 # the Free Software Foundation, either version 3 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU Affero General Public License for more details.
16 # You should have received a copy of the GNU Affero General Public License
17 # along with this program. If not, see <http://www.gnu.org/licenses/>.
19 exit(&main());
21 use strict;
22 use warnings;
23 use bytes;
25 use MIME::Base64;
26 use IPC::Open2;
27 use Digest::MD5 qw(md5 md5_hex md5_base64);
28 use Getopt::Long qw(:config gnu_getopt);
30 our $VERSION;
31 my $VERSIONMSG;
32 my $HELP;
33 my $USAGE;
35 my $hasSha2;
37 BEGIN {
38 *VERSION = \'1.3.2';
39 $VERSIONMSG = "CACreateCert version $VERSION\n" .
40 "Copyright (c) 2011-2015 Kyle J. McKay. All rights reserved.\n" .
41 "License AGPLv3+: GNU Affero GPL version 3 or later.\n" .
42 "http://gnu.org/licenses/agpl.html\n" .
43 "This is free software: you are free to change and redistribute it.\n" .
44 "There is NO WARRANTY, to the extent permitted by law.\n";
47 BEGIN {
48 $hasSha2 = 0;
50 eval {
51 require Digest::SHA;
52 Digest::SHA->import(
53 qw(
54 sha1 sha1_hex sha1_base64
55 sha224 sha224_hex sha224_base64
56 sha256 sha256_hex sha256_base64
57 sha384 sha384_hex sha384_base64
58 sha512 sha512_hex sha512_base64
60 ); $hasSha2=1} ||
61 eval {
62 require Digest::SHA::PurePerl;
63 require Digest::SHA1;
64 Digest::SHA1->import(
65 qw(
66 sha1 sha1_hex sha1_base64
69 Digest::SHA::PurePerl->import(
70 qw(
71 sha224 sha224_hex sha224_base64
72 sha256 sha256_hex sha256_base64
73 sha384 sha384_hex sha384_base64
74 sha512 sha512_hex sha512_base64
76 ); $hasSha2=1} ||
77 eval {
78 require Digest::SHA::PurePerl;
79 Digest::SHA::PurePerl->import(
80 qw(
81 sha1 sha1_hex sha1_base64
82 sha224 sha224_hex sha224_base64
83 sha256 sha256_hex sha256_base64
84 sha384 sha384_hex sha384_base64
85 sha512 sha512_hex sha512_base64
87 ); $hasSha2=1} ||
88 eval {
89 require Digest::SHA1;
90 Digest::SHA1->import(
91 qw(
92 sha1 sha1_hex sha1_base64
94 ); 1} ||
95 die "One of Digest::SHA1 or Digest::SHA or Digest::SHA::PurePerl "
96 . "must be available\n";
98 eval {(`openssl version -v 2>/dev/null` || '') =~ /^OpenSSL /} ||
99 die "OpenSSL (as the openssl command) is not available in the PATH\n";
102 BEGIN {
103 $USAGE = <<USAGE;
104 Usage: CACreateCert [-h] [--version] [--verbose] [--debug] [--quiet] [--check]
105 [--now] [--pubx509] [-t] [--digest=sha1|sha224|sha256|sha384|sha512]
106 [--root | --subca | --server | --codesign | --applecodesign | --email]
107 [--client] [--rootauth] [--authext] [--pathlen n] [--suffix suffix.pem]
108 [--random | --no-random] [--in pub_key_file] [--out out_cert.pem]
109 [--cert signing_cert] [--dni k=v] [--dns "name-or-ip"] [--dnq "qual"]
110 --key priv_key_file "name string"
111 USAGE
112 $HELP = <<HELP;
113 NAME
114 CACreateCert -- create X.509 certificate
116 SYNOPSIS
117 CACreateCert [-h] [--version] [--verbose] [--debug] [--quiet] [--check]
118 [--now] [--pubx509] [-t] [--digest=sha1|sha224|sha256|sha384|sha512]
119 [--root | --subca | --server | --codesign | --applecodesign | --email]
120 [--client] [--rootauth] [--authext] [--pathlen n] [--suffix suffix.pem]
121 [--random | --no-random] [--in pubkeyfile] [--out pemcertfile]
122 [--cert signing_cert] [--dni k=v] [--dns "name-or-ip"] [--dnq "qual"]
123 --key priv_key_file "name string"
124 CACreateCert --root [--random] --key priv_key_file "name string" > ca.pem
125 CACreateCert --key priv_key_file --cert signing_cert "name string"
126 < pub_key_file > out_cert.pem
128 DESCRIPTION
129 CACreateCert creates a new certificate. Various certificate types are
130 supported including root CA certificates, sub CA certificates, server
131 certificates, code signing certificates, email certificates and client
132 certificates.
134 When creating a certificate, the only private key required is that of
135 the signer. This means that, for example, a new client authentication
136 certifcate can be created given only the public key of the client and
137 the private key of the signing certificate.
139 The public key for the certificate being created may be provided in
140 either OpenSSH .pub format or X.509 public key format. The
141 "openssl rsa -pubout" or "openssl x509 -noout -pubkey" commands can be
142 used to produce an X.509 format public key from either an RSA private key
143 or an X.509 certificate respectively. Note that only OpenSSH RSA public
144 keys in protocol format 2 are supported (they start with "ssh-rsa ").
146 When creating a root certificate no public key is required.
148 The "name string" value given must be appropriate for the type of
149 certificate being created. For a client authentication certificate it
150 will typically be a *nix user login (all lowercase) on the server to
151 which clients connect to. For an email certificate it will typically
152 be the full email address. For a server it will generally be the
153 canonical DNS name of the server.
155 No validation is performed on the "name string" value except that it
156 must not be the empty string. It may be provided in either Latin-1 or
157 UTF-8.
159 The priv_key_file must be an RSA private key file in PEM or DER format
160 and furthermore it must not have a password (both openssl genrsa and
161 ssh-keygen -t rsa can create these kinds of RSA private key files). If
162 a host is running an OpenSSH sshd daemon, then it probably already has a
163 suitable host private RSA key in either /etc/ssh/ssh_host_rsa_key or
164 /etc/ssh_host_rsa_key that can be used if desired.
166 The signing_cert must be an X.509 certificate that uses priv_key_file as
167 its private key. It may be in either PEM or DER format. The created
168 certificate will be signed by the signing_cert. The CACreateCert utility
169 can be used to create a suitable signing_cert certificate authority
170 certificate from the priv_key_file if desired by using the --root option.
172 When creating a root certificate no signing_cert is required.
174 On success the new certificate is written in PEM format to standard
175 output. (All error/information messages are written to standard error.)
177 Note that certificates created by CACreateCert are deterministic (i.e.
178 the bytewise identical certificate will be output) given the identical
179 input arguments only so long as neither the --random nor --now options
180 are used.
182 Also note that the certificates created by this utility do not expire.
184 OPTIONS
185 -h/--help
186 Show this help
188 -V/--version
189 Show the CACreateCert version
191 -v/--verbose
192 Produce extra informational messages to standard error.
193 Suppresses --quiet.
195 --list-oid-names
196 Show a list of recognized key names for the --dni option. If
197 given other options are ignored.
199 --man
200 Same as --verbose --help.
202 --debug
203 Show debugging information. Automatically enables --verbose.
204 Suppresses --quiet.
206 --quiet
207 Suppress all messages except errors. Ignored if --debug or
208 --verbose given.
210 --check
211 Perform all normal validation checks (except for a non-empty
212 "name string") but do not actually produce a certificate.
213 Automatically enables --verbose.
215 --now
216 Normally the validity not before date will be set to the signing
217 certificate's not before date or the approval date of the X.509
218 v3 standard (root certificates). Using this option causes the
219 not before validity date of the generated certificate to be set
220 to the current time. Use of this option will preclude production
221 of byte-exact matching output certificates for the same input
222 arguments.
224 --pubx509/--pubX509
225 Force the public key read from standard input to be interpreted
226 as an X.509 format public key. Normally this should be
227 automatically detected and this option should not be needed.
228 This option is ignored if --root is given.
231 Allow reading the public key from standard input when standard
232 input is a tty. In most cases attempting to read the public key
233 from standard input that is a tty indicates that the public key
234 was accidentally omitted. If that is not the case, the -t option
235 must be given to allow reading the public key from standard input
236 when standard input is a tty. This option is always implied if
237 the --in option is used with a value other than "-".
239 --digest name
240 Select the digest to use in the generated certificate. Must be
241 one of sha1, sha224, sha256, sha384 or sha512. By default sha256
242 will be used if available otherwise sha1 will be used (and a
243 warning issued). All systems support sha1 digest certificates,
244 but sha1 should really not be used anymore (see NIST
245 recommendation SP 800-131A). OpenSSL starting with version 0.9.8
246 (released 2005-07-05) supports the SHA-2 family of hash functions
247 (sha224, sha256, sha384 and sha512) which should be used instead
248 of sha1. Note that either Digest::SHA or Digest::SHA::PurePerl
249 must be available to use sha224, sha256, sha384 or sha512.
251 --root
252 --subca
253 --server
254 --codesign
255 --applecodesign
256 --email
257 --client
258 Select the type of certificate to generate. If --root is given
259 then a root certificate will be created and any --cert option will
260 be ignored as well as standard input. If none of these options is
261 given then --client will be assumed. Both --root and --subca
262 generate certificate authority certificates (CA:TRUE).
263 Specifying any of --root, --subca, --server, --codesign or
264 --applecodesign will cause the "name string" to be embedded as
265 a commonName (CN). Otherwise if --email is specified
266 "name string" will be embedded as an emailAddress (and a subject
267 alternative name email type). Finally if none of those apply then
268 "name string" will be embedded as a userId (UID) instead
269 (client certificates). The certificate's key usage bits will be
270 set to one of four values. --root or --subca select the first,
271 --server selects the second, --email selects the third otherwise
272 the fourth is used. If any of --server, --client (explicit or
273 implied), --codesign, --email or --applecodesign are given then
274 extended key usage items will be included (up to five -- one for
275 each option given).
277 --acme
278 Giving this option causes most of the other options to be ignored.
279 A unique "Acme" root certificate will be created and output each
280 CACreateCert is run with this option. The only required option
281 is --key when generating an "Acme" certificate.
283 --pathlen n
284 The --pathlen option will be ignored unless --subca is given in
285 which case the X509v3 Basic Constraints will include the
286 specified pathlen value.
288 --rootauth
289 Ignored unless --root given. Normally --root certificates do not
290 include an X509v3 Authority Key Identifier. If this option is
291 given then they will (with only a keyid value).
293 --authext
294 Ignored if --root given. Normally non --root certificates include
295 an X509v3 Authority Key Identifier section with only a keyid
296 value. If this option is given, then the name and serial number
297 will also be included.
299 --random
300 Use a random serial number instead of one determined by the actual
301 contents of the certificate. When generating a --root certificate
302 the issuer name will also include a serialNumber attribute as the
303 first item followed by the "name string" value (as the CN
304 attribute). This can be modified by use of one or more --dni
305 options and if a --dni serialNumber=# option is used then the '#'
306 will be replaced by the actual serial number generated and in the
307 case of a --root certificate the extra serialNumber attribute at
308 the beginning of the issuer name will be suppressed. Only one
309 --dni serialNumber=# is allowed and it must be non-multivalued.
310 Use of this option will preclude production of byte-exact matching
311 output certificates for the same input arguments. This is now the
312 default when --root is given. Roughly equivalent to adding a
313 --dni serialNumber=randomvalue option BEFORE any other --dni
314 options and then using --no-random.
316 --no-random
317 Ignored unless --root given. Turns off the default --random
318 option that is normally enabled by default when --root is given.
320 --key priv_key_file
321 The RSA private key in either PEM or DER format. This option
322 is always required.
324 --cert signing_cert
325 Ignored if --root is given. The signing X.509 certificate in
326 either PEM or DER format. The public key embedded in signing_cert
327 must match the one in the priv_key_file or an error will occur.
329 --in pub_key_file
330 Ignored if --root is given. The public key for the certificate
331 to be created. Must be different than the public key contained in
332 priv_key_file. May be an OpenSSH protocol 2 format RSA public key
333 or an X.509 format public key (in either PEM or DER format). See
334 also the --pubx509 option. If pub_key_file is "-" or this option
335 is omitted then standard input is read.
337 --out out_cert.pem
338 The generated certificate will be written to out_cert.pem. If
339 this option is omitted or out_cert.pem is "-" then the generated
340 certificate is written to standard output.
342 --suffix suffix.pem
343 Primarily intended to be used when generating client certificates,
344 if this option is given, then the entire contents of suffix.pem is
345 written to the same location as the generated certificate
346 immediately following the certificate. This option may be given
347 more than once in which case the files will be appended to the
348 output in the order the --suffix options were given. See the
349 NOTES section below for relevant information on use of --suffix.
351 --dni [+]key=value | \@filename
352 Add distinguished name information. This option may be repeated
353 multiple times as desired. Key is either the name of an OID
354 attribute to add or a dotted OID number. Recognized names may be
355 listed with the --list-oid-names option. Value is a string value
356 to assign to the key. Whitespace before and after as well as any
357 surrounding the '+' and '=' is completely ignored. If a '+' is
358 prefixed to the key, the value will be combined with the previous
359 --dni item to make it multi-valued. The '+' prefix requires at
360 least one previous --dni item that does NOT have a '+' prefix.
361 Instead of '[+]key=value', '\@filename' may be used instead. If
362 filename is '-' then standard input will be read provided it is
363 not already being used to read the public key. The 'filename'
364 must contain one --dni directive per line (with the '--dni' part
365 omitted). Blank lines and lines with the first non-blank
366 character a '#' are ignored. The directives in the file are
367 processed exactly as though they each appeared as a command line
368 '--dni' option in the order they appear in the file. See also
369 description for --random option.
371 --no-max-len
372 Ignore any maximum length limits on most --dni values. A warning
373 will still be issued unless --quiet is also used.
375 --dns domain-name-or-ip
376 Ignored unless --server given. Adds the given domain-name-or-ip
377 as a subject alternative name (either DNS or IPAddress). May
378 be repeated to add multiple alternative names. A DNS name must
379 satisfy RFC 1034 section 3.5 as modified by RFC 1123 section 2.1
380 except that the leftmost label may be the single character '*'.
381 An IP address may be either IPv4 or IPv6 (do NOT use surrounding
382 '[', ']' characters on an IPv6 address). An IPv6 address MUST NOT
383 have a scope identifier. Note that when --server is given, the
384 common name (CN) value is NOT automatically added as a subject
385 alternative name -- it must be specified explicitly with a --dns
386 option if that is desired (and normally it IS desirable).
388 --dnq qual
389 Optional for all certificate types. If given must not be the
390 empty string. Will be embedded into the subject's distinguished
391 name as the final component. Use of this option is not
392 recommended when using --server or --email. The value must be
393 a PrintableString (needs to match [A-Za-z0-9 '()+,./:=?-]+).
394 Equivalent to adding a --dni dnQualifier=qual option after any
395 other --dni options except that it is also placed AFTER any
396 "name string" value as well.
398 name string
399 The name to embed in the certificate as the subject. This will
400 be embedded as a common name (CN) except when --client is in
401 effect in which case it will be embedded as a user id (UID) or
402 when --email is in effect in which case it will be embedded as
403 an email address in both the subject and subject alternative name.
404 The "name string" value may never be omitted but may be explictly
405 given as the empty string ('' or "") when generating a root
406 certificate using a random serial number or when the distinguished
407 name attribute key that would be embedded (e.g. CN or UID) has
408 already had a value specified using a --dni option AND the
409 --email option has NOT been given. The name string is ignored,
410 if present, when --acme is used.
412 NOTES
413 All systems support sha1 digest certificates, but sha1 should really not
414 be used anymore (NIST recommendation SP 800-131A). OpenSSL starting
415 with versions 0.9.8 (released 2005-07-05) supports the SHA-2 family of
416 hash functions (sha224, sha256, sha384 and sha512) which should be used
417 instead.
419 NIST SP 800-131A requires use of an RSA key with 2048 or more bits and
420 a hash function with 224 or more bits after December 31 2010.
422 RFC 6194 states sha256 is the most commonly used alternative to sha1
423 (and will be used by default if a suitable SHA module is available).
425 Note that NIST SP 800-78-3 requires RSA public key exponents to be
426 greater than or equal to 65537. OpenSSH version 5.4 and later generate
427 RSA keys with a public exponent of 65537 otherwise openssl genrsa can
428 be used together with ssh-keygen -y to create a suitable OpenSSH key that
429 uses an exponent of 65537 instead of 35.
431 A client attempting to authenticate a server and following the rules in
432 RFC 6125 will COMPLETELY IGNORE the value given for a server certificate's
433 common name (CN) if any alternative name DNS values are present. Although
434 that standard does not discuss IP alternative names, the user of this
435 utility is strongly advised to include the value from the server's CN
436 as one of the --dns values given if ANY --dns values are given.
438 Using an IPv6 address as a --dns value will not interfere with the
439 correct working of an IPv4 address and/or DNS name as a --dns value, but
440 some older clients do not seem to reliably support checking IPv6 address
441 alternative name values so do not rely on them actually working
442 everywhere in practice. The problematic clients stubbornly insist there
443 is a host name mismatch.
445 Link-local IPv6 addresses are unlikely to work since there's no way to
446 embed a scope value (and client support for a scope specifier is rare).
447 However, some platforms (i.e. Darwin) allow the scope number to be
448 embedded as octets 2 and 3 so that address FE80::... with a scope_id
449 value of 5 can be represented as FE80:5::... instead. Of course the
450 correct scope_id value is host-specific, so a range of possibilities
451 would have to be included although since the loopback interface is
452 almost always scope_id 1 that one can be skipped. Current versions
453 of the cURL command line utility DO actually correctly handle scope
454 ids as described in RFC 6874, correctly stripping off the zone value
455 from the host name included in the 'Host:' HTTP header.
457 The TLS (Transport Layer Security -- also sometimes referred to by the
458 previous standard's name, SSL [Secure Sockets Layer]) requires the peer
459 (either the server when the client is authenticating it or the client
460 when the server is authenticating it if client certificates are in use)
461 to supply the ENTIRE certificate chain in order from the leaf
462 certificate (that identifies the peer) on up through and INCLUDING the
463 root certificate (also known as the certificate authority). Reference
464 RFC 5246 section 7.4.2 and the description of "certificate_list". But
465 there is an exception listed, you MAY omit the last certificate (aka the
466 "root" certificate, "certificate authority" certificate or "self-signed"
467 certificate) under the assumption that the peer already has that or it
468 would not be able to decide whether or not to trust the certificate
469 even if it turns out to be a valid one. What this means is that if you
470 are generating a client certificate and the client certificate's issuer
471 is not the root certificate for the chain, then you should probably add
472 the --suffix <path_to_issuer_cert> option for its issuer and if the
473 issuer's issuer is not the root certificate, add another --suffix option
474 and so on until the issuer of the certificate listed with the final
475 --suffix option is the root certificate (you may also go ahead and
476 include one more --suffix option for the root certificate but it's
477 likely unnecessary since the server should have that).
479 TIPS
480 Display the currently available version of OpenSSL with:
482 openssl version
484 Display the currently available version of OpenSSH with:
486 ssh -V
488 EXAMPLES
489 Valid certificate chains always must contain at least two certificates,
490 the leaf certificate and the root certificate. There may be additional
491 intermediate certificates in the chain between them.
493 Here's an example of how to quickly create a valid web server
494 certificate chain for an 'example.com' web server:
496 1. Create a root certificate key:
498 openssl genrsa -f4 -out root_key.pem 3072
500 2. Generate a server certificate key and extract its public key:
502 openssl genrsa -f4 -out server_key.pem 3072
503 openssl rsa -in server_key.pem -pubout -out server_key_pub.pem
505 3. Generate an Acme root certificate:
507 CACreateCert --acme --key root_key.pem --out root_cert.pem
509 4. Generate a server certificate for 'example.com':
511 CACreateCert --server --key root_key.pem --cert root_cert.pem \
512 --in server_key_pub.pem --out server_cert.pem "example.com"
514 Optionally add one or more --dns and/or --dni options when generating
515 the --server certificate.
517 To configure a web server to serve 'example.com' over https the
518 root_cert.pem, server_cert.pem and server_key.pem files will be needed.
520 Clients connecting to 'example.com' over https will get an untrusted
521 root certificate error unless they trust root_cert.pem as a certificate
522 authority or otherwise add an exception.
524 BUGS
525 The ability to create self-signed types other than --root by combining
526 the --root option with one of the others (e.g. --client, --email,
527 --codesign, --server) is poorly documented. Furthermore, since the
528 standard (see RFC 5280) effectively requires at least two certificates
529 in a valid certificate chain since a chain must have a non-root leaf
530 to be valid.
532 DSA is not supported even though it is possible to create a valid
533 certificate that uses dsaWithSHA1. But since SHA-1 should not be used
534 any longer after 2010-12-31 (NIST SP 800-131A) it's no big loss. And
535 there do not seem to be any identifiers available for DSA with longer
536 hash algorithms anyway.
538 The ability to sign using whirlpool, which requires use of an unofficial
539 OID (1.2.840.113549.1.1.15) should, perhaps, not be allowed.
541 HELP
544 sub IsUTF8($)
546 # Return 0 if non-UTF-8 sequences present
547 # Return -1 if no characters > 0x7F found
548 # Return 1 if valid UTF-8 sequences present
549 use bytes;
550 return -1 if $_[0] !~ /[\x80-\xFF]/so;
551 my $l = length($_[0]);
552 for (my $i=0; $i<$l; ++$i) {
553 my $c = ord(substr($_[0],$i,1));
554 next if $c < 0x80;
555 return 0 if $c < 0xC0 || $c >= 0xF8;
556 if ($c <= 0xDF) {
557 # Need 1 more byte
558 ++$i;
559 return 0 if $i >= $l;
560 my $c2 = ord(substr($_[0],$i,1));
561 return 0 if $c2 < 0x80 || $c2 > 0xBF;
562 my $u = (($c & 0x1F) << 6) | ($c2 & 0x3F);
563 return 0 if $u < 0x80;
564 next;
566 if ($c <= 0xEF) {
567 # Need 2 more bytes
568 $i += 2;
569 return 0 if $i >= $l;
570 my $c2 = ord(substr($_[0],$i-1,1));
571 return 0 if $c2 < 0x80 || $c2 > 0xBF;
572 my $c3 = ord(substr($_[0],$i,1));
573 return 0 if $c3 < 0x80 || $c3 > 0xBF;
574 my $u = (($c & 0x0F) << 12) | (($c2 & 0x3F) << 6) | ($c3 & 0x3F);
575 return 0 if $u < 0x800 || ($u >= 0xD800 && $u <= 0xDFFFF) || $u >= 0xFFFE;
576 next;
578 # Need 3 more bytes
579 $i += 3;
580 return 0 if $i >= $l;
581 my $c2 = ord(substr($_[0],$i-2,1));
582 return 0 if $c2 < 0x80 || $c2 > 0xBF;
583 my $c3 = ord(substr($_[0],$i-1,1));
584 return 0 if $c3 < 0x80 || $c3 > 0xBF;
585 my $c4 = ord(substr($_[0],$i,1));
586 return 0 if $c4 < 0x80 || $c4 > 0xBF;
587 my $u = (($c & 0x07) << 18) | (($c2 & 0x3F) << 12) | (($c3 & 0x3F) << 6)
588 | ($c4 & 0x3F);
589 return 0 if $u < 0x10000 || $u >= 0x10FFFE || (($u & 0xFFFF) >= 0xFFFE);
591 return 1;
594 sub Make1252()
596 use bytes;
597 our %W1252;
599 # Provide translations for 0x80-0x9F into UTF-8
600 $W1252{0x80} = pack('H*','E282AC'); # 0x20AC Euro
601 $W1252{0x82} = pack('H*','E2809A'); # 0X201A Single Low-9 Quote
602 $W1252{0x83} = pack('H*','C692'); # 0x0192 Latin Small Letter f With Hook
603 $W1252{0x84} = pack('H*','E2809E'); # 0x201E Double Low-9 Quote
604 $W1252{0x85} = pack('H*','E280A6'); # 0x2026 Horizontal Ellipsis
605 $W1252{0x86} = pack('H*','E280A0'); # 0x2020 Dagger
606 $W1252{0x87} = pack('H*','E280A1'); # 0x2021 Double Dagger
607 $W1252{0x88} = pack('H*','CB86'); # 0x02C6 Modifier Letter Circumflex Accent
608 $W1252{0x89} = pack('H*','E28080'); # 0x2030 Per Mille Sign
609 $W1252{0x8A} = pack('H*','C5A0'); # 0x0160 Latin Capital Letter S With Caron
610 $W1252{0x8B} = pack('H*','E28089'); # 0x2039 Left Single Angle Quote
611 $W1252{0x8C} = pack('H*','C592'); # 0x0152 Latin Capital Ligature OE
612 $W1252{0x8E} = pack('H*','C5BD'); # 0x017D Latin Capital Letter Z With Caron
613 $W1252{0x91} = pack('H*','E28098'); # 0x2018 Left Single Quote
614 $W1252{0x92} = pack('H*','E28099'); # 0x2019 Right Single Quote
615 $W1252{0x93} = pack('H*','E2809C'); # 0x201C Left Double Quote
616 $W1252{0x94} = pack('H*','E2809D'); # 0x201D Right Double Quote
617 $W1252{0x95} = pack('H*','E280A2'); # 0x2022 Bullet
618 $W1252{0x96} = pack('H*','E28093'); # 0x2013 En Dash
619 $W1252{0x97} = pack('H*','E28094'); # 0x2014 Em Dash
620 $W1252{0x98} = pack('H*','CB9C'); # 0x02DC Small Tilde
621 $W1252{0x99} = pack('H*','E284A2'); # 0x2122 Trade Mark Sign
622 $W1252{0x9A} = pack('H*','C5A1'); # 0x0161 Latin Small Letter s With Caron
623 $W1252{0x9B} = pack('H*','E2808A'); # 0x203A Right Single Angle Quote
624 $W1252{0x9C} = pack('H*','C593'); # 0x0153 Latin Small Ligature oe
625 $W1252{0x9E} = pack('H*','C5BE'); # 0x017E Latin Small Letter z With Caron
626 $W1252{0x9F} = pack('H*','C5B8'); # 0x0178 Latin Cap Letter Y With Diaeresis
629 sub MakeUTF8($)
631 use bytes;
632 our %W1252;
634 return $_[0] if (IsUTF8($_[0]));
635 my $ans = '';
636 foreach my $c (unpack('C*',$_[0])) {
637 if ($c < 0x80) {
638 $ans .= chr($c);
640 else {
641 # Ass/u/me we have Latin-1 (ISO-8859-1) but per the HTML 5 draft treat
642 # it as windows-1252
643 if ($c >= 0xA0 || !defined($W1252{$c})) {
644 $ans .= chr(0xC0 | ($c >> 6));
645 $ans .= chr(0x80 | ($c & 0x3F));
647 else {
648 $ans .= $W1252{$c};
652 return $ans;
655 sub formatbold($;$)
657 my $str = shift;
658 my $fancy = shift || 0;
659 if ($fancy) {
660 $str = join('',map($_."\b".$_, split(//,$str)));
662 return $str;
665 sub formatul($;$)
667 my $str = shift;
668 my $fancy = shift || 0;
669 if ($fancy) {
670 $str = join('',map("_\b".$_, split(//,$str)));
672 return $str;
675 sub formatman($;$)
677 my $man = shift;
678 my $fancy = shift || 0;
679 my @inlines = split(/\n/, $man, -1);
680 my @outlines = ();
681 foreach my $line (@inlines) {
682 if ($line =~ /^[A-Z]+$/) {
683 $line = formatbold($line, $fancy);
685 else {
686 $line =~ s/'''(.+?)'''/formatbold($1,$fancy)/gse;
687 $line =~ s/''(.+?)''/formatul($1,$fancy)/gse;
689 push (@outlines, $line);
691 my $result = join("\n", @outlines);
692 $result =~ s/\\\n//gso;
693 return $result;
696 my %oidnames;
697 my %knownoids;
698 my %oidstringtypes;
699 my %oidstringlengths;
700 my %oidstringrestrictions;
701 my $oidnamelist;
703 BEGIN {
704 my %oiddata = (
705 'commonName' => '2.5.4.3',
706 'CN' => '2.5.4.3',
707 'surname' => '2.5.4.4',
708 'SN' => '2.5.4.4',
709 'serialNumber' => '2.5.4.5',
710 'serial' => '2.5.4.5',
711 'countryName' => '2.5.4.6',
712 'C' => '2.5.4.6',
713 'localityName' => '2.5.4.7',
714 'L' => '2.5.4.7',
715 'stateOrProvinceName' => '2.5.4.8',
716 'ST' => '2.5.4.8',
717 'streetAddress' => '2.5.4.9',
718 'street' => '2.5.4.9',
719 'organizationName' => '2.5.4.10',
720 'O' => '2.5.4.10',
721 'organizationalUnitName' => '2.5.4.11',
722 'OU' => '2.5.4.11',
723 'title' => '2.5.4.12',
724 'description' => '2.5.4.13',
725 'businessCategory' => '2.5.4.15',
726 'postalCode' => '2.5.4.17',
727 'telephoneNumber' => '2.5.4.20',
728 'facsimileTelephoneNumber' => '2.5.4.23',
729 'givenName' => '2.5.4.42',
730 'GN' => '2.5.4.42',
731 'initials' => '2.5.4.43',
732 'generationQualifier' => '2.5.4.44',
733 'dnQualifier' => '2.5.4.46',
734 'pseudonym' => '2.5.4.65',
735 'organizationIdentifier' => '2.5.4.97',
736 'userId' => '0.9.2342.19200300.100.1.1',
737 'UID' => '0.9.2342.19200300.100.1.1',
738 'domainComponent' => '0.9.2342.19200300.100.1.25',
739 'DC' => '0.9.2342.19200300.100.1.25',
740 'emailAddress' => '1.2.840.113549.1.9.1',
741 'jurisdictionOfIncorporationLocalityName'=> '1.3.6.1.4.1.311.60.2.1.1',
742 'jurisdictionOfIncorporationLocality'=> '1.3.6.1.4.1.311.60.2.1.1',
743 'jurisdictionOfIncorporationStateOrProvinceName'=> '1.3.6.1.4.1.311.60.2.1.2',
744 'jurisdictionOfIncorporationStateOrProvince'=> '1.3.6.1.4.1.311.60.2.1.2',
745 'jurisdictionOfIncorporationCountryName'=> '1.3.6.1.4.1.311.60.2.1.3',
746 'jurisdictionOfIncorporationCountry'=> '1.3.6.1.4.1.311.60.2.1.3',
748 # Some extra help here for those last long ones and some obvious abbreviations
749 'joiL' => '1.3.6.1.4.1.311.60.2.1.1',
750 'joiST' => '1.3.6.1.4.1.311.60.2.1.2',
751 'joiC' => '1.3.6.1.4.1.311.60.2.1.3',
752 'country' => '2.5.4.6',
753 'city' => '2.5.4.7',
754 'locality' => '2.5.4.7',
755 'state' => '2.5.4.8',
756 'province' => '2.5.4.8',
757 'stateOrProvince' => '2.5.4.8',
758 'organization' => '2.5.4.10',
759 'organizationalUnit' => '2.5.4.11',
760 'zip' => '2.5.4.17',
761 'zipCode' => '2.5.4.17',
762 'phone' => '2.5.4.20',
763 'phoneNumber' => '2.5.4.20',
764 'fax' => '2.5.4.23',
765 'faxNumber' => '2.5.4.23',
766 'DNQ' => '2.5.4.46',
767 'email' => '1.2.840.113549.1.9.1'
769 # p => PrintableString, i => IA5String, u => UTF8String
770 # If not listed prefer PrintableString if compatible otherwise UTF8String
771 %oidstringtypes = (
772 '2.5.4.5' => 'p', # serialNumber
773 '2.5.4.6' => 'p', # countryName
774 '2.5.4.46' => 'p', # dnQualifier
775 '1.2.840.113549.1.9.1' => 'i', # emailAddress
776 '0.9.2342.19200300.100.1.25' => 'i' # domainComponent
778 # Exact number of characters required if single number "n"
779 # Minimum number of characters required if "n,"
780 # Maximum number of characters if ",n"
781 # Minimum and maximum number of characters if "n,m"
782 %oidstringlengths = (
783 '2.5.4.3' => ',64', # commonName
784 '2.5.4.4' => ',40', # surname
785 '2.5.4.5' => ',64', # serialNumber
786 '2.5.4.6' => 2 , # countryName
787 '2.5.4.7' => ',128', # localityName
788 '2.5.4.8' => ',128', # stateOrProvinceName
789 '2.5.4.9' => ',30', # streetAddress
790 '2.5.4.10' => ',64', # organizationName
791 '2.5.4.11' => ',32', # organizationUnitName
792 '2.5.4.12' => ',64', # title
793 '2.5.4.17' => ',16', # postalCode
794 '2.5.4.42' => ',16', # givenName
795 '2.5.4.43' => ',5', # initials
796 '2.5.4.44' => ',3', # generationQualifier
797 '2.5.4.65' => ',128', # pseudonym
798 '1.2.840.113549.1.9.1' => ',255' # emailAddress
800 # 'e' => must be an email address, 'd' => must be a domain name label
801 # 'c' => must be ISO 3166 2-character country code (2 'A'-'Z' will do)
802 %oidstringrestrictions = (
803 '2.5.4.6' => 'c', # 2-character country code
804 '1.2.840.113549.1.9.1' => 'e', # emailAddress RFC 5280 4.2.1.6 rfc822Name
805 # See 'Mailbox' Section 4.1.2 of RFC 2821
806 '0.9.2342.19200300.100.1.25' => 'd' # domainComponent RFC 4519
808 my %aliases = ();
809 my $maxlen = 0;
810 %oidnames = ();
811 %knownoids = ();
812 foreach my $key (keys(%oiddata)) {
813 my $l = length($key);
814 $maxlen = $l if $l > $maxlen;
815 my $value = $oiddata{$key};
816 $knownoids{$value} = 1;
817 $oidnames{lc($key)} = $value;
818 my $nlist = $aliases{$value};
819 $nlist = [], $aliases{$value} = $nlist unless $nlist;
820 push(@$nlist, $key);
822 my @list = ();
823 foreach my $oid (keys(%aliases)) {
824 my $aliases = $aliases{$oid};
825 my @sorted = sort({length($b) <=> length($a)} @$aliases);
826 my $canon = shift(@sorted);
827 push(@list, sprintf('%-*s = %s', $maxlen, $canon, $oid));
828 foreach my $alias (@sorted) {
829 push(@list, sprintf('%-*s -> %s', $maxlen, $alias, $canon));
832 $oidnamelist = join('', map("$_\n", sort({lc($a) cmp lc($b)} @list)));
835 sub DERLength($)
837 # return a DER encoded length
838 my $len = shift;
839 return pack('C',$len) if $len <= 127;
840 return pack('C2',0x81, $len) if $len <= 255;
841 return pack('Cn',0x82, $len) if $len <= 65535;
842 return pack('CCn',0x83, ($len >> 16), $len & 0xFFFF) if $len <= 16777215;
843 # Silently returns invalid result if $len > 2^32-1
844 return pack('CN',0x84, $len);
847 sub SingleOID($)
849 # return a single DER encoded OID component
850 no warnings;
851 my $num = shift;
852 $num += 0;
853 my $result = pack('C', $num & 0x7F);
854 $num >>= 7;
855 while ($num) {
856 $result = pack('C', 0x80 | ($num & 0x7F)) . $result;
857 $num >>= 7;
859 return $result;
862 sub DEROID($)
864 # return a DER encoded OID complete with leading 0x06 and DER length
865 # Input is a string of decimal numbers separated by '.' with at least
866 # two numbers required.
867 no warnings;
868 my @ids = split(/[.]/,$_[0]);
869 push(@ids, 0) while @ids < 2; # return something that's kind of valid
870 unshift(@ids, shift(@ids) * 40 + shift(@ids)); # combine first two
871 my $ans = '';
872 foreach my $num (@ids) {
873 $ans .= SingleOID($num);
875 return pack('C',0x6).DERLength(length($ans)).$ans;
878 sub DERTime($)
880 my $t = shift; # a time() value
881 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t);
882 $year += 1900;
883 ++$mon;
884 my $tag;
885 my $tstr;
886 if (1950 <= $year && $year < 2050) {
887 # UTCTime
888 $tag = 0x17;
889 $tstr = sprintf("%02d%02d%02d%02d%02d%02dZ", $year % 100, $mon, $mday,
890 $hour, $min, $sec);
892 else {
893 # GeneralizedTime
894 $tag = 0x18;
895 $tstr = sprintf("%04d%02d%02d%02d%02d%02dZ", $year, $mon, $mday,
896 $hour, $min, $sec);
898 return pack('C',$tag).DERLength(length($tstr)).$tstr;
901 sub DERInteger($)
903 my $int = shift; # an integer value, may be negative
904 my @bytes = unpack('C*',pack('N',$int));
905 shift @bytes while @bytes >= 2 && $bytes[0] == 255 && ($bytes[1] & 0x80);
906 shift @bytes while @bytes >= 2 && $bytes[0] == 0 && !($bytes[1] & 0x80);
907 return pack('C*',0x02,scalar(@bytes),@bytes);
910 sub RandomID(;$)
912 # return 20 random bytes except that the first byte has its high bit clear
913 my $suppress = shift || 0;
914 print STDERR "Generating serial number, please wait...\n" unless $suppress;
915 my $randfile = "/dev/random";
916 $randfile = "/dev/urandom" if -e "/dev/urandom";
917 open(RANDIN, "<", $randfile)
918 or die "Cannot open $randfile for input: $!\n";
919 my $result = '';
920 for (my $cnt = 0; $cnt < 20; ++$cnt) {
921 my $byte;
922 sysread(RANDIN, $byte, 1)
923 or die "Cannot read from $randfile: $!\n";
924 if (!$cnt) {
925 my $val = unpack('C', $byte);
926 $val &= 0x7F;
927 $byte = pack('C', $val);
929 $result .= $byte;
931 close(RANDIN);
932 print STDERR "...done creating serial number.\n" unless $suppress;
933 return $result;
936 sub ReadDERLength($)
938 # Input is a DER encoded length with possibly extra trailing bytes
939 # Output is an array of length and bytes-used-for-encoded-length
940 my $der = shift;
941 return undef unless length($der);
942 my $byte = unpack('C',substr($der,0,1));
943 return ($byte, 1) if $byte <= 127;
944 return undef if $byte == 128 || $byte > 128+8; # Fail if greater than 2^64
945 my $cnt = $byte & 0x7F;
946 return undef unless length($der) >= $cnt+1; # Fail if not enough bytes
947 my $val = 0;
948 for (my $i = 0; $i < $cnt; ++$i) {
949 $val <<= 8;
950 $val |= unpack('C',substr($der,$i+1,1));
952 return ($val, $cnt+1);
955 sub DERTimeStr($)
957 my $der = shift;
958 return undef unless length($der) >= 2;
959 my $byte = unpack('C',substr($der,0,1));
960 return undef unless $byte == 0x17 || $byte == 0x18;
961 my ($len, $lenbytes) = ReadDERLength(substr($der,1));
962 return undef unless length($der) == 1 + $lenbytes + $len;
963 return undef
964 unless ($byte == 0x17 && $len == 13) || ($byte == 0x18 && $len == 15);
965 substr($der,0,1+$lenbytes) = '';
966 if ($byte == 0x17) {
967 no warnings;
968 my $year = substr($der,0,2) + 1900;
969 $year += 100 if $year < 1950;
970 $der = sprintf("%04d",$year).substr($der,2);
972 return substr($der,0,4).'-'.substr($der,4,2).'-'.substr($der,6,2).'_'.
973 substr($der,8,2).':'.substr($der,10,2).':'.substr($der,12,3);
976 sub GetOpenSSHKeyInfo($)
978 # Input is an OpenSSH public key in .pub format
979 # Output is an array of:
980 # how many bits in the modulus
981 # the public exponent
982 # the key id
983 # the OpenSSH md5 fingerprint
984 # the OpenSSH sha1 fingerprint
985 # the OpenSSH comment (may be '')
986 # the OpenSSH public key in OpenSSL PUBLIC KEY DER format
987 # or undef if the key is unparseable
988 # or just the key type if it's not ssh-rsa
990 # Expected format is:
991 # ssh-rsa BASE64PUBLICKEYDATA optional comment here
992 # where the BASE64PUBLICKEYDATA when decoded produces:
993 # 4 Byte Big-Endian length of Key type (must be 7 for RSA)
994 # Key type WITHOUT terminating NUL (must be ssh-rsa for RSA)
995 # 4 Byte Big-Endian length of public exponent
996 # Public exponent integer bytes
997 # 4 Byte Big-Endian length of modulus
998 # Modulus integer bytes
999 # no extra trailing bytes are permitted
1000 my $input = shift;
1001 $input =~ s/((?:\r\n|\n|\r).*)$//os;
1002 my @fields = split(' ', $input, 3);
1003 return undef unless @fields >= 2;
1004 my $data = decode_base64($fields[1]);
1005 my $origData = $data;
1006 my @parts = ();
1007 while (length($data) >= 4) {
1008 my $len = unpack('N',substr($data,0,4));
1009 my $value = '';
1010 if ($len > 0) {
1011 return undef if $len + 4 > length($data);
1012 $value = substr($data,4,$len);
1014 push(@parts, $value);
1015 substr($data, 0, 4+$len) = '';
1017 return undef unless length($data) == 0;
1018 return $parts[0]
1019 if @parts >= 1 && defined($parts[0]) && $parts[0] && $parts[0] ne 'ssh-rsa';
1020 return undef unless @parts == 3;
1022 my $rsaEncryption = DEROID('1.2.840.113549.1.1.1'); # :rsaEncryption
1023 $rsaEncryption = pack('C',0x30).DERLength(length($rsaEncryption)+2)
1024 .$rsaEncryption.pack('C2',0x05,0x00);
1025 my $pubrsa = pack('C',0x2).DERLength(length($parts[2])).$parts[2]; # modulus
1026 $pubrsa .= pack('C',0x2).DERLength(length($parts[1])).$parts[1]; # exponent
1027 $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
1028 my $id = sha1($pubrsa); # The id is the sha1 hash of the private key part
1029 $pubrsa = pack('C',0x3).DERLength(length($pubrsa)+1).pack('C',0x0).$pubrsa;
1030 $pubrsa = $rsaEncryption.$pubrsa;
1031 $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
1033 my $bits = length($parts[2]) * 8;
1034 # But we have to discount any leading 0 bits in the first byte
1035 my $byte = unpack('C',substr($parts[2],0,1));
1036 if (!$byte) {
1037 $bits -= 8;
1039 else {
1040 return undef if $byte & 0x80; # negative modulus is not allowed
1041 while (!($byte & 0x80)) {
1042 --$bits;
1043 $byte <<= 1;
1047 my $rawexp = $parts[1];
1048 my $exp;
1049 if (length($rawexp) > 8) {
1050 # Fudge the result because it's bigger than a 64-bit number
1051 my $lastbyte = unpack('C',substr($rawexp,-1,1));
1052 $exp = $lastbyte & 0x01 ? 65537 : 65536;
1054 else {
1055 $exp = 0;
1056 while (length($rawexp)) {
1057 $exp <<= 8;
1058 $exp |= unpack('C',substr($rawexp,0,1));
1059 substr($rawexp,0,1) = '';
1063 return ($bits,$exp,$id,md5($origData),sha1($origData),$fields[2]||'',$pubrsa);
1066 sub GetKeyInfo($)
1068 # Input is an RSA PRIVATE KEY in DER format
1069 # Output is an array of:
1070 # how many bits in the modulus
1071 # the public exponent
1072 # the key id
1073 # the OpenSSH md5 fingerprint
1074 # the OpenSSH sha1 fingerprint
1075 # or undef if the key is unparseable
1077 # Expected format is:
1078 # SEQUENCE {
1079 # SEQUENCE {
1080 # OBJECT IDENTIFIER :rsaEncryption = 1.2.840.113549.1.1.1
1081 # NULL
1083 # BIT STRING (primitive) {
1084 # 0 unused bits
1085 # SEQUENCE { # this part is the contents of an "RSA PUBLIC KEY" file
1086 # INTEGER modulus
1087 # INTEGER publicExponent
1092 no warnings;
1093 my $der = shift;
1094 my $rawmod;
1095 my $rawexp;
1097 return undef if unpack('C',substr($der,0,1)) != 0x30;
1098 my ($len, $lenbytes) = ReadDERLength(substr($der,1));
1099 return undef unless length($der) == 1 + $lenbytes + $len;
1100 substr($der, 0, 1 + $lenbytes) = '';
1102 # the algorithm part always encodes as 30 0d 06092a864886f70d010101 0500
1103 return undef
1104 unless substr($der, 0, 15) = pack('H*',"300d06092a864886f70d0101010500");
1105 substr($der, 0, 15) = '';
1107 return undef if unpack('C',substr($der,0,1)) != 0x03;
1108 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1109 return undef unless length($der) == 1 + $lenbytes + $len && $len >= 1;
1110 return undef unless unpack('C',substr($der, 1 + $lenbytes, 1)) == 0x00;
1111 substr($der, 0, 1 + $lenbytes + 1) = '';
1113 return undef if unpack('C',substr($der,0,1)) != 0x30;
1114 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1115 return undef unless length($der) == 1 + $lenbytes + $len;
1116 my $id = sha1($der); # The id is the sha1 hash of the private key part
1117 substr($der, 0, 1 + $lenbytes) = '';
1119 return undef if unpack('C',substr($der,0,1)) != 0x02;
1120 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1121 substr($der, 0, 1 + $lenbytes) = '';
1122 my $derexp = substr($der, $len);
1123 substr($der, $len) = '';
1124 return undef unless $len >= 1;
1125 $rawmod = $der;
1126 my $bits = length($der) * 8;
1127 # But we have to discount any leading 0 bits in the first byte
1128 my $byte = unpack('C',substr($der,0,1));
1129 if (!$byte) {
1130 $bits -= 8;
1132 else {
1133 return undef if $byte & 0x80; # negative modulus is not allowed
1134 while (!($byte & 0x80)) {
1135 --$bits;
1136 $byte <<= 1;
1140 $der = $derexp;
1141 return undef if unpack('C',substr($der,0,1)) != 0x02;
1142 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1143 substr($der, 0, 1 + $lenbytes) = '';
1144 return undef unless length($der) == $len && $len >= 1;
1145 return undef if unpack('C',substr($der,0,1)) & 0x80; # negative pub exp bad
1146 $rawexp = $der;
1147 my $exp;
1148 if ($len > 8) {
1149 # Fudge the result because it's bigger than a 64-bit number
1150 my $lastbyte = unpack('C',substr($der,-1,1));
1151 $exp = $lastbyte & 0x01 ? 65537 : 65536;
1153 else {
1154 $exp = 0;
1155 while (length($der)) {
1156 $exp <<= 8;
1157 $exp |= unpack('C',substr($der,0,1));
1158 substr($der,0,1) = '';
1162 my $tohash = pack('N',7)."ssh-rsa".pack('N',length($rawexp)).$rawexp
1163 .pack('N',length($rawmod)).$rawmod;
1165 return ($bits,$exp,$id,md5($tohash),sha1($tohash));
1168 sub GetCertInfo($)
1170 # Input is an X.509 "Certificate" (RFC 5280) in DER format
1171 # Output is an array of:
1172 # version (1, 2, or 3)
1173 # serial number (just the serial number data bytes, no header or length)
1174 # issuer name as a DER "Name"
1175 # validity start as a DER "Time"
1176 # validity end as a DER "Time"
1177 # subject name as a DER "Name"
1178 # subject public key as a DER "SubjectPublicKeyInfo"
1179 # subject public key id if v3 Extension SubjectKeyIdentifier is present
1180 # otherwise undef. This is just the raw bytes of the key id, no DER
1181 # header. (Same format as returned by GetKeyInfo and GetOpenSSHKeyInfo.)
1182 # or undef if the certificate is unparseable
1184 no warnings;
1185 my $der = shift;
1186 my $subjectKeyIdentifier = DEROID('2.5.29.14');
1187 return undef if unpack('C',substr($der,0,1)) != 0x30;
1188 my ($len, $lenbytes) = ReadDERLength(substr($der,1));
1189 return undef unless length($der) == 1 + $lenbytes + $len;
1190 substr($der, 0, 1 + $lenbytes) = '';
1191 return undef if unpack('C',substr($der,0,1)) != 0x30;
1192 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1193 return undef unless length($der) >= 1 + $lenbytes + $len;
1194 substr($der, 0, 1 + $lenbytes) = '';
1195 substr($der, $len) = '';
1196 my $byte = unpack('C',substr($der,0,1));
1197 my $ver = 1;
1198 if ($byte == 0xA0) {
1199 return undef if length($der) < 5 || substr($der,1,3) != pack('H*','030201');
1200 $byte = unpack('C',substr($der,4,1));
1201 # Zero shouldn't be allowed as it's DEFAULT but we'll let it go by
1202 return undef if $byte > 2; # unrecognized version
1203 $ver = $byte + 1;
1204 substr($der,0,5) = '';
1206 return undef if unpack('C',substr($der,0,1)) != 0x02;
1207 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1208 return undef unless length($der) > 1+$lenbytes+$len && $len >= 1;
1209 substr($der, 0, 1 + $lenbytes) = '';
1210 my $serial = substr($der, 0, $len);
1211 substr($der, 0, $len) = '';
1212 return undef if unpack('C',substr($der,0,1)) != 0x30; # Alg ID
1213 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1214 return undef unless length($der) > 1+$lenbytes+$len;
1215 substr($der,0,1+$lenbytes+$len) = '';
1216 return undef if unpack('C',substr($der,0,1)) != 0x30; # Issuer
1217 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1218 return undef unless length($der) > 1+$lenbytes+$len;
1219 my $issuer = substr($der, 0, 1 + $lenbytes + $len);
1220 substr($der,0,1+$lenbytes+$len) = '';
1221 return undef if unpack('C',substr($der,0,1)) != 0x30; # Validity
1222 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1223 return undef unless length($der) > 1+$lenbytes+$len;
1224 my $validlen = $len;
1225 substr($der, 0, 1 + $lenbytes) = '';
1226 $byte = unpack('C', substr($der, 0, 1));
1227 return undef unless $byte == 0x17 || $byte == 0x18;
1228 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1229 return undef unless length($der) > 1+$lenbytes+$len;
1230 my $vst = substr($der, 0, 1 + $lenbytes + $len);
1231 substr($der, 0, 1+$lenbytes+$len) = '';
1232 $byte = unpack('C', substr($der, 0, 1));
1233 return undef unless $byte == 0x17 || $byte == 0x18;
1234 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1235 return undef unless length($der) > 1+$lenbytes+$len;
1236 my $vnd = substr($der, 0, 1 + $lenbytes + $len);
1237 substr($der, 0, 1+$lenbytes+$len) = '';
1238 return undef unless $validlen == length($vst) + length($vnd);
1239 return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject
1240 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1241 return undef unless length($der) > 1+$lenbytes+$len;
1242 my $subj = substr($der, 0, 1 + $lenbytes + $len);
1243 substr($der, 0, 1+$lenbytes+$len) = '';
1244 return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject PubKey
1245 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1246 return undef unless length($der) >= 1+$lenbytes+$len;
1247 my $subjkey = substr($der, 0, 1 + $lenbytes + $len);
1248 substr($der, 0, 1+$lenbytes+$len) = '';
1249 return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,undef)
1250 if !length($der) || $ver < 3;
1251 $byte = unpack('C',substr($der,0,1));
1252 if ($byte == 0x81) {
1253 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1254 return undef unless length($der) >= 1+$lenbytes+$len;
1255 substr($der,0,1+$lenbytes+$len) = '';
1256 $byte = unpack('C',substr($der,0,1));
1258 if ($byte == 0x82) {
1259 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1260 return undef unless length($der) >= 1+$lenbytes+$len;
1261 substr($der,0,1+$lenbytes+$len) = '';
1262 $byte = unpack('C',substr($der,0,1));
1264 return undef if length($der) && $byte != 0xA3; # exts tag
1265 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1266 return undef unless length($der) == 1+$lenbytes+$len;
1267 my $skid = undef;
1268 substr($der, 0, 1+$lenbytes) = '';
1269 return undef unless unpack('C',substr($der,0,1)) == 0x30; # Extensions
1270 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1271 return undef unless length($der) == 1+$lenbytes+$len;
1272 substr($der, 0, 1+$lenbytes) = '';
1273 while (length($der)) {
1274 return undef unless unpack('C',substr($der,0,1)) == 0x30;
1275 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1276 return undef unless length($der) >= 1+$lenbytes+$len;
1277 substr($der,0,1+$lenbytes) = '';
1278 return undef unless unpack('C',substr($der,0,1)) == 0x06;
1279 if (substr($der,0,length($subjectKeyIdentifier)) ne $subjectKeyIdentifier) {
1280 substr($der,0,$len) = '';
1281 next;
1283 substr($der,0,length($subjectKeyIdentifier)) = '';
1284 if (unpack('C',substr($der,0,1)) == 0x01) {
1285 # SHOULDn't really be here, but allow it anyway
1286 return undef unless unpack('C',substr($der,1,1)) == 0x01;
1287 substr($der,0,3) = '';
1289 return undef unless unpack('C',substr($der,0,1)) == 0x04;
1290 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1291 return undef unless length($der) >= 1+$lenbytes+$len && $len > 1;
1292 substr($der,0,1+$lenbytes) = '';
1293 return undef unless unpack('C',substr($der,0,1)) == 0x04;
1294 ($len, $lenbytes) = ReadDERLength(substr($der,1));
1295 return undef unless length($der) >= 1+$lenbytes+$len && $len >= 1;
1296 $skid = substr($der,1+$lenbytes,$len);
1297 last;
1299 return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,$skid)
1302 sub BreakLine($$)
1304 my ($line,$width) = @_;
1305 my @ans = ();
1306 return $line if $width < 1;
1307 while (length($line) > $width) {
1308 push(@ans, substr($line, 0, $width));
1309 substr($line, 0, $width) = '';
1311 push(@ans, $line) if length($line);
1312 return @ans;
1315 sub whirlpool($)
1317 my $data = shift;
1318 my $hash;
1320 local(*CHLD_OUT, *CHLD_IN);
1321 #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1322 #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1323 (my $pid = open2(\*CHLD_OUT, \*CHLD_IN, "openssl", "dgst", "-whirlpool",
1324 "-binary"))
1325 or die "Cannot start openssl dgst\n";
1326 print CHLD_IN $data;
1327 close(CHLD_IN);
1328 local $/;
1329 die "Error reading whirlpool digest from openssl dgst\n"
1330 unless !!($hash = <CHLD_OUT>);
1331 waitpid($pid, 0);
1332 close(CHLD_OUT);
1333 #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1335 return $hash;
1338 sub GetDigest($)
1340 my $dgst = shift;
1341 my $sha1 = DEROID('1.3.14.3.2.26');
1342 my $sha224 = DEROID('2.16.840.1.101.3.4.2.4');
1343 my $sha256 = DEROID('2.16.840.1.101.3.4.2.1');
1344 my $sha384 = DEROID('2.16.840.1.101.3.4.2.2');
1345 my $sha512 = DEROID('2.16.840.1.101.3.4.2.3');
1346 my $whirlpoolAlgorithm = DEROID('1.0.10118.3.0.55');
1347 my $sha1WithRSAEncryption = DEROID('1.2.840.113549.1.1.5');
1348 my $sha224WithRSAEncryption = DEROID('1.2.840.113549.1.1.14');
1349 my $sha256WithRSAEncryption = DEROID('1.2.840.113549.1.1.11');
1350 my $sha384WithRSAEncryption = DEROID('1.2.840.113549.1.1.12');
1351 my $sha512WithRSAEncryption = DEROID('1.2.840.113549.1.1.13');
1352 my $whirlpoolWithRSAEncryption = DEROID('1.2.840.113549.1.1.15');
1353 return ($sha1, $sha1WithRSAEncryption, \&sha1) if $dgst eq 'sha1';
1354 my $h = undef;
1355 my $oid = undef;
1356 my $func = undef;
1357 for (;;) {
1358 $h=$sha224,$oid=$sha224WithRSAEncryption,$func=\&sha224,last
1359 if $dgst eq 'sha224';
1360 $h=$sha256,$oid=$sha256WithRSAEncryption,$func=\&sha256,last
1361 if $dgst eq 'sha256';
1362 $h=$sha384,$oid=$sha384WithRSAEncryption,$func=\&sha384,last
1363 if $dgst eq 'sha384';
1364 $h=$sha512,$oid=$sha512WithRSAEncryption,$func=\&sha512,last
1365 if $dgst eq 'sha512';
1366 $h=$whirlpoolAlgorithm,$oid=$whirlpoolWithRSAEncryption,
1367 $func=\&whirlpool,last if $dgst eq 'whirlpool';
1368 last;
1370 die "Invalid digest ($dgst) must be one of:\n"
1371 . " sha1 sha224 sha256 sha384 sha512\n" unless $h && $oid;
1372 die "Digest $dgst requires Digest::SHA or Digest::SHA::PurePerl "
1373 . "to be available\n" if !$hasSha2;
1374 return ($h,$oid,$func);
1377 sub GetDigestStrength($)
1379 return 80 if $_[0] eq 'sha1';
1380 return 112 if $_[0] eq 'sha224';
1381 return 128 if $_[0] eq 'sha256';
1382 return 192 if $_[0] eq 'sha384';
1383 return 256 if $_[0] eq 'sha512';
1384 return 256 if $_[0] eq 'whirlpool';
1387 sub GetDigestNameForBits($)
1389 return 'sha1' if $_[0] <= 80;
1390 return 'sha224' if $_[0] <= 112;
1391 return 'sha256' if $_[0] <= 128;
1392 return 'sha384' if $_[0] <= 192;
1393 return 'sha512';
1396 sub toupper($)
1398 my $str = shift;
1399 $str =~ tr/a-z/A-Z/;
1400 return $str;
1403 sub tolower($)
1405 my $str = shift;
1406 $str =~ tr/A-Z/a-z/;
1407 return $str;
1410 sub RSASign($$)
1412 my ($data, $keyfile) = @_;
1413 my $sig;
1415 local(*CHLD_OUT, *CHLD_IN);
1416 #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1417 #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1418 (my $pid = open2(\*CHLD_OUT, \*CHLD_IN, "openssl", "rsautl", "-sign",
1419 "-inkey", $keyfile))
1420 or die "Cannot start openssl rsautl\n";
1421 print CHLD_IN $data;
1422 close(CHLD_IN);
1423 local $/;
1424 die "Error reading RSA signature from openssl rsautl\n"
1425 unless !!($sig = <CHLD_OUT>);
1426 waitpid($pid, 0);
1427 close(CHLD_OUT);
1428 #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1430 return $sig;
1433 my %rsadsa_known_strengths;
1434 BEGIN {
1435 %rsadsa_known_strengths = (
1436 1024 => 80,
1437 2048 => 112,
1438 3072 => 128,
1439 7680 => 192,
1440 15360 => 256,
1444 sub compute_rsa_strength($)
1446 my $rsadsabits = shift;
1447 return 0 unless $rsadsabits && $rsadsabits > 0;
1448 return ($rsadsa_known_strengths{$rsadsabits},'')
1449 if $rsadsa_known_strengths{$rsadsabits};
1450 my $guess;
1451 if ($rsadsabits < 1024) {
1452 $guess = 80 * sqrt($rsadsabits/1024);
1453 } elsif ($rsadsabits > 15360) {
1454 $guess = 256 * sqrt($rsadsabits/15360);
1455 } else {
1456 $guess = 34.141 + sqrt(34.141*34.141 - 4*0.344*(1554.7-$rsadsabits));
1457 $guess = $guess / (2 * 0.344);
1459 $guess = 79 if $rsadsabits < 1024 && $guess >= 80;
1460 $guess = 80 if $rsadsabits > 1024 && $guess < 80;
1461 $guess = 111 if $rsadsabits > 1024 && $rsadsabits < 2048 && $guess >= 112;
1462 $guess = 112 if $rsadsabits > 2048 && $guess < 112;
1463 $guess = 127 if $rsadsabits > 2048 && $rsadsabits < 3072 && $guess >= 128;
1464 $guess = 128 if $rsadsabits > 3072 && $guess < 128;
1465 $guess = 191 if $rsadsabits > 3072 && $rsadsabits < 7680 && $guess >= 192;
1466 $guess = 192 if $rsadsabits > 7680 && $guess < 192;
1467 $guess = 255 if $rsadsabits > 7680 && $rsadsabits < 15360 && $guess >= 256;
1468 $guess = 256 if $rsadsabits > 15360 && $guess < 256;
1469 return (int($guess),1);
1472 sub is_ipv4($)
1474 my $octet = '(?:\d|[1-9]\d|1\d{2}|2[0-4]\d|25[0-5])';
1475 return $_[0] =~ /^$octet\.$octet\.$octet\.$octet$/o;
1478 # 1-8 groups of 1-4 hex digits separated by ':' except that the groups may be
1479 # divided into two and separated by '::' instead and finally the last two
1480 # groups may be specified using IPv4 notation. No scope allowed.
1481 sub parseipv6($)
1483 my $a = shift;
1484 return undef unless $a =~ /^[:0-9a-fA-F.]+$/;
1485 my $two = 0;
1486 my @group1 = ();
1487 my @group2 = ();
1488 if ($a =~ /^(.*)::(.*)$/) {
1489 @group1 = split(/:/, $1) if $1;
1490 @group2 = split(/:/, $2) if $2;
1491 $two = 1;
1492 } else {
1493 @group2 = split(/:/, $a);
1495 if (@group2 && is_ipv4($group2[@group2 - 1])) {
1496 my @ipv4 = split(/\./, pop(@group2));
1497 push(@group2, sprintf("%x", ($ipv4[0] << 8) | $ipv4[1]));
1498 push(@group2, sprintf("%x", ($ipv4[2] << 8) | $ipv4[3]));
1500 return undef unless @group1 + @group2 >= 1 && @group1 + @group2 <= 8;
1501 return undef if $two && @group1 + @group2 >= 8;
1502 if ($two) {
1503 my $zcomps = 8 - (@group1 + @group2);
1504 for (my $i=0; $i < $zcomps; ++$i) {
1505 push(@group1, 0);
1508 my $ans = '';
1509 foreach my $comp (@group1,@group2) {
1510 return undef unless $comp =~ /^[0-9a-fA-F]{1,4}$/;
1511 $ans .= pack('n', hex($comp));
1513 return $ans;
1516 sub parseip($)
1518 my $a = shift;
1519 if (is_ipv4($a)) {
1520 return pack('CCCC', split(/\./, $a, 4));
1521 } else {
1522 return parseipv6($a);
1526 # See these RFCs:
1527 # RFC 1034 section 3.5
1528 # RFC 1123 section 2.1
1529 # RFC 1738 section 3.1
1530 # RFC 3986 section 3.2.2
1531 sub is_dns_valid($)
1533 my $dns = shift;
1534 defined($dns) or $dns = '';
1535 return 0 if $dns eq '' || $dns =~ /\s/;
1536 my @labels = split(/\./, $dns, -1);
1537 # Check each label
1538 my $i = -1;
1539 foreach my $label (@labels) {
1540 ++$i;
1541 return 0 unless length($label) > 0 && length($label) <= 63;
1542 return 0 unless $label =~ /^[A-Za-z0-9](?:[A-Za-z0-9-]*[A-Za-z0-9])?$/ ||
1543 ($i == 0 && $label eq '*' && @labels > 1);
1545 return 0 unless length($dns) <= 255;
1546 return 1;
1549 sub handle_dns_opt($$)
1551 my $val = shift;
1552 my $altsref = shift;
1553 my $ip = parseip($val);
1554 if (defined($ip)) {
1555 die "Internal error: parsed IP not 4 or 16 bytes long"
1556 unless length($ip) == 4 || length($ip) == 16;
1557 push(@$altsref, [0x87, $ip]);
1558 } else {
1559 $val =~ s/\.$//;
1560 die "Not a valid dns name or IPv4/IPv6 address: $val\n"
1561 unless is_dns_valid($val);
1562 push(@$altsref, [0x82, $val]);
1566 sub is_oid_valid($)
1568 my $oid = shift;
1569 return 0 unless $oid =~ /^\d+(?:\.\d+)*$/os;
1570 my @ids = split(/[.]/, $oid);
1571 return 0 unless @ids >= 2;
1572 return 0 unless $ids[0] <= 2;
1573 return 0 if $ids[0] < 2 && $ids[1] >= 40;
1574 return 1;
1577 sub is_email_valid($)
1579 my $val = shift;
1580 return 0 unless $val =~ /^([^@\s]+)\@([A-Za-z0-9.-]+)$/;
1581 my ($local,$host) = ($1,$2);
1582 return 0 unless is_dns_valid($host);
1583 return $local =~ /^[[:print:]]+$/os ? 1 : 0;
1586 sub validate_oid_value($$$)
1588 our $quiet;
1589 our $nomaxlen;
1590 our $useRandom;
1591 my ($oid, $value, $key) = @_;
1592 if (defined($oidstringlengths{$oid})) {
1593 my $len = $oidstringlengths{$oid};
1594 if ($len =~ /^\d+$/) {
1595 if (length($value) != $len) {
1596 warn "--dni key type '$key' requires exactly $len characters\n";
1597 return 0;
1599 } elsif ($len =~ /^,(\d+)$/) {
1600 my $max = $1;
1601 if (length($value) > $max) {
1602 warn "--dni key type '$key' requires no more than $max characters\n"
1603 unless $quiet;
1604 return 0 unless $nomaxlen;
1606 } elsif ($len =~ /^(\d+),$/) {
1607 my $min = $1;
1608 if (length($value) < $min) {
1609 warn "--dni key type '$key' requires at least $min characters\n";
1610 return 0;
1612 } elsif ($len =~ /^(\d+),(\d+)$/) {
1613 my ($min,$max) = ($1, $2);
1614 if (length($value) < $min || length($value) > $max) {
1615 warn "--dni key type '$key' requires $min-$max characters\n"
1616 unless $quiet && length($value) >= $min;
1617 return 0 unless $nomaxlen && length($value) >= $min;
1619 } else {
1620 die "Bad value \"$len\" in \%oidstringlengths for '$key'\n";
1623 warn("--dni key values may not be empty (key '$key')\n"), return 0
1624 unless length($value);
1625 if (defined($oidstringtypes{$oid})) {
1626 my $st = $oidstringtypes{$oid};
1627 die "Invalid \%oidstringtype value '$st' for $oid\n"
1628 unless $st eq 'u' || $st eq 'p' || $st eq 'i';
1629 warn("--dni key type '$key' requires a PrintableString (must match ".
1630 "[A-Za-z0-9 '()+,./:=?-]+)\n"), return 0
1631 if $st eq 'p' && $value !~ m|^[A-Za-z0-9 '()+,./:=?-]+$|os &&
1632 ($oid ne '2.5.4.5' || !$useRandom || $value ne '#');
1633 warn("--dni key type '$key' requires an IA5String (must match ".
1634 "[\x00-\x7F]+)\n"), return 0
1635 if $st eq 'i' && $value !~ m|^[\x00-\x7F]+$|os;
1636 warn("--dni key type '$key' requires a UTF8String\n"), return 0
1637 if $st eq 'u' && !IsUTF8(MakeUTF8($value));
1639 if (defined($oidstringrestrictions{$oid})) {
1640 my $r = $oidstringrestrictions{$oid};
1641 die "Invalid \%oidstringrestrictions value '$r' for $oid\n"
1642 unless $r eq 'c' || $r eq 'd' || $r eq 'e';
1643 warn("--dni key type '$key' requires 2 A-Z characters\n"), return 0
1644 if $r eq 'c' && $value !~ m|^[A-Z]{2}$|;
1645 warn("--dni key type '$key' requires 1-63 character dns label ".
1646 "(letdig(letdighyp*)letdig*)\n"), return 0
1647 if $r eq 'd' && (length($value) > 63 ||
1648 $value !~ m|^[A-Za-z0-9](?:[A-Za-z0-9-]*[A-Za-z0-9])?$|);
1649 warn("--dni key type '$key' requires an email address (local\@host)\n"),
1650 return 0 if $r eq 'e' && !is_email_valid($value);
1652 return 1;
1655 sub get_oid_string_type($$)
1657 my ($oid, $value) = @_;
1658 if (defined($oidstringtypes{$oid})) {
1659 my $st = $oidstringtypes{$oid};
1660 return 12 if $st eq 'u';
1661 return 19 if $st eq 'p';
1662 return 22 if $st eq 'i';
1663 die "Invalid \%oidstringtype value '$st' for $oid\n";
1665 return 19 if $value =~ m|^[A-Za-z0-9 '()+,./:=?-]*$|os;
1666 return 12;
1669 sub handle_dni_opt($$$)
1671 my $opt = shift;
1672 my $listref = shift;
1673 my $stdinokref = shift;
1674 my $dor;
1675 if ($$stdinokref && $$stdinokref > 2) {
1676 $dor = sub {warn "@_"; return 0}
1677 } else {
1678 $dor = sub {die "@_"}
1680 $opt =~ s/^\s+//;
1681 $opt =~ s/\s+$//;
1682 if ($opt =~ /^\@(.*)$/os) {
1683 my $fn = $1;
1684 if ($$stdinokref && $$stdinokref > 2) {
1685 warn "May not use \@filename syntax within a --dni \@filename file\n";
1686 return 0;
1688 die "May not use --dni \@- if stdin is being used for a public key\n"
1689 if $fn eq '-' && !$$stdinokref;
1690 die "May not use --dni \@- more than once\n"
1691 if $fn eq '-' && $$stdinokref && $$stdinokref > 1;
1692 ++$$stdinokref if $fn eq '-';
1693 my $stdinnotok = 3;
1694 my $input;
1695 my $infilename;
1696 if ($fn ne '-') {
1697 $infilename = "\"$fn\"";
1698 open($input, '<', $fn)
1699 or die "Cannot open $infilename for input: $!\n";
1700 } else {
1701 $input = *STDIN;
1702 $infilename = 'standard input';
1704 my $lineno = 0;
1705 while (my $line = <$input>) {
1706 ++$lineno;
1707 $line =~ s/(?:\r|\r\n|\n)$//os;
1708 next if $line =~ /^\s*$/os || $line =~ /^\s*#/os;
1709 &handle_dni_opt($line, $listref, \$stdinnotok)
1710 or die "$infilename:$lineno: error: --dni \@filename syntax error\n";
1712 close($input) if $fn ne '-';
1713 return 1;
1715 return &$dor("Bad --dni key=value option: $opt\n")
1716 unless $opt =~ /^([+]?)\s*([^+=\s]+)\s*=\s*(.+)$/;
1717 my ($mv,$key,$value) = ($1,$2,$3);
1718 my $oid;
1719 if ($key =~ /^[\d.]+$/) {
1720 return &$dor("Bad --dni option invalid oid key: $key\n")
1721 unless is_oid_valid($key);
1722 warn "*** Warning: The OID $key is not recognized, value will be encoded ".
1723 "as a PrintableString or UTF8String type\n" unless $knownoids{$key};
1724 $oid = $key;
1725 } else {
1726 return &$dor("Bad --dni option unrecognized key name ".
1727 "(use --list-oid-names): $key\n") unless $oidnames{lc($key)};
1728 $oid = $oidnames{lc($key)};
1730 return &$dor("Bad --dni option '+key=value' requires previous non-'+': $opt\n")
1731 if $mv && !@$listref;
1732 return &$dor("Bad --dni option invalid value for key: $opt\n")
1733 unless validate_oid_value($oid, $value, $key);
1734 push(@$listref, []) unless $mv;
1735 push(@{$$listref[$#$listref]}, [$oid, $value]);
1736 return 1;
1739 sub main
1741 Make1252(); # Set up the UTF-8 auxiliary conversion table
1743 my $help = '';
1744 my $verbose = '';
1745 our $quiet = '';
1746 our $nomaxlen = '';
1747 my $acme = '';
1748 my $keyfile = '';
1749 my $certfile = '';
1750 my $useNow = '';
1751 our $useRandom = '';
1752 my $useNoRandom = '';
1753 my $termOK = '';
1754 my $server = '';
1755 my @serverAltNames = ();
1756 my $codesign = '';
1757 my $applecodesign = '';
1758 my $client = '';
1759 my $email = '';
1760 my $subca = '';
1761 our $root = '';
1762 my $rootauth = '';
1763 my $authext = '';
1764 my $digest = $hasSha2 ? 'sha256' : 'sha1';
1765 my $digestChoice = '';
1766 my $debug = 0;
1767 my $pubx509 = '';
1768 my $check = '';
1769 my $pathlen = '';
1770 my $commonNameOID = '2.5.4.3'; # :commonName
1771 my $serialNumber = DEROID('2.5.4.5'); # :serialNumber
1772 my $userIdOID = '0.9.2342.19200300.100.1.1'; # :userId
1773 my $emailAddressOID = '1.2.840.113549.1.9.1'; # :emailAddress
1774 my $dnQualifier = DEROID('2.5.4.46'); # :dnQualifier
1775 my $basicConstraints = DEROID('2.5.29.19');
1776 my $keyUsage = DEROID('2.5.29.15');
1777 my $extKeyUsage = DEROID('2.5.29.37');
1778 my $serverAuth = DEROID('1.3.6.1.5.5.7.3.1');
1779 my $clientAuth = DEROID('1.3.6.1.5.5.7.3.2');
1780 my $codeSigning = DEROID('1.3.6.1.5.5.7.3.3');
1781 my $emailProtection = DEROID('1.3.6.1.5.5.7.3.4');
1782 my $appleCodeSigning = DEROID('1.2.840.113635.100.4.1');
1783 my $authKeyId = DEROID('2.5.29.35');
1784 my $subjKeyId = DEROID('2.5.29.14');
1785 my $subjAltName = DEROID('2.5.29.17');
1786 my $boolTRUE = pack('C*',0x01,0x01,0xFF);
1787 my $boolFALSE = pack('C*',0x01,0x01,0x00);
1788 my $v3Begin = pack('C',0x17).DERLength(13)."970811000000Z";
1789 my $noExpiry = pack('C',0x18).DERLength(15)."99991231235959Z";
1790 my $infile = '-';
1791 my $outfile = '-';
1792 my @suffixfiles = ();
1793 my $suffix = '';
1794 my $qualifier = undef;
1795 my @dnilist = ();
1797 eval {GetOptions(
1798 "help|h" => sub{$help=1;die"!FINISH"},
1799 "verbose|v" => \$verbose,
1800 "man" => sub{$verbose=1;$help=1;die"!FINISH"},
1801 "version|V" => sub{print $VERSIONMSG;exit(0)},
1802 "list-oid-names" => sub{print $oidnamelist;exit(0)},
1803 "debug" => \$debug,
1804 "quiet" => \$quiet,
1805 "pubx509" => \$pubx509,
1806 "pubX509" => \$pubx509,
1807 "check" => \$check,
1808 "acme" => \$acme,
1809 "now" => \$useNow,
1810 "random" => \$useRandom,
1811 "no-random" => \$useNoRandom,
1812 "no-max-len" => \$nomaxlen,
1813 "t" => \$termOK,
1814 "server" => \$server,
1815 "codesign" => \$codesign,
1816 "applecodesign" => \$applecodesign,
1817 "email" => \$email,
1818 "client" => \$client,
1819 "subca" => \$subca,
1820 "root" => \$root,
1821 "rootauth" => \$rootauth,
1822 "authext" => \$authext,
1823 "digest=s" => \$digestChoice,
1824 "key|k=s" => \$keyfile,
1825 "cert|c=s" => \$certfile,
1826 "pathlen=i" => \$pathlen,
1827 "in=s" => \$infile,
1828 "out=s" => \$outfile,
1829 "suffix=s" => sub{push(@suffixfiles, $_[1])},
1830 "dnq=s" => \$qualifier,
1831 "dns=s" => sub{handle_dns_opt($_[1], \@serverAltNames)},
1832 "dni=s" => sub{push(@dnilist, $_[1])}
1833 )} || $help
1834 or die $USAGE;
1835 if ($help) {
1836 local *MAN;
1837 my $pager = $ENV{'PAGER'} || 'less';
1838 if (-t STDOUT && open(MAN, "|-", $pager)) {
1839 print MAN formatman($HELP,1);
1840 close(MAN);
1842 else {
1843 print formatman($HELP);
1845 exit(0);
1847 die "--acme and --check are not compatible\n" if $acme && $check;
1848 die("May not combine --random and --no-random\n", $USAGE)
1849 if $root && $useRandom && $useNoRandom;
1850 $useRandom = 1 if $root && !$useNoRandom;
1851 my @dnseq = ();
1852 if ($acme) {
1853 $useNow = '';
1854 $useNoRandom = '';
1855 $useRandom = 1;
1856 $root = 1;
1857 $rootauth = '';
1858 $qualifier = undef;
1859 @serverAltNames = ();
1860 $client = $subca = $server = $codesign = $applecodesign = $email = '';
1861 @suffixfiles = ();
1862 @dnseq = (
1863 [[$oidnames{'o'}, 'Acme Products Corporation']],
1864 [[$oidnames{'ou'}, 'Internet Services Division']],
1865 [[$oidnames{'ou'}, 'Acme Certificate Co.']],
1866 [[$oidnames{'ou'}, 'Certificate Services']],
1867 [[$oidnames{'ou'}, 'Root Certificate Production']],
1868 [[$oidnames{'serial'}, '#']],
1869 [[$oidnames{'cn'}, 'Acme Root Certificate']]
1872 die "--in requires a filename\n" if !$root && !$infile;
1873 die "--out requires a filename\n" if !$outfile;
1874 foreach my $suffixfile (@suffixfiles) {
1875 die "--suffix requires a filename\n" if defined($suffixfile) && !$suffixfile;
1876 die "--suffix file '$suffixfile' does not exist or is not readable\n"
1877 if ! -e $suffixfile || ! -r $suffixfile;
1879 my $dnistdinok = $root || $infile ne '-';
1880 foreach my $dnitem (@dnilist) {
1881 handle_dni_opt($dnitem, \@dnseq, \$dnistdinok);
1883 if ($useRandom) {
1884 my $stuffcount = 0;
1885 my $seenbad = 0;
1886 RDN: foreach my $rdn (@dnseq) {
1887 if (@$rdn == 1) {
1888 ++$stuffcount if ${$$rdn[0]}[0] eq '2.5.4.5' && ${$$rdn[0]}[1] eq '#';
1889 } else {
1890 foreach my $mv (@$rdn) {
1891 $seenbad = 1, last RDN if $$mv[0] eq '2.5.4.5' && $$mv[1] eq '#';
1895 die "--dni serialNumber=# can only be used at most once and only ".
1896 "non-multivalued\n" if $seenbad || $stuffcount > 1;
1898 my %seensingletons = ();
1899 foreach my $rdn (@dnseq) {
1900 $seensingletons{${$$rdn[0]}[0]} = 1 if @$rdn == 1;
1902 $client = 1 if
1903 !$root && !$subca && !$server && !$codesign && !$applecodesign && !$email;
1904 $verbose = 1 if $debug || $check;
1905 $quiet = 0 if $verbose || $check;
1906 print STDERR $VERSIONMSG if $verbose;
1907 my $keytype = 'OpenSSH';
1908 my $n = 'n';
1909 $keytype = 'pubx509', $n = '' if $pubx509;
1910 die("Missing required --key option\n", $USAGE) if !$keyfile;
1911 die("Missing required --cert option\n", $USAGE) if !$root && !$certfile;
1912 die("Must have exactly one \"name string\" argument\n", $USAGE)
1913 if !$check && !$acme && @ARGV != 1;
1914 die "Standard input is a tty (which is an unlikely source of a$n $keytype "
1915 . "public key)\n"
1916 . "If that's what you truly meant, add the -t option to allow it.\n"
1917 if !$root && $infile eq '-' && -t STDIN && !$termOK;
1918 my $emptynameok = $check || ($root && $useRandom);
1919 if (!$emptynameok && $ARGV[0] eq '') {
1920 if ($client) {
1921 # Okay to be empty if we've seen a user id singleton
1922 $emptynameok = 1 if $seensingletons{$userIdOID};
1923 } elsif (!$email) {
1924 # Okay to be empty if we've seen a common name singleton
1925 $emptynameok = 1 if $seensingletons{$commonNameOID};
1927 die "\"name string\" may not be empty\n" unless $emptynameok;
1929 die "Distinguished name qualifier may not be empty string\n"
1930 unless !defined($qualifier) || $qualifier ne '';
1931 die "Invalid distinguished name qualifier (must match [A-Za-z0-9 '()+,./:=?-]+)\n"
1932 unless !$qualifier || $qualifier =~ m|^[A-Za-z0-9 '()+,./:=?-]+$|;
1933 if (!$check && @ARGV && $ARGV[0] ne '') {
1934 my ($oid, $key);
1935 if ($client) {
1936 $oid = $userIdOID;
1937 $key = 'UID';
1938 } elsif ($email) {
1939 $oid = $emailAddressOID;
1940 $key = 'emailAddress';
1941 } else {
1942 $oid = $commonNameOID;
1943 $key = 'CN';
1945 die "Bad \"name string\" value\n"
1946 unless validate_oid_value($oid, $ARGV[0], $key);
1947 push(@dnseq, [[$oid, $ARGV[0]]]);
1949 my $opensshdotpub;
1950 my $infilename;
1951 foreach my $suffixfile (@suffixfiles) {
1952 open(SUFFIX, '<', $suffixfile)
1953 or die "Cannot open '$suffixfile' for input: $!\n";
1954 local $/;
1955 $suffix .= <SUFFIX>;
1956 close(SUFFIX);
1958 if (!$root) {
1959 local $/ if $pubx509;
1960 my $input;
1961 if ($infile ne '-') {
1962 $infilename = "\"$infile\"";
1963 open($input, '<', $infile)
1964 or die "Cannot open $infilename for input: $!\n";
1965 } else {
1966 $input = *STDIN;
1967 $infilename = 'standard input';
1969 !!($opensshdotpub = <$input>)
1970 or die "Cannot read $keytype public key from $infilename\n";
1971 if (!$pubx509) {
1972 my $auto509 = 0;
1973 if ($opensshdotpub =~ /^----[- ]BEGIN PUBLIC KEY[- ]----/) {
1974 $auto509 = 1;
1976 else {
1977 my $input = $opensshdotpub;
1978 $input =~ s/((?:\r\n|\n|\r).*)$//os;
1979 my @fields = split(' ', $input, 3);
1980 if (@fields < 2 ||
1981 length($fields[1]) < 16 ||
1982 $fields[1] !~ m|^[0-9A-Za-z+/=]+$|) {
1983 $auto509 = 1;
1986 if ($auto509) {
1987 $pubx509 = 1;
1988 $keytype = 'pubx509';
1989 print STDERR "auto detected --pubx509 option\n" if $debug;
1990 local $/;
1991 my $extra = <$input>;
1992 $opensshdotpub .= $extra if $extra;
1995 close($input) if $infile ne '-';
1997 die "Cannot read key file $keyfile\n" if ! -r $keyfile;
1998 die "Cannot read certificate file $certfile\n" if !$root && ! -r $certfile;
2000 my ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub);
2001 if ($root) {
2002 # need to set $sshkeyid to $pubkeyid
2003 # need to set $opensshpub to $pubkey
2004 # but don't have either yet, so do it later
2006 elsif ($pubx509) {
2007 local (*READKEY, *WRITEKEY);
2008 my $inform = $opensshdotpub =~ m|^[\t\n\r\x20-\x7E]*$|os ? 'PEM' : 'DER';
2009 print STDERR "pubx509 -inform $inform\n" if $debug;
2010 open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
2011 open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
2012 my $pid = open2(\*READKEY, \*WRITEKEY, "openssl", "rsa", "-inform",
2013 $inform, "-pubin", "-outform", "DER", "-pubout");
2014 open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
2015 $pid or die "Cannot start openssl rsa\n";
2016 print WRITEKEY $opensshdotpub;
2017 close(WRITEKEY);
2018 local $/;
2019 die "Error reading X.509 format RSA public key from $infilename\n"
2020 unless !!($opensshpub = <READKEY>);
2021 waitpid($pid, 0);
2022 close(READKEY);
2023 $sshcmnt = undef;
2024 ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1) = GetKeyInfo($opensshpub);
2025 die "Unparseable X.509 public key format read from $infilename\n"
2026 unless $sshkeybits;
2028 else {
2029 ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub) =
2030 GetOpenSSHKeyInfo($opensshdotpub);
2031 die "Unparseable OpenSSH public key read from $infilename\n"
2032 unless $sshkeybits;
2033 die "Unsupported OpenSSH public key type ($sshkeybits), must be ssh-rsa\n"
2034 unless $sshkeyexp;
2036 my $sshkeystrength;
2037 if (!$root) {
2038 my $sshkeyapprox;
2039 ($sshkeystrength, $sshkeyapprox) = compute_rsa_strength($sshkeybits);
2040 printf(STDERR "$keytype Public Key Info:\n".
2041 " bits=$sshkeybits pubexp=$sshkeyexp secstrenth=%s%s\n",
2042 $sshkeystrength, ($sshkeyapprox ? ' (approximately)' : '')) if $verbose;
2043 print STDERR " keyid=",
2044 join(":", toupper(unpack("H*",$sshkeyid))=~/../g), "\n" if $verbose;
2045 print STDERR " fingerprint(md5)=",
2046 join(":", tolower(unpack("H*",$sfmd5))=~/../g), "\n" if $verbose;
2047 print STDERR " fingerprint(sha1)=",
2048 join(":", tolower(unpack("H*",$sfsha1))=~/../g), "\n" if $verbose;
2049 print STDERR " comment=",$sshcmnt||'<none present>',"\n"
2050 if $verbose && !$pubx509;
2051 die "*** Error: $keytype key has less than 512 bits ($sshkeybits)\n"
2052 . "*** You might as well just donate your system to hackers now.\n"
2053 if $sshkeybits < 512;
2054 die "*** Error: The $keytype key's public exponent is even ($sshkeyexp)!\n"
2055 if !($sshkeyexp & 0x01);
2056 warn "*** Warning: The $keytype key has less than 2048 bits ($sshkeybits), "
2057 . "continuing anyway\n" if !$quiet && $sshkeybits < 2048;
2058 die "*** Error: The $keytype public key's exponent of $sshkeyexp is "
2059 . "unacceptably weak!\n" if $sshkeyexp < 35; # OpenSSH used 35 until v5.4
2060 warn "*** Warning: The $keytype public key's exponent ($sshkeyexp) is weak "
2061 . "(< 65537), continuing anyway\n" if !$quiet && $sshkeyexp < 65537;
2064 my $inform = -T $keyfile ? 'PEM' : 'DER';
2065 print STDERR "keyfile -inform $inform\n" if $debug;
2066 die "Input key does not appear to be in PEM format: $keyfile\n"
2067 unless $inform eq 'PEM';
2068 my $pubkey;
2070 local *READKEY;
2071 open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
2072 open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
2073 open(READKEY, "-|", "openssl", "rsa", "-inform", $inform, "-outform", "DER",
2074 "-pubout", "-passin", "pass:", "-in", $keyfile)
2075 or die "Cannot read RSA private key in \"$keyfile\": $!\n";
2076 open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
2077 local $/;
2078 die "Error reading RSA private key in \"$keyfile\"\n"
2079 unless !!($pubkey = <READKEY>);
2080 close(READKEY);
2082 $opensshpub = $pubkey if $root;
2083 my ($pubkeybits,$pubkeyexp,$pubkeyid,$pfmd5,$pfsha1) = GetKeyInfo($pubkey);
2084 $sshkeyid = $pubkeyid if $root;
2085 die "Unparseable public key format in \"$keyfile\"\n" unless $pubkeybits;
2086 my ($pubkeystrength, $pubkeyapprox) = compute_rsa_strength($pubkeybits);
2087 printf(STDERR "RSA Private Key $keyfile:\n".
2088 " bits=$pubkeybits pubexp=$pubkeyexp secstrength=%s%s\n",
2089 $pubkeystrength, ($pubkeyapprox?' (approximately)':'')) if $verbose;
2090 print STDERR " keyid=",
2091 join(":", toupper(unpack("H*",$pubkeyid))=~/../g), "\n" if $verbose;
2092 print STDERR " fingerprint(md5)=",
2093 join(":", tolower(unpack("H*",$pfmd5))=~/../g), "\n" if $verbose;
2094 print STDERR " fingerprint(sha1)=",
2095 join(":", tolower(unpack("H*",$pfsha1))=~/../g), "\n" if $verbose;
2096 die "*** Error: Private key has less than 512 bits ($pubkeybits)\n"
2097 . "*** You might as well just donate your system to hackers now.\n"
2098 if $pubkeybits < 512;
2099 die "*** Error: The private key's public exponent is even ($pubkeyexp)!\n"
2100 if !($pubkeyexp & 0x01);
2101 warn "*** Warning: The private key has less than 2048 bits ($pubkeybits), "
2102 . "continuing anyway\n" if !$quiet && $pubkeybits < 2048;
2103 die "*** Error: The private key's public key exponent of $pubkeyexp is "
2104 . "unacceptably weak!\n" if $pubkeyexp < 35; # ssh-keygen used 35 'til v5.4
2105 warn "*** Warning: The private key's public exponent ($pubkeyexp) is weak "
2106 . "(< 65537), continuing anyway\n" if !$quiet && $pubkeyexp < 65537;
2108 my $maxkeystrength = $pubkeystrength;
2109 $maxkeystrength = $sshkeystrength
2110 if $sshkeystrength && $sshkeystrength > $maxkeystrength;
2111 my $digeststrength = GetDigestStrength($digestChoice || $digest);
2112 my $digestsuggest = GetDigestNameForBits($maxkeystrength);
2113 my $digestsuggestbits = GetDigestStrength($digestsuggest);
2114 # Never warn or auto-choose if both keys are <= 1024 bits in length
2115 if ($maxkeystrength > 80) {
2116 if (!$digestChoice) {
2117 if (!$hasSha2 && $digestsuggestbits > $digeststrength) {
2118 warn "*** Warning: automatic digest selection $digestsuggest ".
2119 "support not available\n" unless $quiet;
2120 } else {
2121 $digest = $digestsuggest if $digestsuggestbits > $digeststrength;
2125 my ($did, $dalg, $dfunc) = GetDigest($digestChoice || $digest);
2126 print STDERR "default digest: $digest\n" if $debug;
2127 if ($digestChoice && $digestsuggestbits > $digeststrength) {
2128 warn "*** Warning: $digestsuggest (or stronger) is recommended for ".
2129 "security strength $maxkeystrength keys, continuing anyway\n"
2130 unless $quiet;
2132 warn "*** Warning: defaulting to sha1 since SHA-2 support not available\n"
2133 if !$quiet && $digest eq 'sha1' && !$digestChoice;
2134 $digest = $digestChoice if $digestChoice;
2135 warn "*** Warning: sha1 use is strongly discouraged, continuing anyway\n"
2136 if !$quiet && $digest eq 'sha1';
2137 warn <<EOT if !$quiet && $digest eq 'whirlpool';
2138 *** Warning: whirlpool use requires an unofficial OID (1.2.840.113549.1.1.15)
2139 *** be used for whirlpoolWithRSAEncryption. See the following:
2140 *** http://openssl.6102.n7.nabble.com/Creating-a-x509-request-with-Whirlpool-td27209.html#message27213
2141 *** Such certificates are unlikely to work. So unless you have a
2142 *** specific application that you know supports the unofficial value
2143 *** for whirlpoolWithRSAEncryption you should select a different
2144 *** signing digest. Continuing anyway.
2146 print STDERR "Using digest $digest\n" if $verbose;
2148 my ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid);
2149 if ($root) {
2150 $vst = $v3Begin;
2151 $vnd = $noExpiry;
2152 $subjkeyid = $pubkeyid;
2154 else {
2155 $inform = -T $certfile ? 'PEM' : 'DER';
2156 print STDERR "certfile -inform $inform\n" if $debug;
2157 my $signcert;
2159 local *READCERT;
2160 #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
2161 #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
2162 open(READCERT, "-|", "openssl", "x509", "-inform", $inform, "-outform",
2163 "DER", "-in", $certfile)
2164 or die "Cannot read X.509 certificate in \"$certfile\"\n";
2165 #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
2166 local $/;
2167 die "Error reading X.509 certificate in \"$certfile\"\n"
2168 unless !!($signcert = <READCERT>);
2169 close(READCERT);
2171 ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid) =
2172 GetCertInfo($signcert);
2173 die "Unparseable certificate format in \"$certfile\"\n" unless $cver;
2174 my $dser = $cser;
2175 substr($dser,0,1) = '' if unpack('C',substr($cser,0,1)) == 0x00;
2176 print STDERR "X.509 Certificate $certfile:\n",
2177 " ver=v$cver serial=", join(":", tolower(unpack("H*",$dser))=~/../g),"\n"
2178 if $verbose;
2179 print STDERR " notBefore=",DERTimeStr($vst)||'Invalid Time',
2180 " notAfter=",DERTimeStr($vnd)||'Invalid Time',"\n" if $verbose;
2181 #print STDERR " issuer=",DERNameStr($issuer),"\n" if $verbose;
2182 #print STDERR " name=",DERNameStr($subj),"\n" if $verbose;
2183 print STDERR " subj_keyid=", join(":", toupper(
2184 unpack("H*",$subjkeyid))=~/../g), "\n" if defined($subjkeyid) && $verbose;
2185 die "The private key is not the correct one for the certificate:\n".
2186 " certificate: $certfile\n".
2187 " private key: $keyfile\n" unless $subjkey eq $pubkey;
2188 if (!defined($subjkeyid)) {
2189 warn "*** Warning: The certificate has no subjectKeyIdentifier, "
2190 . "using RFC 5280 (1)\n";
2191 $subjkeyid = $pubkeyid;
2193 warn "*** Warning: subjectKeyIdentifier non-standard, continuing anyway\n"
2194 unless $subjkeyid eq $pubkeyid;
2195 die "*** Error: The $keytype public key is the same as the certificate's "
2196 . "public key.\n"
2197 . "*** They must be different for security reasons.\n"
2198 if $pubkey eq $opensshpub;
2200 return 0 if $check;
2202 my $version = pack('CCCCC', 0xA0, 0x03, 0x02, 0x01, 0x02); # v3
2203 my $randval;
2204 my $serialRDN;
2205 if ($useRandom) {
2206 $randval = RandomID($quiet);
2207 $serialRDN = join(":", tolower(unpack("H*",$randval))=~/../g) if $root;
2209 my $sigAlg = $dalg . pack('CC',0x05,0x00);
2210 $sigAlg = pack('C',0x30).DERLength(length($sigAlg)).$sigAlg;
2211 my $stuffedrand = '';
2212 if ($root && $useRandom && $seensingletons{'2.5.4.5'}) {
2213 foreach my $rdn (@dnseq) {
2214 if (@$rdn == 1 && ${$$rdn[0]}[0] eq '2.5.4.5') {
2215 if (${$$rdn[0]}[1] eq '#') {
2216 ${$$rdn[0]}[1] = $serialRDN;
2217 $stuffedrand = 1;
2218 last;
2223 my $name = '';
2224 foreach my $rdn (@dnseq) {
2225 my $packedrdn = '';
2226 foreach my $pair (@$rdn) {
2227 my $packedoid = DEROID($$pair[0]);
2228 my $val = MakeUTF8($$pair[1]);
2229 my $st = get_oid_string_type($$pair[0], $$pair[1]);
2230 my $packed = $packedoid.pack('C',$st).DERLength(length($val)).$val;
2231 $packedrdn .= pack('C',0x30).DERLength(length($packed)).$packed;
2233 $name .= pack('C',0x31).DERLength(length($packedrdn)).$packedrdn;
2235 if ($root && $useRandom && !$stuffedrand) {
2236 $serialRDN = pack('C',0x13).DERLength(length($serialRDN)).$serialRDN;
2237 $serialRDN = $serialNumber . $serialRDN;
2238 $serialRDN = pack('C',0x30).DERLength(length($serialRDN)).$serialRDN;
2239 $serialRDN = pack('C',0x31).DERLength(length($serialRDN)).$serialRDN;
2240 $name = $serialRDN . $name;
2242 if ($qualifier) {
2243 my $dnq = $qualifier;
2244 $dnq = pack('C',0x13).DERLength(length($dnq)).$dnq;
2245 $dnq = $dnQualifier . $dnq;
2246 $dnq = pack('C',0x30).DERLength(length($dnq)).$dnq;
2247 $dnq = pack('C',0x31).DERLength(length($dnq)).$dnq;
2248 $name .= $dnq;
2250 $name = pack('C',0x30).DERLength(length($name)).$name;
2251 $subj = $name if $root;
2252 my $validity = ($useNow ? DERTime(time()) : $vst).$vnd;
2253 $validity = pack('C',0x30).DERLength(length($validity)).$validity;
2254 my $extCAVal;
2255 if ($subca || $root) {
2256 $extCAVal = $boolTRUE;
2257 if ($subca && $pathlen ne '') {
2258 $extCAVal .= DERInteger($pathlen);
2260 $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
2262 else {
2263 #$extCAVal = pack('C',0x30).DERLength(length($boolFALSE)).$boolFALSE;
2264 $extCAVal = pack('C',0x30).DERLength(0); # do not include DEFAULT value
2266 $extCAVal = pack('C',0x04).DERLength(length($extCAVal)).$extCAVal;
2267 $extCAVal = $basicConstraints . $boolTRUE . $extCAVal;
2268 $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
2269 my $extKeyBits = 0x80;
2270 $extKeyBits |= 0x06 if $subca || $root;
2271 $extKeyBits |= 0x20 if $server;
2272 $extKeyBits |= 0x60 if $email;
2273 my $extKeySpare = scalar(@{[
2274 unpack("B*", chr((($extKeyBits & ($extKeyBits-1)) ^ $extKeyBits) - 1))
2275 =~ /1/g]});
2276 my $extKeyUse = pack('H*', '04040302').pack('CC',$extKeySpare,$extKeyBits);
2277 $extKeyUse = $keyUsage . $boolTRUE. $extKeyUse;
2278 $extKeyUse = pack('C',0x30).DERLength(length($extKeyUse)).$extKeyUse;
2279 my $extXKeyUse = '';
2280 if ($server || $client || $codesign || $email || $applecodesign) {
2281 $extXKeyUse .= $serverAuth if $server;
2282 $extXKeyUse .= $clientAuth if $client;
2283 $extXKeyUse .= $codeSigning if $codesign;
2284 $extXKeyUse .= $emailProtection if $email;
2285 $extXKeyUse .= $appleCodeSigning if $applecodesign;
2286 $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
2287 $extXKeyUse = pack('C',0x04).DERLength(length($extXKeyUse)).$extXKeyUse;
2288 $extXKeyUse = $extKeyUsage . $boolTRUE . $extXKeyUse;
2289 $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
2291 my $extSubjKey = pack('C',0x04).DERLength(length($sshkeyid)).$sshkeyid;
2292 $extSubjKey = pack('C',0x04).DERLength(length($extSubjKey)).$extSubjKey;
2293 $extSubjKey = $subjKeyId . $extSubjKey;
2294 $extSubjKey = pack('C',0x30).DERLength(length($extSubjKey)).$extSubjKey;
2295 my $extAuthKey = '';
2296 if (!$root || $rootauth) {
2297 $extAuthKey = pack('C',0x80).DERLength(length($pubkeyid)).$pubkeyid;
2298 if (!$root && $authext) {
2299 my $gen = pack('C',0xA4).DERLength(length($issuer)).$issuer;
2300 $extAuthKey .= pack('C',0xA1).DERLength(length($gen)).$gen;
2301 $extAuthKey .= pack('C',0x82).DERLength(length($cser)).$cser;
2303 $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
2304 $extAuthKey = pack('C',0x04).DERLength(length($extAuthKey)).$extAuthKey;
2305 $extAuthKey = $authKeyId . $extAuthKey;
2306 $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
2308 my $exts = $extCAVal . $extKeyUse . $extXKeyUse . $extSubjKey . $extAuthKey;
2309 if ($email || ($server && @serverAltNames)) {
2310 my $extSubjAlt;
2311 if ($email) {
2312 $extSubjAlt = MakeUTF8($ARGV[0]);
2313 $extSubjAlt = pack('C',0x81).DERLength(length($extSubjAlt)).$extSubjAlt;
2314 } else {
2315 $extSubjAlt = '';
2316 foreach my $alt (@serverAltNames) {
2317 $extSubjAlt .= pack('C',$$alt[0]).DERLength(length($$alt[1])).$$alt[1];
2320 $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
2321 $extSubjAlt = pack('C',0x04).DERLength(length($extSubjAlt)).$extSubjAlt;
2322 $extSubjAlt = $subjAltName . $extSubjAlt; # not crit unless empty DN
2323 $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
2324 $exts .= $extSubjAlt;
2326 $exts = pack('C',0x30).DERLength(length($exts)).$exts;
2327 $exts = pack('C',0xA3).DERLength(length($exts)).$exts;
2328 my $serial;
2329 if ($useRandom) {
2330 $serial = pack('C',0x2).DERLength(length($randval)).$randval;
2332 else {
2333 my $idtohash = $version.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
2334 $idtohash = pack('C',0x30).DERLength(length($idtohash)).$idtohash;
2335 my $idhash = sha1($idtohash);
2336 my $byte0 = unpack('C',substr($idhash,0,1));
2337 $byte0 &= 0x7F;
2338 substr($idhash,0,1) = pack('C',$byte0);
2339 $serial = pack('C',0x2).DERLength(length($idhash)).$idhash;
2341 my $tbs = $version.$serial.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
2342 $tbs = pack('C',0x30).DERLength(length($tbs)).$tbs;
2343 my $tbsseq = &$dfunc($tbs);
2344 $tbsseq = pack('C',0x04).DERLength(length($tbsseq)).$tbsseq;
2345 my $algid = $did . pack('CC',0x05,0x00);
2346 $algid = pack('C',0x30).DERLength(length($algid)).$algid;
2347 $tbsseq = $algid . $tbsseq;
2348 $tbsseq = pack('C',0x30).DERLength(length($tbsseq)).$tbsseq;
2349 my $sig = RSASign($tbsseq, $keyfile);
2350 $sig = pack('C',0x03).DERLength(length($sig)+1).pack('C',0x00).$sig;
2351 my $cert = $tbs . $sigAlg . $sig;
2352 $cert = pack('C',0x30).DERLength(length($cert)).$cert;
2353 my $base64 = join("\n", BreakLine(encode_base64($cert, ''), 64))."\n";
2354 my $output;
2355 if ($outfile ne '-') {
2356 open($output, ">", $outfile)
2357 or die "Cannot open \"$outfile\" for output: $!\n";
2358 } else {
2359 $output = *STDOUT;
2361 print $output "-----BEGIN CERTIFICATE-----\n",
2362 $base64,
2363 "-----END CERTIFICATE-----\n",
2364 $suffix;
2365 close($output) if $outfile ne '-';
2366 return 0;