CACreateCert

   1 #!/usr/bin/env perl
   2
   3 # CACreateCert - Create various types of certificates
   4 # Copyright (c) 2011,2012,2013 Kyle J. McKay.  All rights reserved.
   5
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU Affero General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU Affero General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU Affero General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 exit(&main());
  20
  21 use strict;
  22 use warnings;
  23 use bytes;
  24
  25 use MIME::Base64;
  26 use IPC::Open2;
  27 use Digest::MD5 qw(md5 md5_hex md5_base64);
  28 use Getopt::Long qw(:config gnu_getopt);
  29
  30 our $VERSION;
  31 my $VERSIONMSG;
  32 my $HELP;
  33 my $USAGE;
  34
  35 my $hasSha2;
  36
  37 BEGIN {
  38   *VERSION = \'1.2.15';
  39   $VERSIONMSG = "CACreateCert version $VERSION\n" .
  40     "Copyright (c) 2011-2014 Kyle J. McKay.  All rights reserved.\n" .
  41     "License AGPLv3+: GNU Affero GPL version 3 or later.\n" .
  42     "http://gnu.org/licenses/agpl.html\n" .
  43     "This is free software: you are free to change and redistribute it.\n" .
  44     "There is NO WARRANTY, to the extent permitted by law.\n";
  45 }
  46
  47 BEGIN {
  48   $hasSha2 = 0;
  49
  50   eval {
  51     require Digest::SHA;
  52     Digest::SHA->import(
  53       qw(
  54         sha1 sha1_hex sha1_base64
  55         sha224 sha224_hex sha224_base64
  56         sha256 sha256_hex sha256_base64
  57         sha384 sha384_hex sha384_base64
  58         sha512 sha512_hex sha512_base64
  59       )
  60     ); $hasSha2=1} ||
  61   eval {
  62     require Digest::SHA::PurePerl;
  63     require Digest::SHA1;
  64     Digest::SHA1->import(
  65       qw(
  66         sha1 sha1_hex sha1_base64
  67       )
  68     );
  69     Digest::SHA::PurePerl->import(
  70       qw(
  71         sha224 sha224_hex sha224_base64
  72         sha256 sha256_hex sha256_base64
  73         sha384 sha384_hex sha384_base64
  74         sha512 sha512_hex sha512_base64
  75       )
  76     ); $hasSha2=1} ||
  77   eval {
  78     require Digest::SHA::PurePerl;
  79     Digest::SHA::PurePerl->import(
  80       qw(
  81         sha1 sha1_hex sha1_base64
  82         sha224 sha224_hex sha224_base64
  83         sha256 sha256_hex sha256_base64
  84         sha384 sha384_hex sha384_base64
  85         sha512 sha512_hex sha512_base64
  86       )
  87     ); $hasSha2=1} ||
  88   eval {
  89     require Digest::SHA1;
  90     Digest::SHA1->import(
  91       qw(
  92         sha1 sha1_hex sha1_base64
  93       )
  94     ); 1} ||
  95   die "One of Digest::SHA1 or Digest::SHA or Digest::SHA::PurePerl "
  96     . "must be available\n";
  97
  98   eval {(`openssl version -v 2>/dev/null` || '') =~ /^OpenSSL /} ||
  99     die "OpenSSL (as the openssl command) is not available in the PATH\n";
 100 }
 101
 102 BEGIN {
 103   $USAGE = <<USAGE;
 104 Usage: CACreateCert [-h] [--version] [--verbose] [--debug] [--quiet] [--check]
 105          [--now] [--pubx509] [-t] [--digest=sha1|sha224|sha256|sha384|sha512]
 106          [--root | --subca | --server | --codesign | --applecodesign | --email]
 107          [--client] [--rootauth] [--authext] [--pathlen n] [--suffix suffix.pem]
 108          [--random | --no-random] [--in pub_key_file] [--out out_cert.pem]
 109          --key priv_key_file [--cert signing_cert] [--dnq "qual"] "name string"
 110 USAGE
 111   $HELP = <<HELP;
 112 NAME
 113        CACreateCert -- create X.509 certificate
 114
 115 SYNOPSIS
 116        CACreateCert [-h] [--version] [--verbose] [--debug] [--quiet] [--check]
 117          [--now] [--pubx509] [-t] [--digest=sha1|sha224|sha256|sha384|sha512]
 118          [--root | --subca | --server | --codesign | --applecodesign | --email]
 119          [--client] [--rootauth] [--authext] [--pathlen n] [--suffix suffix.pem]
 120          [--random | --no-random] [--in pubkeyfile] [--out pemcertfile]
 121          --key priv_key_file [--cert signing_cert] [--dnq "qual"] "name string"
 122        CACreateCert --root [--random] --key priv_key_file "name string" > ca.pem
 123        CACreateCert --key priv_key_file --cert signing_cert "name string"
 124          < pub_key_file > out_cert.pem
 125
 126 DESCRIPTION
 127        CACreateCert creates a new certificate.  Various certificate types are
 128        supported including root CA certificates, sub CA certificates, server
 129        certificates, code signing certificates, email certificates and client
 130        certificates.
 131
 132        When creating a certificate, the only private key required is that of
 133        the signer.  This means that, for example, a new client authentication
 134        certifcate can be created given only the public key of the client and
 135        the private key of the signing certificate.
 136
 137        The public key for the certificate being created may be provided in
 138        either OpenSSH .pub format or X.509 public key format.  The
 139        "openssl rsa -pubout" or "openssl x509 -noout -pubkey" commands can be
 140        used to produce an X.509 format public key from either an RSA private key
 141        or an X.509 certificate respectively.  Note that only OpenSSH RSA public
 142        keys in protocol format 2 are supported (they start with "ssh-rsa ").
 143
 144        When creating a root certificate no public key is required.
 145
 146        The "name string" value given must be appropriate for the type of
 147        certificate being created.  For a client authentication certificate it
 148        will typically be a *nix user login (all lowercase) on the server to
 149        which clients connect to.  For an email certificate it will typically
 150        be the full email address.  For a server it will generally be the
 151        canonical DNS name of the server.
 152
 153        No validation is performed on the "name string" value except that it
 154        must not be the empty string.  It may be provided in either Latin-1 or
 155        UTF-8.
 156
 157        The priv_key_file must be an RSA private key file in PEM or DER format
 158        and furthermore it must not have a password (both openssl genrsa and
 159        ssh-keygen -t rsa can create these kinds of RSA private key files).  If
 160        a host is running an OpenSSH sshd daemon, then it probably already has a
 161        suitable host private RSA key in either /etc/ssh/ssh_host_rsa_key or
 162        /etc/ssh_host_rsa_key that can be used if desired.
 163
 164        The signing_cert must be an X.509 certificate that uses priv_key_file as
 165        its private key.  It may be in either PEM or DER format.  The created
 166        certificate will be signed by the signing_cert.  The CACreateCert utility
 167        can be used to create a suitable signing_cert certificate authority
 168        certificate from the priv_key_file if desired by using the --root option.
 169
 170        When creating a root certificate no signing_cert is required.
 171
 172        On success the new certificate is written in PEM format to standard
 173        output.  (All error/information messages are written to standard error.)
 174
 175        Note that certificates created by CACreateCert are deterministic (i.e.
 176        the bytewise identical certificate will be output) given the identical
 177        input arguments only so long as neither the --random nor --now options
 178        are used.
 179
 180        Also note that the certificates created by this utility do not expire.
 181
 182 OPTIONS
 183        -h/--help
 184               Show this help
 185
 186        -V/--version
 187               Show the CACreateCert version
 188
 189        -v/--verbose
 190               Produce extra informational messages to standard error.
 191               Suppresses --quiet.
 192
 193        --debug
 194               Show debugging information.  Automatically enables --verbose.
 195               Suppresses --quiet.
 196
 197        --quiet
 198               Suppress all messages except errors.  Ignored if --debug or
 199               --verbose given.
 200
 201        --check
 202               Perform all normal validation checks (except for a non-empty
 203               "name string") but do not actually produce a certificate.
 204               Automatically enables --verbose.
 205
 206        --now
 207               Normally the validity not before date will be set to the signing
 208               certificate's not before date or the approval date of the X.509
 209               v3 standard (root certificates).  Using this option causes the
 210               not before validity date of the generated certificate to be set
 211               to the current time.  Use of this option will preclude production
 212               of byte-exact matching output certificates for the same input
 213               arguments.
 214
 215        --pubx509/--pubX509
 216               Force the public key read from standard input to be interpreted
 217               as an X.509 format public key.  Normally this should be
 218               automatically detected and this option should not be needed.
 219               This option is ignored if --root is given.
 220
 221        -t
 222               Allow reading the public key from standard input when standard
 223               input is a tty.  In most cases attempting to read the public key
 224               from standard input that is a tty indicates that the public key
 225               was accidentally omitted.  If that is not the case, the -t option
 226               must be given to allow reading the public key from standard input
 227               when standard input is a tty.  This option is always implied if
 228               the --in option is used with a value other than "-".
 229
 230        --digest name
 231               Select the digest to use in the generated certificate.  Must be
 232               one of sha1, sha224, sha256, sha384 or sha512.  By default sha256
 233               will be used if available otherwise sha1 will be used (and a
 234               warning issued).  All systems support sha1 digest certificates,
 235               but sha1 should really not be used anymore (see NIST
 236               recommendation SP 800-131A).  OpenSSL starting with version 0.9.8
 237               (released 2005-07-05) supports the SHA-2 family of hash functions
 238               (sha224, sha256, sha384 and sha512) which should be used instead
 239               of sha1.  Note that either Digest::SHA or Digest::SHA::PurePerl
 240               must be available to use sha224, sha256, sha384 or sha512.
 241
 242        --root
 243        --subca
 244        --server
 245        --codesign
 246        --applecodesign
 247        --email
 248        --client
 249               Select the type of certificate to generate.  If --root is given
 250               then a root certificate will be created and any --cert option will
 251               be ignored as well as standard input.  If none of these options is
 252               given then --client will be assumed.  Both --root and --subca
 253               generate certificate authority certificates (CA:TRUE).
 254               Specifying any of --root, --subca, --server, --codesign or
 255               --applecodesign will cause the "name string" to be embedded as
 256               a commonName (CN).  Otherwise if --email is specified
 257               "name string" will be embedded as an emailAddress (and a subject
 258               alternative name email type).  Finally if none of those apply then
 259               "name string" will be embedded as a userId (UID) instead
 260               (client certificates).  The certificate's key usage bits will be
 261               set to one of four values.  --root or --subca select the first,
 262               --server selects the second, --email selects the third otherwise
 263               the fourth is used.  If any of --server, --client (explicit or
 264               implied), --codesign, --email or --applecodesign are given then
 265               extended key usage items will be included (up to five -- one for
 266               each option given).
 267
 268        --pathlen n
 269               The --pathlen option will be ignored unless --subca is given in
 270               which case the X509v3 Basic Constraints will include the
 271               specified pathlen value.
 272
 273        --rootauth
 274               Ignored unless --root given.  Normally --root certificates do not
 275               include an X509v3 Authority Key Identifier.  If this option is
 276               given then they will (with only a keyid value).
 277
 278        --authext
 279               Ignored if --root given.  Normally non --root certificates include
 280               an X509v3 Authority Key Identifier section with only a keyid
 281               value.  If this option is given, then the name and serial number
 282               will also be included.
 283
 284        --random
 285               Ignored unless --root given.  When generating a --root certificate
 286               normally only the "name string" value is embedded (as the CN
 287               attribute).  If this option is given, a random serialNumber will
 288               be generated and the issuer name will be the serialNumber followed
 289               by the CN.  If this option is given, the "name string" may be set
 290               to the empty string (it must be explicit, e.g. "") in which case
 291               the issuer name will be just the random serialNumber.  Use of this
 292               option will preclude production of byte-exact matching output
 293               certificates for the same input arguments.  This is now the
 294               default when --root is given.
 295
 296        --no-random
 297               Ignored unless --root given.  Turns off the default --random
 298               option that is normally enabled by default when --root is given.
 299
 300        --key priv_key_file
 301               The RSA private key in either PEM or DER format.  This option
 302               is always required.
 303
 304        --cert signing_cert
 305               Ignored if --root is given.  The signing X.509 certificate in
 306               either PEM or DER format.  The public key embedded in signing_cert
 307               must match the one in the priv_key_file or an error will occur.
 308
 309        --in pub_key_file
 310               Ignored if --root is given.  The public key for the certificate
 311               to be created.  Must be different than the public key contained in
 312               priv_key_file.  May be an OpenSSH protocol 2 format RSA public key
 313               or an X.509 format public key (in either PEM or DER format).  See
 314               also the --pubx509 option.  If pub_key_file is "-" or this option
 315               is omitted then standard input is read.
 316
 317        --out out_cert.pem
 318               The generated certificate will be written to out_cert.pem.  If
 319               this option is omitted or out_cert.pem is "-" then the generated
 320               certificate is written to standard output.
 321
 322        --suffix suffix.pem
 323               Primarily intended to be used when generating client certificates,
 324               if this option is given, then the entire contents of suffix.pem is
 325               written to the same location as the generated certificate
 326               immediately following the certificate.  This option may be given
 327               more than once in which case the files will be appended to the
 328               output in the order the --suffix options were given.
 329
 330        --dnq qual
 331               Optional for all certificate types.  If given must not be the
 332               empty string.  Will be embedded into the subject's distinguished
 333               name as the final component.  Use of this option is not
 334               recommended when using --server or --email.  The value must be
 335               a PrintableString (needs to match [A-Za-z0-9 '()+,./:=?-]+).
 336
 337        name string
 338               The name to embed in the certificate as the subject.  This will
 339               be embedded as a common name (CN) except when --client is in
 340               effect in which case it will be embedded as a user id (UID) or
 341               when --email is in effect in which case it will be embedded as
 342               an email address in both the subject and subject alternative name.
 343               The "name string" value may never be omitted but may be explictly
 344               given as the empty string ('' or "") when generating a root
 345               certificate using a random serial number.
 346
 347 NOTES
 348        All systems support sha1 digest certificates, but sha1 should really not
 349        be used anymore (NIST recommendation SP 800-131A).  OpenSSL starting
 350        with versions 0.9.8 (released 2005-07-05) supports the SHA-2 family of
 351        hash functions (sha224, sha256, sha384 and sha512) which should be used
 352        instead.
 353
 354        NIST SP 800-131A requires use of an RSA key with 2048 or more bits and
 355        a hash function with 224 or more bits after December 31 2010.
 356
 357        RFC 6194 states sha256 is the most commonly used alternative to sha1
 358        (and will be used by default if a suitable SHA module is available).
 359
 360        Note that NIST SP 800-78-3 requires RSA public key exponents to be
 361        greater than or equal to 65537.  OpenSSH version 5.4 and later generate
 362        RSA keys with a public exponent of 65537 otherwise openssl genrsa can
 363        be used together with ssh-keygen -y to create a suitable OpenSSH key that
 364        uses an exponent of 65537 instead of 35.
 365
 366 TIPS
 367        Display the currently available version of OpenSSL with:
 368
 369            openssl version
 370
 371        Display the currently available version of OpenSSH with:
 372
 373            ssh -V
 374 HELP
 375 }
 376
 377 sub IsUTF8($)
 378 {
 379   # Return 0 if non-UTF-8 sequences present
 380   # Return -1 if no characters > 0x7F found
 381   # Return 1 if valid UTF-8 sequences present
 382   use bytes;
 383   return -1 if $_[0] !~ /[\x80-\xFF]/so;
 384   my $l = length($_[0]);
 385   for (my $i=0; $i<$l; ++$i) {
 386     my $c = ord(substr($_[0],$i,1));
 387     next if $c < 0x80;
 388     return 0 if $c < 0xC0 || $c >= 0xF8;
 389     if ($c <= 0xDF) {
 390       # Need 1 more byte
 391       ++$i;
 392       return 0 if $i >= $l;
 393       my $c2 = ord(substr($_[0],$i,1));
 394       return 0 if $c2 < 0x80 || $c2 > 0xBF;
 395       my $u = (($c & 0x1F) << 6) | ($c2 & 0x3F);
 396       return 0 if $u < 0x80;
 397       next;
 398     }
 399     if ($c <= 0xEF) {
 400       # Need 2 more bytes
 401       $i += 2;
 402       return 0 if $i >= $l;
 403       my $c2 = ord(substr($_[0],$i-1,1));
 404       return 0 if $c2 < 0x80 || $c2 > 0xBF;
 405       my $c3 = ord(substr($_[0],$i,1));
 406       return 0 if $c3 < 0x80 || $c3 > 0xBF;
 407       my $u = (($c & 0x0F) << 12) | (($c2 & 0x3F) << 6) | ($c3 & 0x3F);
 408       return 0 if $u < 0x800 || ($u >= 0xD800 && $u <= 0xDFFFF) || $u >= 0xFFFE;
 409       next;
 410     }
 411     # Need 3 more bytes
 412     $i += 3;
 413     return 0 if $i >= $l;
 414     my $c2 = ord(substr($_[0],$i-2,1));
 415     return 0 if $c2 < 0x80 || $c2 > 0xBF;
 416     my $c3 = ord(substr($_[0],$i-1,1));
 417     return 0 if $c3 < 0x80 || $c3 > 0xBF;
 418     my $c4 = ord(substr($_[0],$i,1));
 419     return 0 if $c4 < 0x80 || $c4 > 0xBF;
 420     my $u = (($c & 0x07) << 18) | (($c2 & 0x3F) << 12) | (($c3 & 0x3F) << 6)
 421                                                                  | ($c4 & 0x3F);
 422     return 0 if $u < 0x10000 || $u >= 0x10FFFE || (($u & 0xFFFF) >= 0xFFFE);
 423   }
 424   return 1;
 425 }
 426
 427 sub Make1252()
 428 {
 429   use bytes;
 430   our %W1252;
 431
 432   # Provide translations for 0x80-0x9F into UTF-8
 433   $W1252{0x80} = pack('H*','E282AC'); # 0x20AC Euro
 434   $W1252{0x82} = pack('H*','E2809A'); # 0X201A Single Low-9 Quote
 435   $W1252{0x83} = pack('H*','C692');   # 0x0192 Latin Small Letter f With Hook
 436   $W1252{0x84} = pack('H*','E2809E'); # 0x201E Double Low-9 Quote
 437   $W1252{0x85} = pack('H*','E280A6'); # 0x2026 Horizontal Ellipsis
 438   $W1252{0x86} = pack('H*','E280A0'); # 0x2020 Dagger
 439   $W1252{0x87} = pack('H*','E280A1'); # 0x2021 Double Dagger
 440   $W1252{0x88} = pack('H*','CB86');   # 0x02C6 Modifier Letter Circumflex Accent
 441   $W1252{0x89} = pack('H*','E28080'); # 0x2030 Per Mille Sign
 442   $W1252{0x8A} = pack('H*','C5A0');   # 0x0160 Latin Capital Letter S With Caron
 443   $W1252{0x8B} = pack('H*','E28089'); # 0x2039 Left Single Angle Quote
 444   $W1252{0x8C} = pack('H*','C592');   # 0x0152 Latin Capital Ligature OE
 445   $W1252{0x8E} = pack('H*','C5BD');   # 0x017D Latin Capital Letter Z With Caron
 446   $W1252{0x91} = pack('H*','E28098'); # 0x2018 Left Single Quote
 447   $W1252{0x92} = pack('H*','E28099'); # 0x2019 Right Single Quote
 448   $W1252{0x93} = pack('H*','E2809C'); # 0x201C Left Double Quote
 449   $W1252{0x94} = pack('H*','E2809D'); # 0x201D Right Double Quote
 450   $W1252{0x95} = pack('H*','E280A2'); # 0x2022 Bullet
 451   $W1252{0x96} = pack('H*','E28093'); # 0x2013 En Dash
 452   $W1252{0x97} = pack('H*','E28094'); # 0x2014 Em Dash
 453   $W1252{0x98} = pack('H*','CB9C');   # 0x02DC Small Tilde
 454   $W1252{0x99} = pack('H*','E284A2'); # 0x2122 Trade Mark Sign
 455   $W1252{0x9A} = pack('H*','C5A1');   # 0x0161 Latin Small Letter s With Caron
 456   $W1252{0x9B} = pack('H*','E2808A'); # 0x203A Right Single Angle Quote
 457   $W1252{0x9C} = pack('H*','C593');   # 0x0153 Latin Small Ligature oe
 458   $W1252{0x9E} = pack('H*','C5BE');   # 0x017E Latin Small Letter z With Caron
 459   $W1252{0x9F} = pack('H*','C5B8');   # 0x0178 Latin Cap Letter Y With Diaeresis
 460 }
 461
 462 sub MakeUTF8($)
 463 {
 464   use bytes;
 465   our %W1252;
 466
 467   return $_[0] if (IsUTF8($_[0]));
 468   my $ans = '';
 469   foreach my $c (unpack('C*',$_[0])) {
 470     if ($c < 0x80) {
 471       $ans .= chr($c);
 472     }
 473     else {
 474       # Ass/u/me we have Latin-1 (ISO-8859-1) but per the HTML 5 draft treat
 475       # it as windows-1252
 476       if ($c >= 0xA0 || !defined($W1252{$c})) {
 477         $ans .= chr(0xC0 | ($c >> 6));
 478         $ans .= chr(0x80 | ($c & 0x3F));
 479       }
 480       else {
 481         $ans .= $W1252{$c};
 482       }
 483     }
 484   }
 485   return $ans;
 486 }
 487
 488 sub formatbold($;$)
 489 {
 490   my $str = shift;
 491   my $fancy = shift || 0;
 492   if ($fancy) {
 493     $str = join('',map($_."\b".$_, split(//,$str)));
 494   }
 495   return $str;
 496 }
 497
 498 sub formatul($;$)
 499 {
 500   my $str = shift;
 501   my $fancy = shift || 0;
 502   if ($fancy) {
 503     $str = join('',map("_\b".$_, split(//,$str)));
 504   }
 505   return $str;
 506 }
 507
 508 sub formatman($;$)
 509 {
 510   my $man = shift;
 511   my $fancy = shift || 0;
 512   my @inlines = split(/\n/, $man, -1);
 513   my @outlines = ();
 514   foreach my $line (@inlines) {
 515     if ($line =~ /^[A-Z]+$/) {
 516       $line = formatbold($line, $fancy);
 517     }
 518     else {
 519       $line =~ s/'''(.+?)'''/formatbold($1,$fancy)/gse;
 520       $line =~ s/''(.+?)''/formatul($1,$fancy)/gse;
 521     }
 522     push (@outlines, $line);
 523   }
 524   my $result = join("\n", @outlines);
 525   $result =~ s/\\\n//gso;
 526   return $result;
 527 }
 528
 529 sub DERLength($)
 530 {
 531   # return a DER encoded length
 532   my $len = shift;
 533   return pack('C',$len) if $len <= 127;
 534   return pack('C2',0x81, $len) if $len <= 255;
 535   return pack('Cn',0x82, $len) if $len <= 65535;
 536   return pack('CCn',0x83, ($len >> 16), $len & 0xFFFF) if $len <= 16777215;
 537   # Silently returns invalid result if $len > 2^32-1
 538   return pack('CN',0x84, $len);
 539 }
 540
 541 sub SingleOID($)
 542 {
 543   # return a single DER encoded OID component
 544   no warnings;
 545   my $num = shift;
 546   $num += 0;
 547   my $result = pack('C', $num & 0x7F);
 548   $num >>= 7;
 549   while ($num) {
 550     $result = pack('C', 0x80 | ($num & 0x7F)) . $result;
 551     $num >>= 7;
 552   }
 553   return $result;
 554 }
 555
 556 sub DEROID($)
 557 {
 558   # return a DER encoded OID complete with leading 0x06 and DER length
 559   # Input is a string of decimal numbers separated by '.' with at least
 560   # two numbers required.
 561   no warnings;
 562   my @ids = split(/[.]/,$_[0]);
 563   push(@ids, 0) while @ids < 2; # return something that's kind of valid
 564   unshift(@ids, shift(@ids) * 40 + shift(@ids)); # combine first two
 565   my $ans = '';
 566   foreach my $num (@ids) {
 567     $ans .= SingleOID($num);
 568   }
 569   return pack('C',0x6).DERLength(length($ans)).$ans;
 570 }
 571
 572 sub DERTime($)
 573 {
 574   my $t = shift; # a time() value
 575   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t);
 576   $year += 1900;
 577   ++$mon;
 578   my $tag;
 579   my $tstr;
 580   if (1950 <= $year && $year < 2050) {
 581     # UTCTime
 582     $tag = 0x17;
 583     $tstr = sprintf("%02d%02d%02d%02d%02d%02dZ", $year % 100, $mon, $mday,
 584       $hour, $min, $sec);
 585   }
 586   else {
 587     # GeneralizedTime
 588     $tag = 0x18;
 589     $tstr = sprintf("%04d%02d%02d%02d%02d%02dZ", $year, $mon, $mday,
 590       $hour, $min, $sec);
 591   }
 592   return pack('C',$tag).DERLength(length($tstr)).$tstr;
 593 }
 594
 595 sub DERInteger($)
 596 {
 597   my $int = shift; # an integer value, may be negative
 598   my @bytes = unpack('C*',pack('N',$int));
 599   shift @bytes while @bytes >= 2 && $bytes[0] == 255 && ($bytes[1] & 0x80);
 600   shift @bytes while @bytes >= 2 && $bytes[0] == 0 && !($bytes[1] & 0x80);
 601   return pack('C*',0x02,scalar(@bytes),@bytes);
 602 }
 603
 604 sub RandomID(;$)
 605 {
 606   # return 20 random bytes except that the first byte has its high bit clear
 607   my $suppress = shift || 0;
 608   print STDERR "Generating serial number, please wait...\n" unless $suppress;
 609   my $randfile = "/dev/random";
 610   $randfile = "/dev/urandom" if -e "/dev/urandom";
 611   open(RANDIN, "<", $randfile)
 612     or die "Cannot open $randfile for input: $!\n";
 613   my $result = '';
 614   for (my $cnt = 0; $cnt < 20; ++$cnt) {
 615     my $byte;
 616     sysread(RANDIN, $byte, 1)
 617       or die "Cannot read from $randfile: $!\n";
 618     if (!$cnt) {
 619       my $val = unpack('C', $byte);
 620       $val &= 0x7F;
 621       $byte = pack('C', $val);
 622     }
 623     $result .= $byte;
 624   }
 625   close(RANDIN);
 626   print STDERR "...done creating serial number.\n" unless $suppress;
 627   return $result;
 628 }
 629
 630 sub ReadDERLength($)
 631 {
 632   # Input is a DER encoded length with possibly extra trailing bytes
 633   # Output is an array of length and bytes-used-for-encoded-length
 634   my $der = shift;
 635   return undef unless length($der);
 636   my $byte = unpack('C',substr($der,0,1));
 637   return ($byte, 1) if $byte <= 127;
 638   return undef if $byte == 128 || $byte > 128+8; # Fail if greater than 2^64
 639   my $cnt = $byte & 0x7F;
 640   return undef unless length($der) >= $cnt+1; # Fail if not enough bytes
 641   my $val = 0;
 642   for (my $i = 0; $i < $cnt; ++$i) {
 643     $val <<= 8;
 644     $val |= unpack('C',substr($der,$i+1,1));
 645   }
 646   return ($val, $cnt+1);
 647 }
 648
 649 sub DERTimeStr($)
 650 {
 651   my $der = shift;
 652   return undef unless length($der) >= 2;
 653   my $byte = unpack('C',substr($der,0,1));
 654   return undef unless $byte == 0x17 || $byte == 0x18;
 655   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 656   return undef unless length($der) == 1 + $lenbytes + $len;
 657   return undef
 658     unless ($byte == 0x17 && $len == 13) || ($byte == 0x18 && $len == 15);
 659   substr($der,0,1+$lenbytes) = '';
 660   if ($byte == 0x17) {
 661     no warnings;
 662     my $year = substr($der,0,2) + 1900;
 663     $year += 100 if $year < 1950;
 664     $der = sprintf("%04d",$year).substr($der,2);
 665   }
 666   return substr($der,0,4).'-'.substr($der,4,2).'-'.substr($der,6,2).'_'.
 667     substr($der,8,2).':'.substr($der,10,2).':'.substr($der,12,3);
 668 }
 669
 670 sub GetOpenSSHKeyInfo($)
 671 {
 672   # Input is an OpenSSH public key in .pub format
 673   # Output is an array of:
 674   #   how many bits in the modulus
 675   #   the public exponent
 676   #   the key id
 677   #   the OpenSSH md5 fingerprint
 678   #   the OpenSSH sha1 fingerprint
 679   #   the OpenSSH comment (may be '')
 680   #   the OpenSSH public key in OpenSSL PUBLIC KEY DER format
 681   # or undef if the key is unparseable
 682   # or just the key type if it's not ssh-rsa
 683   #
 684   # Expected format is:
 685   #   ssh-rsa BASE64PUBLICKEYDATA optional comment here
 686   # where the BASE64PUBLICKEYDATA when decoded produces:
 687   #   4 Byte Big-Endian length of Key type (must be 7 for RSA)
 688   #   Key type WITHOUT terminating NUL (must be ssh-rsa for RSA)
 689   #   4 Byte Big-Endian length of public exponent
 690   #   Public exponent integer bytes
 691   #   4 Byte Big-Endian length of modulus
 692   #   Modulus integer bytes
 693   # no extra trailing bytes are permitted
 694   my $input = shift;
 695   $input =~ s/((?:\r\n|\n|\r).*)$//os;
 696   my @fields = split(' ', $input, 3);
 697   return undef unless @fields >= 2;
 698   my $data = decode_base64($fields[1]);
 699   my $origData = $data;
 700   my @parts = ();
 701   while (length($data) >= 4) {
 702     my $len = unpack('N',substr($data,0,4));
 703     my $value = '';
 704     if ($len > 0) {
 705       return undef if $len + 4 > length($data);
 706       $value = substr($data,4,$len);
 707     }
 708     push(@parts, $value);
 709     substr($data, 0, 4+$len) = '';
 710   }
 711   return undef unless length($data) == 0;
 712   return $parts[0]
 713     if @parts >= 1 && defined($parts[0]) && $parts[0] && $parts[0] ne 'ssh-rsa';
 714   return undef unless @parts == 3;
 715
 716   my $rsaEncryption = DEROID('1.2.840.113549.1.1.1'); # :rsaEncryption
 717   $rsaEncryption = pack('C',0x30).DERLength(length($rsaEncryption)+2)
 718     .$rsaEncryption.pack('C2',0x05,0x00);
 719   my $pubrsa = pack('C',0x2).DERLength(length($parts[2])).$parts[2]; # modulus
 720   $pubrsa .= pack('C',0x2).DERLength(length($parts[1])).$parts[1]; # exponent
 721   $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
 722   my $id = sha1($pubrsa); # The id is the sha1 hash of the private key part
 723   $pubrsa = pack('C',0x3).DERLength(length($pubrsa)+1).pack('C',0x0).$pubrsa;
 724   $pubrsa = $rsaEncryption.$pubrsa;
 725   $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
 726
 727   my $bits = length($parts[2]) * 8;
 728   # But we have to discount any leading 0 bits in the first byte
 729   my $byte = unpack('C',substr($parts[2],0,1));
 730   if (!$byte) {
 731     $bits -= 8;
 732   }
 733   else {
 734     return undef if $byte & 0x80; # negative modulus is not allowed
 735     while (!($byte & 0x80)) {
 736       --$bits;
 737       $byte <<= 1;
 738     }
 739   }
 740
 741   my $rawexp = $parts[1];
 742   my $exp;
 743   if (length($rawexp) > 8) {
 744     # Fudge the result because it's bigger than a 64-bit number
 745     my $lastbyte = unpack('C',substr($rawexp,-1,1));
 746     $exp = $lastbyte & 0x01 ? 65537 : 65536;
 747   }
 748   else {
 749     $exp = 0;
 750     while (length($rawexp)) {
 751       $exp <<= 8;
 752       $exp |= unpack('C',substr($rawexp,0,1));
 753       substr($rawexp,0,1) = '';
 754     }
 755   }
 756
 757   return ($bits,$exp,$id,md5($origData),sha1($origData),$fields[2]||'',$pubrsa);
 758 }
 759
 760 sub GetKeyInfo($)
 761 {
 762   # Input is an RSA PRIVATE KEY in DER format
 763   # Output is an array of:
 764   #   how many bits in the modulus
 765   #   the public exponent
 766   #   the key id
 767   #   the OpenSSH md5 fingerprint
 768   #   the OpenSSH sha1 fingerprint
 769   # or undef if the key is unparseable
 770   #
 771   # Expected format is:
 772   #   SEQUENCE {
 773   #     SEQUENCE {
 774   #       OBJECT IDENTIFIER :rsaEncryption = 1.2.840.113549.1.1.1
 775   #       NULL
 776   #     }
 777   #     BIT STRING (primitive) {
 778   #       0 unused bits
 779   #       SEQUENCE { # this part is the contents of an "RSA PUBLIC KEY" file
 780   #         INTEGER modulus
 781   #         INTEGER publicExponent
 782   #       }
 783   #     }
 784   #   }
 785
 786   no warnings;
 787   my $der = shift;
 788   my $rawmod;
 789   my $rawexp;
 790
 791   return undef if unpack('C',substr($der,0,1)) != 0x30;
 792   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 793   return undef unless length($der) == 1 + $lenbytes + $len;
 794   substr($der, 0, 1 + $lenbytes) = '';
 795
 796   # the algorithm part always encodes as 30 0d 06092a864886f70d010101 0500
 797   return undef
 798     unless substr($der, 0, 15) = pack('H*',"300d06092a864886f70d0101010500");
 799   substr($der, 0, 15) = '';
 800
 801   return undef if unpack('C',substr($der,0,1)) != 0x03;
 802   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 803   return undef unless length($der) == 1 + $lenbytes + $len && $len >= 1;
 804   return undef unless unpack('C',substr($der, 1 + $lenbytes, 1)) == 0x00;
 805   substr($der, 0, 1 + $lenbytes + 1) = '';
 806
 807   return undef if unpack('C',substr($der,0,1)) != 0x30;
 808   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 809   return undef unless length($der) == 1 + $lenbytes + $len;
 810   my $id = sha1($der); # The id is the sha1 hash of the private key part
 811   substr($der, 0, 1 + $lenbytes) = '';
 812
 813   return undef if unpack('C',substr($der,0,1)) != 0x02;
 814   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 815   substr($der, 0, 1 + $lenbytes) = '';
 816   my $derexp = substr($der, $len);
 817   substr($der, $len) = '';
 818   return undef unless $len >= 1;
 819   $rawmod = $der;
 820   my $bits = length($der) * 8;
 821   # But we have to discount any leading 0 bits in the first byte
 822   my $byte = unpack('C',substr($der,0,1));
 823   if (!$byte) {
 824     $bits -= 8;
 825   }
 826   else {
 827     return undef if $byte & 0x80; # negative modulus is not allowed
 828     while (!($byte & 0x80)) {
 829       --$bits;
 830       $byte <<= 1;
 831     }
 832   }
 833
 834   $der = $derexp;
 835   return undef if unpack('C',substr($der,0,1)) != 0x02;
 836   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 837   substr($der, 0, 1 + $lenbytes) = '';
 838   return undef unless length($der) == $len && $len >= 1;
 839   return undef if unpack('C',substr($der,0,1)) & 0x80; # negative pub exp bad
 840   $rawexp = $der;
 841   my $exp;
 842   if ($len > 8) {
 843     # Fudge the result because it's bigger than a 64-bit number
 844     my $lastbyte = unpack('C',substr($der,-1,1));
 845     $exp = $lastbyte & 0x01 ? 65537 : 65536;
 846   }
 847   else {
 848     $exp = 0;
 849     while (length($der)) {
 850       $exp <<= 8;
 851       $exp |= unpack('C',substr($der,0,1));
 852       substr($der,0,1) = '';
 853     }
 854   }
 855
 856   my $tohash = pack('N',7)."ssh-rsa".pack('N',length($rawexp)).$rawexp
 857     .pack('N',length($rawmod)).$rawmod;
 858
 859   return ($bits,$exp,$id,md5($tohash),sha1($tohash));
 860 }
 861
 862 sub GetCertInfo($)
 863 {
 864   # Input is an X.509 "Certificate" (RFC 5280) in DER format
 865   # Output is an array of:
 866   #   version (1, 2, or 3)
 867   #   serial number (just the serial number data bytes, no header or length)
 868   #   issuer name as a DER "Name"
 869   #   validity start as a DER "Time"
 870   #   validity end as a DER "Time"
 871   #   subject name as a DER "Name"
 872   #   subject public key as a DER "SubjectPublicKeyInfo"
 873   #   subject public key id if v3 Extension SubjectKeyIdentifier is present
 874   #     otherwise undef.  This is just the raw bytes of the key id, no DER
 875   #     header.  (Same format as returned by GetKeyInfo and GetOpenSSHKeyInfo.)
 876   # or undef if the certificate is unparseable
 877
 878   no warnings;
 879   my $der = shift;
 880   my $subjectKeyIdentifier = DEROID('2.5.29.14');
 881   return undef if unpack('C',substr($der,0,1)) != 0x30;
 882   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 883   return undef unless length($der) == 1 + $lenbytes + $len;
 884   substr($der, 0, 1 + $lenbytes) = '';
 885   return undef if unpack('C',substr($der,0,1)) != 0x30;
 886   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 887   return undef unless length($der) >= 1 + $lenbytes + $len;
 888   substr($der, 0, 1 + $lenbytes) = '';
 889   substr($der, $len) = '';
 890   my $byte = unpack('C',substr($der,0,1));
 891   my $ver = 1;
 892   if ($byte == 0xA0) {
 893     return undef if length($der) < 5 || substr($der,1,3) != pack('H*','030201');
 894     $byte = unpack('C',substr($der,4,1));
 895     # Zero shouldn't be allowed as it's DEFAULT but we'll let it go by
 896     return undef if $byte > 2; # unrecognized version
 897     $ver = $byte + 1;
 898     substr($der,0,5) = '';
 899   }
 900   return undef if unpack('C',substr($der,0,1)) != 0x02;
 901   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 902   return undef unless length($der) > 1+$lenbytes+$len && $len >= 1;
 903   substr($der, 0, 1 + $lenbytes) = '';
 904   my $serial = substr($der, 0, $len);
 905   substr($der, 0, $len) = '';
 906   return undef if unpack('C',substr($der,0,1)) != 0x30; # Alg ID
 907   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 908   return undef unless length($der) > 1+$lenbytes+$len;
 909   substr($der,0,1+$lenbytes+$len) = '';
 910   return undef if unpack('C',substr($der,0,1)) != 0x30; # Issuer
 911   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 912   return undef unless length($der) > 1+$lenbytes+$len;
 913   my $issuer = substr($der, 0, 1 + $lenbytes + $len);
 914   substr($der,0,1+$lenbytes+$len) = '';
 915   return undef if unpack('C',substr($der,0,1)) != 0x30; # Validity
 916   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 917   return undef unless length($der) > 1+$lenbytes+$len;
 918   my $validlen = $len;
 919   substr($der, 0, 1 + $lenbytes) = '';
 920   $byte = unpack('C', substr($der, 0, 1));
 921   return undef unless $byte == 0x17 || $byte == 0x18;
 922   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 923   return undef unless length($der) > 1+$lenbytes+$len;
 924   my $vst = substr($der, 0, 1 + $lenbytes + $len);
 925   substr($der, 0, 1+$lenbytes+$len) = '';
 926   $byte = unpack('C', substr($der, 0, 1));
 927   return undef unless $byte == 0x17 || $byte == 0x18;
 928   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 929   return undef unless length($der) > 1+$lenbytes+$len;
 930   my $vnd = substr($der, 0, 1 + $lenbytes + $len);
 931   substr($der, 0, 1+$lenbytes+$len) = '';
 932   return undef unless $validlen == length($vst) + length($vnd);
 933   return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject
 934   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 935   return undef unless length($der) > 1+$lenbytes+$len;
 936   my $subj = substr($der, 0, 1 + $lenbytes + $len);
 937   substr($der, 0, 1+$lenbytes+$len) = '';
 938   return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject PubKey
 939   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 940   return undef unless length($der) >= 1+$lenbytes+$len;
 941   my $subjkey = substr($der, 0, 1 + $lenbytes + $len);
 942   substr($der, 0, 1+$lenbytes+$len) = '';
 943   return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,undef)
 944     if !length($der) || $ver < 3;
 945   $byte = unpack('C',substr($der,0,1));
 946   if ($byte == 0x81) {
 947     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 948     return undef unless length($der) >= 1+$lenbytes+$len;
 949     substr($der,0,1+$lenbytes+$len) = '';
 950     $byte = unpack('C',substr($der,0,1));
 951   }
 952   if ($byte == 0x82) {
 953     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 954     return undef unless length($der) >= 1+$lenbytes+$len;
 955     substr($der,0,1+$lenbytes+$len) = '';
 956     $byte = unpack('C',substr($der,0,1));
 957   }
 958   return undef if length($der) && $byte != 0xA3; # exts tag
 959   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 960   return undef unless length($der) == 1+$lenbytes+$len;
 961   my $skid = undef;
 962   substr($der, 0, 1+$lenbytes) = '';
 963   return undef unless unpack('C',substr($der,0,1)) == 0x30; # Extensions
 964   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 965   return undef unless length($der) == 1+$lenbytes+$len;
 966   substr($der, 0, 1+$lenbytes) = '';
 967   while (length($der)) {
 968     return undef unless unpack('C',substr($der,0,1)) == 0x30;
 969     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 970     return undef unless length($der) >= 1+$lenbytes+$len;
 971     substr($der,0,1+$lenbytes) = '';
 972     return undef unless unpack('C',substr($der,0,1)) == 0x06;
 973     if (substr($der,0,length($subjectKeyIdentifier)) ne $subjectKeyIdentifier) {
 974       substr($der,0,$len) = '';
 975       next;
 976     }
 977     substr($der,0,length($subjectKeyIdentifier)) = '';
 978     if (unpack('C',substr($der,0,1)) == 0x01) {
 979       # SHOULDn't really be here, but allow it anyway
 980       return undef unless unpack('C',substr($der,1,1)) == 0x01;
 981       substr($der,0,3) = '';
 982     }
 983     return undef unless unpack('C',substr($der,0,1)) == 0x04;
 984     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 985     return undef unless length($der) >= 1+$lenbytes+$len && $len > 1;
 986     substr($der,0,1+$lenbytes) = '';
 987     return undef unless unpack('C',substr($der,0,1)) == 0x04;
 988     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 989     return undef unless length($der) >= 1+$lenbytes+$len && $len >= 1;
 990     $skid = substr($der,1+$lenbytes,$len);
 991     last;
 992   }
 993   return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,$skid)
 994 }
 995
 996 sub BreakLine($$)
 997 {
 998   my ($line,$width) = @_;
 999   my @ans = ();
1000   return $line if $width < 1;
1001   while (length($line) > $width) {
1002     push(@ans, substr($line, 0, $width));
1003     substr($line, 0, $width) = '';
1004   }
1005   push(@ans, $line) if length($line);
1006   return @ans;
1007 }
1008
1009 sub tests
1010 {
1011   print STDERR unpack('H*', DEROID('2.100.3')),"\n"; # should be 0603813403
1012   for (my $i=0; $i<16; ++$i) {
1013     print STDERR unpack('H*', RandomID(1)),"\n"; # Hi bit should NOT be set
1014   }
1015 }
1016
1017 sub GetDigest($)
1018 {
1019   my $dgst = shift;
1020   my $sha1   = DEROID('1.3.14.3.2.26');
1021   my $sha224 = DEROID('2.16.840.1.101.3.4.2.4');
1022   my $sha256 = DEROID('2.16.840.1.101.3.4.2.1');
1023   my $sha384 = DEROID('2.16.840.1.101.3.4.2.2');
1024   my $sha512 = DEROID('2.16.840.1.101.3.4.2.3');
1025   my $sha1WithRSAEncryption   = DEROID('1.2.840.113549.1.1.5');
1026   my $sha224WithRSAEncryption = DEROID('1.2.840.113549.1.1.14');
1027   my $sha256WithRSAEncryption = DEROID('1.2.840.113549.1.1.11');
1028   my $sha384WithRSAEncryption = DEROID('1.2.840.113549.1.1.12');
1029   my $sha512WithRSAEncryption = DEROID('1.2.840.113549.1.1.13');
1030   return ($sha1, $sha1WithRSAEncryption, \&sha1) if $dgst eq 'sha1';
1031   my $h = undef;
1032   my $oid = undef;
1033   my $func = undef;
1034   for (;;) {
1035     $h=$sha224,$oid=$sha224WithRSAEncryption,$func=\&sha224,last
1036       if $dgst eq 'sha224';
1037     $h=$sha256,$oid=$sha256WithRSAEncryption,$func=\&sha256,last
1038       if $dgst eq 'sha256';
1039     $h=$sha384,$oid=$sha384WithRSAEncryption,$func=\&sha384,last
1040       if $dgst eq 'sha384';
1041     $h=$sha512,$oid=$sha512WithRSAEncryption,$func=\&sha512,last
1042       if $dgst eq 'sha512';
1043     last;
1044   }
1045   die "Invalid digest ($dgst) must be one of:\n"
1046     . "  sha1 sha224 sha256 sha384 sha512\n" unless $h && $oid;
1047   die "Digest $dgst requires Digest::SHA or Digest::SHA::PurePerl "
1048     . "to be available\n" if !$hasSha2;
1049   return ($h,$oid,$func);
1050 }
1051
1052 sub GetDigestStrength($)
1053 {
1054   return 80 if $_[0] eq 'sha1';
1055   return 112 if $_[0] eq 'sha224';
1056   return 128 if $_[0] eq 'sha256';
1057   return 192 if $_[0] eq 'sha384';
1058   return 256 if $_[0] eq 'sha512';
1059 }
1060
1061 sub GetDigestNameForBits($)
1062 {
1063   return 'sha1' if $_[0] <= 80;
1064   return 'sha224' if $_[0] <= 112;
1065   return 'sha256' if $_[0] <= 128;
1066   return 'sha384' if $_[0] <= 192;
1067   return 'sha512';
1068 }
1069
1070 sub toupper($)
1071 {
1072   my $str = shift;
1073   $str =~ tr/a-z/A-Z/;
1074   return $str;
1075 }
1076
1077 sub tolower($)
1078 {
1079   my $str = shift;
1080   $str =~ tr/A-Z/a-z/;
1081   return $str;
1082 }
1083
1084 sub RSASign($$)
1085 {
1086   my ($data, $keyfile) = @_;
1087   my $sig;
1088   {
1089     local(*CHLD_OUT, *CHLD_IN);
1090     #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1091     #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1092     (my $pid = open2(\*CHLD_OUT, \*CHLD_IN, "openssl", "rsautl", "-sign",
1093         "-inkey", $keyfile))
1094       or die "Cannot start openssl rsautl\n";
1095     print CHLD_IN $data;
1096     close(CHLD_IN);
1097     local $/;
1098     die "Error reading RSA signature from openssl rsautl\n"
1099       unless !!($sig = <CHLD_OUT>);
1100     waitpid($pid, 0);
1101     close(CHLD_OUT);
1102     #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1103   }
1104   return $sig;
1105 }
1106
1107 my %rsadsa_known_strengths;
1108 BEGIN {
1109   %rsadsa_known_strengths = (
1110     1024 => 80,
1111     2048 => 112,
1112     3072 => 128,
1113     7680 => 192,
1114     15360 => 256,
1115   );
1116 }
1117
1118 sub compute_rsa_strength($)
1119 {
1120   my $rsadsabits = shift;
1121   return 0 unless $rsadsabits && $rsadsabits > 0;
1122   return ($rsadsa_known_strengths{$rsadsabits},'') if $rsadsa_known_strengths{$rsadsabits};
1123   my $guess;
1124   if ($rsadsabits < 1024) {
1125     $guess = 80 * sqrt($rsadsabits/1024);
1126   } elsif ($rsadsabits > 15360) {
1127     $guess = 256 * sqrt($rsadsabits/15360);
1128   } else {
1129     $guess = 34.141 + sqrt(34.141*34.141 - 4*0.344*(1554.7-$rsadsabits));
1130     $guess = $guess / (2 * 0.344);
1131   }
1132   $guess = 79 if $rsadsabits < 1024 && $guess >= 80;
1133   $guess = 80 if $rsadsabits > 1024 && $guess < 80;
1134   $guess = 111 if $rsadsabits > 1024 && $rsadsabits < 2048 && $guess >= 112;
1135   $guess = 112 if $rsadsabits > 2048 && $guess < 112;
1136   $guess = 127 if $rsadsabits > 2048 && $rsadsabits < 3072 && $guess >= 128;
1137   $guess = 128 if $rsadsabits > 3072 && $guess < 128;
1138   $guess = 191 if $rsadsabits > 3072 && $rsadsabits < 7680 && $guess >= 192;
1139   $guess = 192 if $rsadsabits > 7680 && $guess < 192;
1140   $guess = 255 if $rsadsabits > 7680 && $rsadsabits < 15360 && $guess >= 256;
1141   $guess = 256 if $rsadsabits > 15360 && $guess < 256;
1142   return (int($guess),1);
1143 }
1144
1145 sub main
1146 {
1147   Make1252(); # Set up the UTF-8 auxiliary conversion table
1148
1149   my $help = '';
1150   my $verbose = '';
1151   my $quiet = '';
1152   my $keyfile = '';
1153   my $certfile = '';
1154   my $useNow = '';
1155   my $useRandom = '';
1156   my $useNoRandom = '';
1157   my $termOK = '';
1158   my $server = '';
1159   my $codesign = '';
1160   my $applecodesign = '';
1161   my $client = '';
1162   my $email = '';
1163   my $subca = '';
1164   my $root = '';
1165   my $rootauth = '';
1166   my $authext = '';
1167   my $digest = $hasSha2 ? 'sha256' : 'sha1';
1168   my $digestChoice = '';
1169   my $debug = 0;
1170   my $pubx509 = '';
1171   my $check = '';
1172   my $pathlen = '';
1173   my $commonName = DEROID('2.5.4.3'); # :commonName
1174   my $serialNumber = DEROID('2.5.4.5'); # :serialNumber
1175   my $userId = DEROID('0.9.2342.19200300.100.1.1'); # :userId
1176   my $emailAddress = DEROID('1.2.840.113549.1.9.1'); # :emailAddress
1177   my $dnQualifier = DEROID('2.5.4.46'); # :dnQualifier
1178   my $basicConstraints = DEROID('2.5.29.19');
1179   my $keyUsage = DEROID('2.5.29.15');
1180   my $extKeyUsage = DEROID('2.5.29.37');
1181   my $serverAuth = DEROID('1.3.6.1.5.5.7.3.1');
1182   my $clientAuth = DEROID('1.3.6.1.5.5.7.3.2');
1183   my $codeSigning = DEROID('1.3.6.1.5.5.7.3.3');
1184   my $emailProtection = DEROID('1.3.6.1.5.5.7.3.4');
1185   my $appleCodeSigning = DEROID('1.2.840.113635.100.4.1');
1186   my $authKeyId = DEROID('2.5.29.35');
1187   my $subjKeyId = DEROID('2.5.29.14');
1188   my $subjAltName = DEROID('2.5.29.17');
1189   my $boolTRUE = pack('C*',0x01,0x01,0xFF);
1190   my $boolFALSE = pack('C*',0x01,0x01,0x00);
1191   my $v3Begin = pack('C',0x17).DERLength(13)."970811000000Z";
1192   my $noExpiry = pack('C',0x18).DERLength(15)."99991231235959Z";
1193   my $infile = '-';
1194   my $outfile = '-';
1195   my @suffixfiles = ();
1196   my $suffix = '';
1197   my $qualifier = undef;
1198
1199   #tests;
1200   eval {GetOptions(
1201       "help|h" => sub{$help=1;die"!FINISH"},
1202       "verbose|v" => \$verbose,
1203       "version|V" => sub{print STDERR $VERSIONMSG;exit(0)},
1204       "debug" => \$debug,
1205       "quiet" => \$quiet,
1206       "pubx509" => \$pubx509,
1207       "pubX509" => \$pubx509,
1208       "check" => \$check,
1209       "now" => \$useNow,
1210       "random" => \$useRandom,
1211       "no-random" => \$useNoRandom,
1212       "t" => \$termOK,
1213       "server" => \$server,
1214       "codesign" => \$codesign,
1215       "applecodesign" => \$applecodesign,
1216       "email" => \$email,
1217       "client" => \$client,
1218       "subca" => \$subca,
1219       "root" => \$root,
1220       "rootauth" => \$rootauth,
1221       "authext" => \$authext,
1222       "digest=s" => \$digestChoice,
1223       "key|k=s" => \$keyfile,
1224       "cert|c=s" => \$certfile,
1225       "pathlen=i" => \$pathlen,
1226       "in=s" => \$infile,
1227       "out=s" => \$outfile,
1228       "suffix=s" => sub{push(@suffixfiles, $_[1]);},
1229       "dnq=s" => \$qualifier
1230     )} || $help
1231       or die $USAGE;
1232   if ($help) {
1233     local *MAN;
1234     my $pager = $ENV{'PAGER'} || 'less';
1235     if (-t STDOUT && open(MAN, "|-", $pager)) {
1236       print MAN formatman($HELP,1);
1237       close(MAN);
1238     }
1239     else {
1240       print formatman($HELP);
1241     }
1242     exit(0);
1243   }
1244   die "--in requires a filename\n" if !$root && !$infile;
1245   die "--out requires a filename\n" if !$outfile;
1246   foreach my $suffixfile (@suffixfiles) {
1247     die "--suffix requires a filename\n" if defined($suffixfile) && !$suffixfile;
1248     die "--suffix file '$suffixfile' does not exist or is not readable\n"
1249       if ! -e $suffixfile || ! -r $suffixfile;
1250   }
1251   $client = 1 if
1252     !$root && !$subca && !$server && !$codesign && !$applecodesign && !$email;
1253   $verbose = 1 if $debug || $check;
1254   $quiet = 0 if $verbose || $check;
1255   print STDERR $VERSIONMSG if $verbose;
1256   my $keytype = 'OpenSSH';
1257   my $n = 'n';
1258   $keytype = 'pubx509', $n = '' if $pubx509;
1259   die $USAGE if $root && $useRandom && $useNoRandom;
1260   die $USAGE if !$keyfile || (!$root && !$certfile) || (!$check && @ARGV != 1);
1261   die "Standard input is a tty (which is an unlikely source of a$n $keytype "
1262     . "public key)\n"
1263     . "If that's what you truly meant, add the -t option to allow it.\n"
1264     if !$root && $infile eq '-' && -t STDIN && !$termOK;
1265   $useRandom = 1 if $root && !$useNoRandom;
1266   die "Name may not be empty\n"
1267     unless $check || $ARGV[0] || ($root && $useRandom);
1268   die "Distinguished name qualifier may not be empty string\n"
1269     unless !defined($qualifier) || $qualifier;
1270   die "Invalid distinguished name qualifier (must match [A-Za-z0-9 '()+,./:=?-]+)\n"
1271     unless !$qualifier || $qualifier =~ m|^[A-Za-z0-9 '()+,./:=?-]+$|;
1272   my $opensshdotpub;
1273   my $infilename;
1274   foreach my $suffixfile (@suffixfiles) {
1275     open(SUFFIX, '<', $suffixfile)
1276       or die "Cannot open '$suffixfile' for input: $!\n";
1277     local $/;
1278     $suffix .= <SUFFIX>;
1279     close(SUFFIX);
1280   }
1281   if (!$root) {
1282     local $/ if $pubx509;
1283     my $input;
1284     if ($infile ne '-') {
1285       $infilename = "\"$infile\"";
1286       open($input, '<', $infile)
1287         or die "Cannot open $infilename for input: $!\n";
1288     } else {
1289       $input = *STDIN;
1290       $infilename = 'standard input';
1291     }
1292     !!($opensshdotpub = <$input>)
1293       or die "Cannot read $keytype public key from $infilename\n";
1294     if (!$pubx509) {
1295       my $auto509 = 0;
1296       if ($opensshdotpub =~ /^----[- ]BEGIN PUBLIC KEY[- ]----/) {
1297         $auto509 = 1;
1298       }
1299       else {
1300         my $input = $opensshdotpub;
1301         $input =~ s/((?:\r\n|\n|\r).*)$//os;
1302         my @fields = split(' ', $input, 3);
1303         if (@fields < 2 ||
1304             length($fields[1]) < 16 ||
1305             $fields[1] !~ m|^[0-9A-Za-z+/=]+$|) {
1306           $auto509 = 1;
1307         }
1308       }
1309       if ($auto509) {
1310         $pubx509 = 1;
1311         $keytype = 'pubx509';
1312         print STDERR "auto detected --pubx509 option\n" if $debug;
1313         local $/;
1314         my $extra = <$input>;
1315         $opensshdotpub .= $extra if $extra;
1316       }
1317     }
1318     close($input) if $infile ne '-';
1319   }
1320   die "Cannot read key file $keyfile\n" if ! -r $keyfile;
1321   die "Cannot read certificate file $certfile\n" if !$root && ! -r $certfile;
1322
1323   my ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub);
1324   if ($root) {
1325     # need to set $sshkeyid to $pubkeyid
1326     # need to set $opensshpub to $pubkey
1327     # but don't have either yet, so do it later
1328   }
1329   elsif ($pubx509) {
1330     local (*READKEY, *WRITEKEY);
1331     my $inform = $opensshdotpub =~ m|^[\t\n\r\x20-\x7E]*$|os ? 'PEM' : 'DER';
1332     print STDERR "pubx509 -inform $inform\n" if $debug;
1333     open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1334     open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1335     my $pid = open2(\*READKEY, \*WRITEKEY, "openssl", "rsa", "-inform",
1336       $inform, "-pubin", "-outform", "DER", "-pubout");
1337     open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1338     $pid or die "Cannot start openssl rsa\n";
1339     print WRITEKEY $opensshdotpub;
1340     close(WRITEKEY);
1341     local $/;
1342     die "Error reading X.509 format RSA public key from $infilename\n"
1343       unless !!($opensshpub = <READKEY>);
1344     waitpid($pid, 0);
1345     close(READKEY);
1346     $sshcmnt = undef;
1347     ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1) = GetKeyInfo($opensshpub);
1348     die "Unparseable X.509 public key format read from $infilename\n"
1349       unless $sshkeybits;
1350   }
1351   else {
1352     ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub) =
1353       GetOpenSSHKeyInfo($opensshdotpub);
1354     die "Unparseable OpenSSH public key read from $infilename\n"
1355       unless $sshkeybits;
1356     die "Unsupported OpenSSH public key type ($sshkeybits), must be ssh-rsa\n"
1357       unless $sshkeyexp;
1358   }
1359   my $sshkeystrength;
1360   if (!$root) {
1361     my $sshkeyapprox;
1362     ($sshkeystrength, $sshkeyapprox) = compute_rsa_strength($sshkeybits);
1363     printf(STDERR "$keytype Public Key Info:\n".
1364         "  bits=$sshkeybits pubexp=$sshkeyexp secstrenth=%s%s\n",
1365         $sshkeystrength, ($sshkeyapprox ? ' (approximately)' : '')) if $verbose;
1366     print STDERR "  keyid=",
1367       join(":", toupper(unpack("H*",$sshkeyid))=~/../g), "\n" if $verbose;
1368     print STDERR "  fingerprint(md5)=",
1369       join(":", tolower(unpack("H*",$sfmd5))=~/../g), "\n" if $verbose;
1370     print STDERR "  fingerprint(sha1)=",
1371       join(":", tolower(unpack("H*",$sfsha1))=~/../g), "\n" if $verbose;
1372     print STDERR "  comment=",$sshcmnt||'<none present>',"\n"
1373       if $verbose && !$pubx509;
1374     die "*** Error: $keytype key has less than 512 bits ($sshkeybits)\n"
1375       . "***        You might as well just donate your system to hackers now.\n"
1376       if $sshkeybits < 512;
1377     die "*** Error: The $keytype key's public exponent is even ($sshkeyexp)!\n"
1378       if !($sshkeyexp & 0x01);
1379     warn "*** Warning: The $keytype key has less than 2048 bits ($sshkeybits), "
1380       . "continuing anyway\n" if !$quiet && $sshkeybits < 2048;
1381     die "*** Error: The $keytype public key's exponent of $sshkeyexp is "
1382       . "unacceptably weak!\n" if $sshkeyexp < 35; # OpenSSH used 35 until v5.4
1383     warn "*** Warning: The $keytype public key's exponent ($sshkeyexp) is weak "
1384       . "(< 65537), continuing anyway\n" if !$quiet && $sshkeyexp < 65537;
1385   }
1386
1387   my $inform = -T $keyfile ? 'PEM' : 'DER';
1388   print STDERR "keyfile -inform $inform\n" if $debug;
1389   die "Input key does not appear to be in PEM format: $keyfile\n"
1390     unless $inform eq 'PEM';
1391   my $pubkey;
1392   {
1393     local *READKEY;
1394     open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1395     open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1396     open(READKEY, "-|", "openssl", "rsa", "-inform", $inform, "-outform", "DER",
1397         "-pubout", "-passin", "pass:", "-in", $keyfile)
1398       or die "Cannot read RSA private key in \"$keyfile\": $!\n";
1399     open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1400     local $/;
1401     die "Error reading RSA private key in \"$keyfile\"\n"
1402       unless !!($pubkey = <READKEY>);
1403     close(READKEY);
1404   }
1405   $opensshpub = $pubkey if $root;
1406   my ($pubkeybits,$pubkeyexp,$pubkeyid,$pfmd5,$pfsha1) = GetKeyInfo($pubkey);
1407   $sshkeyid = $pubkeyid if $root;
1408   die "Unparseable public key format in \"$keyfile\"\n" unless $pubkeybits;
1409   my ($pubkeystrength, $pubkeyapprox) = compute_rsa_strength($pubkeybits);
1410   printf(STDERR "RSA Private Key $keyfile:\n".
1411     "  bits=$pubkeybits pubexp=$pubkeyexp secstrength=%s%s\n",
1412     $pubkeystrength, ($pubkeyapprox?' (approximately)':'')) if $verbose;
1413   print STDERR "  keyid=",
1414     join(":", toupper(unpack("H*",$pubkeyid))=~/../g), "\n" if $verbose;
1415   print STDERR "  fingerprint(md5)=",
1416     join(":", tolower(unpack("H*",$pfmd5))=~/../g), "\n" if $verbose;
1417   print STDERR "  fingerprint(sha1)=",
1418     join(":", tolower(unpack("H*",$pfsha1))=~/../g), "\n" if $verbose;
1419   die "*** Error: Private key has less than 512 bits ($pubkeybits)\n"
1420     . "***        You might as well just donate your system to hackers now.\n"
1421     if $pubkeybits < 512;
1422   die "*** Error: The private key's public exponent is even ($pubkeyexp)!\n"
1423     if !($pubkeyexp & 0x01);
1424   warn "*** Warning: The private key has less than 2048 bits ($pubkeybits), "
1425     . "continuing anyway\n" if !$quiet && $pubkeybits < 2048;
1426   die "*** Error: The private key's public key exponent of $pubkeyexp is "
1427     . "unacceptably weak!\n" if $pubkeyexp < 35; # ssh-keygen used 35 'til v5.4
1428   warn "*** Warning: The private key's public exponent ($pubkeyexp) is weak "
1429     . "(< 65537), continuing anyway\n" if !$quiet && $pubkeyexp < 65537;
1430
1431   my $maxkeystrength = $pubkeystrength;
1432   $maxkeystrength = $sshkeystrength
1433     if $sshkeystrength && $sshkeystrength > $maxkeystrength;
1434   my $digeststrength = GetDigestStrength($digestChoice || $digest);
1435   my $digestsuggest = GetDigestNameForBits($maxkeystrength);
1436   my $digestsuggestbits = GetDigestStrength($digestsuggest);
1437   # Never warn or auto-choose if both keys are <= 1024 bits in length
1438   if ($maxkeystrength > 80) {
1439     if (!$digestChoice) {
1440       if (!$hasSha2 && $digestsuggestbits > $digeststrength) {
1441         warn "*** Warning: automatic digest selection $digestsuggest ".
1442           "support not available\n" unless $quiet;
1443       } else {
1444         $digest = $digestsuggest;
1445       }
1446     }
1447   }
1448   my ($did, $dalg, $dfunc) = GetDigest($digestChoice || $digest);
1449   print STDERR "default digest: $digest\n" if $debug;
1450   if ($digestChoice && $digestsuggestbits > $digeststrength) {
1451     warn "*** Warning: $digestsuggest (or stronger) is recommended for strength ".
1452       "$maxkeystrength keys, continuing anyway\n" unless $quiet;
1453   }
1454   warn "*** Warning: defaulting to sha1 since SHA-2 support not available\n"
1455     if !$quiet && $digest eq 'sha1' && !$digestChoice;
1456   $digest = $digestChoice if $digestChoice;
1457   warn "*** Warning: sha1 use is strongly discouraged, continuing anyway\n"
1458     if !$quiet && $digest eq 'sha1';
1459   print STDERR "Using digest $digest\n" if $verbose;
1460
1461   my ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid);
1462   if ($root) {
1463     $vst = $v3Begin;
1464     $vnd = $noExpiry;
1465     $subjkeyid = $pubkeyid;
1466   }
1467   else {
1468     $inform = -T $certfile ? 'PEM' : 'DER';
1469     print STDERR "certfile -inform $inform\n" if $debug;
1470     my $signcert;
1471     {
1472       local *READCERT;
1473       #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1474       #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1475       open(READCERT, "-|", "openssl", "x509", "-inform", $inform, "-outform",
1476           "DER", "-in", $certfile)
1477         or die "Cannot read X.509 certificate in \"$certfile\"\n";
1478       #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1479       local $/;
1480       die "Error reading X.509 certificate in \"$certfile\"\n"
1481         unless !!($signcert = <READCERT>);
1482       close(READCERT);
1483     }
1484     ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid) =
1485       GetCertInfo($signcert);
1486     die "Unparseable certificate format in \"$certfile\"\n" unless $cver;
1487     my $dser = $cser;
1488     substr($dser,0,1) = '' if unpack('C',substr($cser,0,1)) == 0x00;
1489     print STDERR "X.509 Certificate $certfile:\n",
1490       "  ver=v$cver serial=", join(":", tolower(unpack("H*",$dser))=~/../g),"\n"
1491       if $verbose;
1492     print STDERR "  notBefore=",DERTimeStr($vst)||'Invalid Time',
1493       " notAfter=",DERTimeStr($vnd)||'Invalid Time',"\n" if $verbose;
1494     #print STDERR "  issuer=",DERNameStr($issuer),"\n" if $verbose;
1495     #print STDERR "  name=",DERNameStr($subj),"\n" if $verbose;
1496     print STDERR "  subj_keyid=", join(":", toupper(
1497       unpack("H*",$subjkeyid))=~/../g), "\n" if defined($subjkeyid) && $verbose;
1498     die "The private key is not the correct one for the certificate:\n".
1499       "  certificate: $certfile\n".
1500       "  private key: $keyfile\n" unless $subjkey eq $pubkey;
1501     if (!defined($subjkeyid)) {
1502       warn "*** Warning: The certificate has no subjectKeyIdentifier, "
1503         . "using RFC 5280 (1)\n";
1504       $subjkeyid = $pubkeyid;
1505     }
1506     warn "*** Warning: subjectKeyIdentifier non-standard, continuing anyway\n"
1507       unless $subjkeyid eq $pubkeyid;
1508     die "*** Error: The $keytype public key is the same as the certificate's "
1509       . "public key.\n"
1510       . "***        They must be different for security reasons.\n"
1511       if $pubkey eq $opensshpub;
1512   }
1513   return 0 if $check;
1514
1515   my $version = pack('CCCCC', 0xA0, 0x03, 0x02, 0x01, 0x02); # v3
1516   my $randval = $useRandom ? RandomID($quiet) : undef;
1517   my $sigAlg = $dalg . pack('CC',0x05,0x00);
1518   $sigAlg = pack('C',0x30).DERLength(length($sigAlg)).$sigAlg;
1519   my $name = MakeUTF8($ARGV[0]);
1520   $name = pack('C',$email?0x16:0x0C).DERLength(length($name)).$name;
1521   $name = (($server || $codesign || $subca || $root || $applecodesign) ? $commonName :
1522     ($email ? $emailAddress : $userId)) . $name;
1523   $name = pack('C',0x30).DERLength(length($name)).$name;
1524   $name = pack('C',0x31).DERLength(length($name)).$name;
1525   if ($root && $useRandom) {
1526     my $serialRDN = join(":", tolower(unpack("H*",$randval))=~/../g);
1527     $serialRDN = pack('C',0x13).DERLength(length($serialRDN)).$serialRDN;
1528     $serialRDN = $serialNumber . $serialRDN;
1529     $serialRDN = pack('C',0x30).DERLength(length($serialRDN)).$serialRDN;
1530     $serialRDN = pack('C',0x31).DERLength(length($serialRDN)).$serialRDN;
1531     $name = $serialRDN . ($ARGV[0] ? $name : '');
1532   }
1533   if ($qualifier) {
1534     my $dnq = $qualifier;
1535     $dnq = pack('C',0x13).DERLength(length($dnq)).$dnq;
1536     $dnq = $dnQualifier . $dnq;
1537     $dnq = pack('C',0x30).DERLength(length($dnq)).$dnq;
1538     $dnq = pack('C',0x31).DERLength(length($dnq)).$dnq;
1539     $name .= $dnq;
1540   }
1541   $name = pack('C',0x30).DERLength(length($name)).$name;
1542   $subj = $name if $root;
1543   my $validity = ($useNow ? DERTime(time()) : $vst).$vnd;
1544   $validity = pack('C',0x30).DERLength(length($validity)).$validity;
1545   my $extCAVal;
1546   if ($subca || $root) {
1547     $extCAVal = $boolTRUE;
1548     if ($subca && $pathlen ne '') {
1549       $extCAVal .= DERInteger($pathlen);
1550     }
1551     $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
1552   }
1553   else {
1554     #$extCAVal = pack('C',0x30).DERLength(length($boolFALSE)).$boolFALSE;
1555     $extCAVal = pack('C',0x30).DERLength(0); # do not include DEFAULT value
1556   }
1557   $extCAVal = pack('C',0x04).DERLength(length($extCAVal)).$extCAVal;
1558   $extCAVal = $basicConstraints . $boolTRUE . $extCAVal;
1559   $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
1560   my $extKeyBits = ($subca || $root)  ? '0186' :
1561     ($server ? '05A0' : ($email ? '05E0' : '0780'));
1562   my $extKeyUse = pack('H*', '04040302'.$extKeyBits);
1563   $extKeyUse = $keyUsage . $boolTRUE. $extKeyUse;
1564   $extKeyUse = pack('C',0x30).DERLength(length($extKeyUse)).$extKeyUse;
1565   my $extXKeyUse = '';
1566   if ($server || $client || $codesign || $email || $applecodesign) {
1567     $extXKeyUse .= $serverAuth if $server;
1568     $extXKeyUse .= $clientAuth if $client;
1569     $extXKeyUse .= $codeSigning if $codesign;
1570     $extXKeyUse .= $emailProtection if $email;
1571     $extXKeyUse .= $appleCodeSigning if $applecodesign;
1572     $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
1573     $extXKeyUse = pack('C',0x04).DERLength(length($extXKeyUse)).$extXKeyUse;
1574     $extXKeyUse = $extKeyUsage . $boolTRUE . $extXKeyUse;
1575     $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
1576   }
1577   my $extSubjKey = pack('C',0x04).DERLength(length($sshkeyid)).$sshkeyid;
1578   $extSubjKey = pack('C',0x04).DERLength(length($extSubjKey)).$extSubjKey;
1579   $extSubjKey = $subjKeyId . $extSubjKey;
1580   $extSubjKey = pack('C',0x30).DERLength(length($extSubjKey)).$extSubjKey;
1581   my $extAuthKey = '';
1582   if (!$root || $rootauth) {
1583     $extAuthKey = pack('C',0x80).DERLength(length($pubkeyid)).$pubkeyid;
1584     if (!$root && $authext) {
1585       my $gen = pack('C',0xA4).DERLength(length($issuer)).$issuer;
1586       $extAuthKey .= pack('C',0xA1).DERLength(length($gen)).$gen;
1587       $extAuthKey .= pack('C',0x82).DERLength(length($cser)).$cser;
1588     }
1589     $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
1590     $extAuthKey = pack('C',0x04).DERLength(length($extAuthKey)).$extAuthKey;
1591     $extAuthKey = $authKeyId . $extAuthKey;
1592     $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
1593   }
1594   my $exts = $extCAVal . $extKeyUse . $extXKeyUse . $extSubjKey . $extAuthKey;
1595   if ($email) {
1596     my $extSubjAlt = MakeUTF8($ARGV[0]);
1597     $extSubjAlt = pack('C',0x81).DERLength(length($extSubjAlt)).$extSubjAlt;
1598     $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
1599     $extSubjAlt = pack('C',0x04).DERLength(length($extSubjAlt)).$extSubjAlt;
1600     $extSubjAlt = $subjAltName . $extSubjAlt; # not crit unless empty DN
1601     $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
1602     $exts .= $extSubjAlt;
1603   }
1604   $exts = pack('C',0x30).DERLength(length($exts)).$exts;
1605   $exts = pack('C',0xA3).DERLength(length($exts)).$exts;
1606   my $serial;
1607   if ($useRandom) {
1608     $serial = pack('C',0x2).DERLength(length($randval)).$randval;
1609   }
1610   else {
1611     my $idtohash = $version.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
1612     $idtohash = pack('C',0x30).DERLength(length($idtohash)).$idtohash;
1613     my $idhash = sha1($idtohash);
1614     my $byte0 = unpack('C',substr($idhash,0,1));
1615     $byte0 &= 0x7F;
1616     substr($idhash,0,1) = pack('C',$byte0);
1617     $serial = pack('C',0x2).DERLength(length($idhash)).$idhash;
1618   }
1619   my $tbs = $version.$serial.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
1620   $tbs = pack('C',0x30).DERLength(length($tbs)).$tbs;
1621   my $tbsseq = &$dfunc($tbs);
1622   $tbsseq = pack('C',0x04).DERLength(length($tbsseq)).$tbsseq;
1623   my $algid = $did . pack('CC',0x05,0x00);
1624   $algid = pack('C',0x30).DERLength(length($algid)).$algid;
1625   $tbsseq = $algid . $tbsseq;
1626   $tbsseq = pack('C',0x30).DERLength(length($tbsseq)).$tbsseq;
1627   my $sig = RSASign($tbsseq, $keyfile);
1628   $sig = pack('C',0x03).DERLength(length($sig)+1).pack('C',0x00).$sig;
1629   my $cert = $tbs . $sigAlg . $sig;
1630   $cert = pack('C',0x30).DERLength(length($cert)).$cert;
1631   my $base64 = join("\n", BreakLine(encode_base64($cert, ''), 64))."\n";
1632   my $output;
1633   if ($outfile ne '-') {
1634     open($output, ">", $outfile)
1635       or die "Cannot open \"$outfile\" for output: $!\n";
1636   } else {
1637     $output = *STDOUT;
1638   }
1639   print $output "-----BEGIN CERTIFICATE-----\n",
1640                 $base64,
1641                 "-----END CERTIFICATE-----\n",
1642                 $suffix;
1643   close($output) if $outfile ne '-';
1644   return 0;
1645 }