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