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.6';
  39   $VERSIONMSG = "CACreateCert version $VERSION\n" .
  40     "Copyright (c) 2011-2013 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] [--random|--no-random]
 108         --key priv_key_file [--cert signing_cert] "name string"
 109         [< pub_key_file] > out_cert.pem
 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] [--random|--no-random]
 120         --key priv_key_file [--cert signing_cert] "name string"
 121         [< pub_key_file] > out_cert.pem
 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.
 228
 229        --digest name
 230               Select the digest to use in the generated certificate.  Must be
 231               one of sha1, sha224, sha256, sha384 or sha512.  By default sha256
 232               will be used if available otherwise sha1 will be used (and a
 233               warning issued).  All systems support sha1 digest certificates,
 234               but sha1 should really not be used anymore (see NIST
 235               recommendation SP 800-131A).  OpenSSL starting with version 0.9.8
 236               (released 2005-07-05) supports the SHA-2 family of hash functions
 237               (sha224, sha256, sha384 and sha512) which should be used instead
 238               of sha1.  Note that either Digest::SHA or Digest::SHA::PurePerl
 239               must be available to use sha224, sha256, sha384 or sha512.
 240
 241        --root
 242        --subca
 243        --server
 244        --codesign
 245        --applecodesign
 246        --email
 247        --client
 248               Select the type of certificate to generate.  If --root is given
 249               then a root certificate will be created and any --cert option will
 250               be ignored as well as standard input.  If none of these options is
 251               given then --client will be assumed.  Both --root and --subca
 252               generate certificate authority certificates (CA:TRUE).
 253               Specifying any of --root, --subca, --server, --codesign or
 254               --applecodesign will cause the "name string" to be embedded as
 255               a commonName (CN).  Otherwise if --email is specified
 256               "name string" will be embedded as an emailAddress (and a subject
 257               alternative name email type).  Finally if none of those apply then
 258               "name string" will be embedded as a userId (UID) instead
 259               (client certificates).  The certificate's key usage bits will be
 260               set to one of four values.  --root or --subca select the first,
 261               --server selects the second, --email selects the third otherwise
 262               the fourth is used.  If any of --server, --client (explicit or
 263               implied), --codesign, --email or --applecodesign are given then
 264               extended key usage items will be included (up to five -- one for
 265               each option given).
 266
 267        --pathlen n
 268               The --pathlen option will be ignored unless --subca is given in
 269               which case the X509v3 Basic Constraints will include the
 270               specified pathlen value.
 271
 272        --rootauth
 273               Ignored unless --root given.  Normally --root certificates do not
 274               include an X509v3 Authority Key Identifier.  If this option is
 275               given then they will (with only a keyid value).
 276
 277        --authext
 278               Ignored if --root given.  Normally non --root certificates include
 279               an X509v3 Authority Key Identifier section with only a keyid
 280               value.  If this option is given, then the name and serial number
 281               will also be included.
 282
 283        --random
 284               Ignored unless --root given.  When generating a --root certificate
 285               normally only the "name string" value is embedded (as the CN
 286               attribute).  If this option is given, a random serialNumber will
 287               be generated and the issuer name will be the serialNumber followed
 288               by the CN.  If this option is given, the "name string" may be set
 289               to the empty string (it must be explicit, e.g. "") in which case
 290               the issuer name will be just the random serialNumber.  Use of this
 291               option will preclude production of byte-exact matching output
 292               certificates for the same input arguments.  This is now the
 293               default when --root is given.
 294
 295        --no-random
 296               Ignored unless --root given.  Turns off the default --random
 297               option that is normally enabled by default when --root is given.
 298
 299        --key priv_key_file
 300               The RSA private key in either PEM or DER format.  This option
 301               is always required.
 302
 303        --cert signing_cert
 304               Ignored if --root is given.  The signing X.509 certificate in
 305               either PEM or DER format.  The public key embedded in signing_cert
 306               must match the one in the priv_key_file or an error will occur.
 307
 308        < pub_key_file
 309               Ignored if --root is given.  The public key for the certificate
 310               to be created.  Must be different than the public key contained in
 311               priv_key_file.  May be an OpenSSH protocol 2 format RSA public key
 312               or an X.509 format public key (in either PEM or DER format).  See
 313               also the --pubx509 option.
 314
 315 NOTES
 316        All systems support sha1 digest certificates, but sha1 should really not
 317        be used anymore (NIST recommendation SP 800-131A).  OpenSSL starting
 318        with versions 0.9.8 (released 2005-07-05) supports the SHA-2 family of
 319        hash functions (sha224, sha256, sha384 and sha512) which should be used
 320        instead.
 321
 322        NIST SP 800-131A requires use of an RSA key with 2048 or more bits and
 323        a hash function with 224 or more bits after December 31 2010.
 324
 325        RFC 6194 states sha256 is the most commonly used alternative to sha1
 326        (and will be used by default if a suitable SHA module is available).
 327
 328        Note that NIST SP 800-78-3 requires RSA public key exponents to be
 329        greater than or equal to 65537.  OpenSSH version 5.4 and later generate
 330        RSA keys with a public exponent of 65537 otherwise openssl genrsa can
 331        be used together with ssh-keygen -y to create a suitable OpenSSH key that
 332        uses an exponent of 65537 instead of 35.
 333
 334 TIPS
 335        Display the currently available version of OpenSSL with:
 336
 337            openssl version
 338
 339        Display the currently available version of OpenSSH with:
 340
 341            ssh -V
 342 HELP
 343 }
 344
 345 sub IsUTF8($)
 346 {
 347   # Return 0 if non-UTF-8 sequences present
 348   # Return -1 if no characters > 0x7F found
 349   # Return 1 if valid UTF-8 sequences present
 350   use bytes;
 351   return -1 if $_[0] !~ /[\x80-\xFF]/so;
 352   my $l = length($_[0]);
 353   for (my $i=0; $i<$l; ++$i) {
 354     my $c = ord(substr($_[0],$i,1));
 355     next if $c < 0x80;
 356     return 0 if $c < 0xC0 || $c >= 0xF8;
 357     if ($c <= 0xDF) {
 358       # Need 1 more byte
 359       ++$i;
 360       return 0 if $i >= $l;
 361       my $c2 = ord(substr($_[0],$i,1));
 362       return 0 if $c2 < 0x80 || $c2 > 0xBF;
 363       my $u = (($c & 0x1F) << 6) | ($c2 & 0x3F);
 364       return 0 if $u < 0x80;
 365       next;
 366     }
 367     if ($c <= 0xEF) {
 368       # Need 2 more bytes
 369       $i += 2;
 370       return 0 if $i >= $l;
 371       my $c2 = ord(substr($_[0],$i-1,1));
 372       return 0 if $c2 < 0x80 || $c2 > 0xBF;
 373       my $c3 = ord(substr($_[0],$i,1));
 374       return 0 if $c3 < 0x80 || $c3 > 0xBF;
 375       my $u = (($c & 0x0F) << 12) | (($c2 & 0x3F) << 6) | ($c3 & 0x3F);
 376       return 0 if $u < 0x800 || ($u >= 0xD800 && $u <= 0xDFFFF) || $u >= 0xFFFE;
 377       next;
 378     }
 379     # Need 3 more bytes
 380     $i += 3;
 381     return 0 if $i >= $l;
 382     my $c2 = ord(substr($_[0],$i-2,1));
 383     return 0 if $c2 < 0x80 || $c2 > 0xBF;
 384     my $c3 = ord(substr($_[0],$i-1,1));
 385     return 0 if $c3 < 0x80 || $c3 > 0xBF;
 386     my $c4 = ord(substr($_[0],$i,1));
 387     return 0 if $c4 < 0x80 || $c4 > 0xBF;
 388     my $u = (($c & 0x07) << 18) | (($c2 & 0x3F) << 12) | (($c3 & 0x3F) << 6)
 389                                                                  | ($c4 & 0x3F);
 390     return 0 if $u < 0x10000 || $u >= 0x10FFFE || (($u & 0xFFFF) >= 0xFFFE);
 391   }
 392   return 1;
 393 }
 394
 395 sub Make1252()
 396 {
 397   use bytes;
 398   our %W1252;
 399
 400   # Provide translations for 0x80-0x9F into UTF-8
 401   $W1252{0x80} = pack('H*','E282AC'); # 0x20AC Euro
 402   $W1252{0x82} = pack('H*','E2809A'); # 0X201A Single Low-9 Quote
 403   $W1252{0x83} = pack('H*','C692');   # 0x0192 Latin Small Letter f With Hook
 404   $W1252{0x84} = pack('H*','E2809E'); # 0x201E Double Low-9 Quote
 405   $W1252{0x85} = pack('H*','E280A6'); # 0x2026 Horizontal Ellipsis
 406   $W1252{0x86} = pack('H*','E280A0'); # 0x2020 Dagger
 407   $W1252{0x87} = pack('H*','E280A1'); # 0x2021 Double Dagger
 408   $W1252{0x88} = pack('H*','CB86');   # 0x02C6 Modifier Letter Circumflex Accent
 409   $W1252{0x89} = pack('H*','E28080'); # 0x2030 Per Mille Sign
 410   $W1252{0x8A} = pack('H*','C5A0');   # 0x0160 Latin Capital Letter S With Caron
 411   $W1252{0x8B} = pack('H*','E28089'); # 0x2039 Left Single Angle Quote
 412   $W1252{0x8C} = pack('H*','C592');   # 0x0152 Latin Capital Ligature OE
 413   $W1252{0x8E} = pack('H*','C5BD');   # 0x017D Latin Capital Letter Z With Caron
 414   $W1252{0x91} = pack('H*','E28098'); # 0x2018 Left Single Quote
 415   $W1252{0x92} = pack('H*','E28099'); # 0x2019 Right Single Quote
 416   $W1252{0x93} = pack('H*','E2809C'); # 0x201C Left Double Quote
 417   $W1252{0x94} = pack('H*','E2809D'); # 0x201D Right Double Quote
 418   $W1252{0x95} = pack('H*','E280A2'); # 0x2022 Bullet
 419   $W1252{0x96} = pack('H*','E28093'); # 0x2013 En Dash
 420   $W1252{0x97} = pack('H*','E28094'); # 0x2014 Em Dash
 421   $W1252{0x98} = pack('H*','CB9C');   # 0x02DC Small Tilde
 422   $W1252{0x99} = pack('H*','E284A2'); # 0x2122 Trade Mark Sign
 423   $W1252{0x9A} = pack('H*','C5A1');   # 0x0161 Latin Small Letter s With Caron
 424   $W1252{0x9B} = pack('H*','E2808A'); # 0x203A Right Single Angle Quote
 425   $W1252{0x9C} = pack('H*','C593');   # 0x0153 Latin Small Ligature oe
 426   $W1252{0x9E} = pack('H*','C5BE');   # 0x017E Latin Small Letter z With Caron
 427   $W1252{0x9F} = pack('H*','C5B8');   # 0x0178 Latin Cap Letter Y With Diaeresis
 428 }
 429
 430 sub MakeUTF8($)
 431 {
 432   use bytes;
 433   our %W1252;
 434
 435   return $_[0] if (IsUTF8($_[0]));
 436   my $ans = '';
 437   foreach my $c (unpack('C*',$_[0])) {
 438     if ($c < 0x80) {
 439       $ans .= chr($c);
 440     }
 441     else {
 442       # Ass/u/me we have Latin-1 (ISO-8859-1) but per the HTML 5 draft treat
 443       # it as windows-1252
 444       if ($c >= 0xA0 || !defined($W1252{$c})) {
 445         $ans .= chr(0xC0 | ($c >> 6));
 446         $ans .= chr(0x80 | ($c & 0x3F));
 447       }
 448       else {
 449         $ans .= $W1252{$c};
 450       }
 451     }
 452   }
 453   return $ans;
 454 }
 455
 456 sub formatbold($;$)
 457 {
 458   my $str = shift;
 459   my $fancy = shift || 0;
 460   if ($fancy) {
 461     $str = join('',map($_."\b".$_, split(//,$str)));
 462   }
 463   return $str;
 464 }
 465
 466 sub formatul($;$)
 467 {
 468   my $str = shift;
 469   my $fancy = shift || 0;
 470   if ($fancy) {
 471     $str = join('',map("_\b".$_, split(//,$str)));
 472   }
 473   return $str;
 474 }
 475
 476 sub formatman($;$)
 477 {
 478   my $man = shift;
 479   my $fancy = shift || 0;
 480   my @inlines = split(/\n/, $man, -1);
 481   my @outlines = ();
 482   foreach my $line (@inlines) {
 483     if ($line =~ /^[A-Z]+$/) {
 484       $line = formatbold($line, $fancy);
 485     }
 486     else {
 487       $line =~ s/'''(.+?)'''/formatbold($1,$fancy)/gse;
 488       $line =~ s/''(.+?)''/formatul($1,$fancy)/gse;
 489     }
 490     push (@outlines, $line);
 491   }
 492   my $result = join("\n", @outlines);
 493   $result =~ s/\\\n//gso;
 494   return $result;
 495 }
 496
 497 sub DERLength($)
 498 {
 499   # return a DER encoded length
 500   my $len = shift;
 501   return pack('C',$len) if $len <= 127;
 502   return pack('C2',0x81, $len) if $len <= 255;
 503   return pack('Cn',0x82, $len) if $len <= 65535;
 504   return pack('CCn',0x83, ($len >> 16), $len & 0xFFFF) if $len <= 16777215;
 505   # Silently returns invalid result if $len > 2^32-1
 506   return pack('CN',0x84, $len);
 507 }
 508
 509 sub SingleOID($)
 510 {
 511   # return a single DER encoded OID component
 512   no warnings;
 513   my $num = shift;
 514   $num += 0;
 515   my $result = pack('C', $num & 0x7F);
 516   $num >>= 7;
 517   while ($num) {
 518     $result = pack('C', 0x80 | ($num & 0x7F)) . $result;
 519     $num >>= 7;
 520   }
 521   return $result;
 522 }
 523
 524 sub DEROID($)
 525 {
 526   # return a DER encoded OID complete with leading 0x06 and DER length
 527   # Input is a string of decimal numbers separated by '.' with at least
 528   # two numbers required.
 529   no warnings;
 530   my @ids = split(/[.]/,$_[0]);
 531   push(@ids, 0) while @ids < 2; # return something that's kind of valid
 532   unshift(@ids, shift(@ids) * 40 + shift(@ids)); # combine first two
 533   my $ans = '';
 534   foreach my $num (@ids) {
 535     $ans .= SingleOID($num);
 536   }
 537   return pack('C',0x6).DERLength(length($ans)).$ans;
 538 }
 539
 540 sub DERTime($)
 541 {
 542   my $t = shift; # a time() value
 543   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t);
 544   $year += 1900;
 545   ++$mon;
 546   my $tag;
 547   my $tstr;
 548   if (1950 <= $year && $year < 2050) {
 549     # UTCTime
 550     $tag = 0x17;
 551     $tstr = sprintf("%02d%02d%02d%02d%02d%02dZ", $year % 100, $mon, $mday,
 552       $hour, $min, $sec);
 553   }
 554   else {
 555     # GeneralizedTime
 556     $tag = 0x18;
 557     $tstr = sprintf("%04d%02d%02d%02d%02d%02dZ", $year, $mon, $mday,
 558       $hour, $min, $sec);
 559   }
 560   return pack('C',$tag).DERLength(length($tstr)).$tstr;
 561 }
 562
 563 sub DERInteger($)
 564 {
 565   my $int = shift; # an integer value, may be negative
 566   my @bytes = unpack('C*',pack('N',$int));
 567   shift @bytes while @bytes >= 2 && $bytes[0] == 255 && ($bytes[1] & 0x80);
 568   shift @bytes while @bytes >= 2 && $bytes[0] == 0 && !($bytes[1] & 0x80);
 569   return pack('C*',0x02,scalar(@bytes),@bytes);
 570 }
 571
 572 sub RandomID(;$)
 573 {
 574   # return 20 random bytes except that the first byte has its high bit clear
 575   my $suppress = shift || 0;
 576   print STDERR "Generating serial number, please wait...\n" unless $suppress;
 577   open(RANDIN, "<", "/dev/random")
 578     or die "Cannot open /dev/random for input\n";
 579   my $result = '';
 580   for (my $cnt = 0; $cnt < 20; ++$cnt) {
 581     my $byte;
 582     sysread(RANDIN, $byte, 1)
 583       or die "Cannot read from /dev/random\n";
 584     if (!$cnt) {
 585       my $val = unpack('C', $byte);
 586       $val &= 0x7F;
 587       $byte = pack('C', $val);
 588     }
 589     $result .= $byte;
 590   }
 591   close(RANDIN);
 592   print STDERR "...done creating serial number.\n" unless $suppress;
 593   return $result;
 594 }
 595
 596 sub ReadDERLength($)
 597 {
 598   # Input is a DER encoded length with possibly extra trailing bytes
 599   # Output is an array of length and bytes-used-for-encoded-length
 600   my $der = shift;
 601   return undef unless length($der);
 602   my $byte = unpack('C',substr($der,0,1));
 603   return ($byte, 1) if $byte <= 127;
 604   return undef if $byte == 128 || $byte > 128+8; # Fail if greater than 2^64
 605   my $cnt = $byte & 0x7F;
 606   return undef unless length($der) >= $cnt+1; # Fail if not enough bytes
 607   my $val = 0;
 608   for (my $i = 0; $i < $cnt; ++$i) {
 609     $val <<= 8;
 610     $val |= unpack('C',substr($der,$i+1,1));
 611   }
 612   return ($val, $cnt+1);
 613 }
 614
 615 sub DERTimeStr($)
 616 {
 617   my $der = shift;
 618   return undef unless length($der) >= 2;
 619   my $byte = unpack('C',substr($der,0,1));
 620   return undef unless $byte == 0x17 || $byte == 0x18;
 621   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 622   return undef unless length($der) == 1 + $lenbytes + $len;
 623   return undef
 624     unless ($byte == 0x17 && $len == 13) || ($byte == 0x18 && $len == 15);
 625   substr($der,0,1+$lenbytes) = '';
 626   if ($byte == 0x17) {
 627     no warnings;
 628     my $year = substr($der,0,2) + 1900;
 629     $year += 100 if $year < 1950;
 630     $der = sprintf("%04d",$year).substr($der,2);
 631   }
 632   return substr($der,0,4).'-'.substr($der,4,2).'-'.substr($der,6,2).'_'.
 633     substr($der,8,2).':'.substr($der,10,2).':'.substr($der,12,3);
 634 }
 635
 636 sub GetOpenSSHKeyInfo($)
 637 {
 638   # Input is an OpenSSH public key in .pub format
 639   # Output is an array of:
 640   #   how many bits in the modulus
 641   #   the public exponent
 642   #   the key id
 643   #   the OpenSSH md5 fingerprint
 644   #   the OpenSSH sha1 fingerprint
 645   #   the OpenSSH comment (may be '')
 646   #   the OpenSSH public key in OpenSSL PUBLIC KEY DER format
 647   # or undef if the key is unparseable
 648   # or just the key type if it's not ssh-rsa
 649   #
 650   # Expected format is:
 651   #   ssh-rsa BASE64PUBLICKEYDATA optional comment here
 652   # where the BASE64PUBLICKEYDATA when decoded produces:
 653   #   4 Byte Big-Endian length of Key type (must be 7 for RSA)
 654   #   Key type WITHOUT terminating NUL (must be ssh-rsa for RSA)
 655   #   4 Byte Big-Endian length of public exponent
 656   #   Public exponent integer bytes
 657   #   4 Byte Big-Endian length of modulus
 658   #   Modulus integer bytes
 659   # no extra trailing bytes are permitted
 660   my $input = shift;
 661   $input =~ s/((?:\r\n|\n|\r).*)$//os;
 662   my @fields = split(' ', $input, 3);
 663   return undef unless @fields >= 2;
 664   my $data = decode_base64($fields[1]);
 665   my $origData = $data;
 666   my @parts = ();
 667   while (length($data) >= 4) {
 668     my $len = unpack('N',substr($data,0,4));
 669     my $value = '';
 670     if ($len > 0) {
 671       return undef if $len + 4 > length($data);
 672       $value = substr($data,4,$len);
 673     }
 674     push(@parts, $value);
 675     substr($data, 0, 4+$len) = '';
 676   }
 677   return undef unless length($data) == 0;
 678   return $parts[0]
 679     if @parts >= 1 && defined($parts[0]) && $parts[0] && $parts[0] ne 'ssh-rsa';
 680   return undef unless @parts == 3;
 681
 682   my $rsaEncryption = DEROID('1.2.840.113549.1.1.1'); # :rsaEncryption
 683   $rsaEncryption = pack('C',0x30).DERLength(length($rsaEncryption)+2)
 684     .$rsaEncryption.pack('C2',0x05,0x00);
 685   my $pubrsa = pack('C',0x2).DERLength(length($parts[2])).$parts[2]; # modulus
 686   $pubrsa .= pack('C',0x2).DERLength(length($parts[1])).$parts[1]; # exponent
 687   $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
 688   my $id = sha1($pubrsa); # The id is the sha1 hash of the private key part
 689   $pubrsa = pack('C',0x3).DERLength(length($pubrsa)+1).pack('C',0x0).$pubrsa;
 690   $pubrsa = $rsaEncryption.$pubrsa;
 691   $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
 692
 693   my $bits = length($parts[2]) * 8;
 694   # But we have to discount any leading 0 bits in the first byte
 695   my $byte = unpack('C',substr($parts[2],0,1));
 696   if (!$byte) {
 697     $bits -= 8;
 698   }
 699   else {
 700     return undef if $byte & 0x80; # negative modulus is not allowed
 701     while (!($byte & 0x80)) {
 702       --$bits;
 703       $byte <<= 1;
 704     }
 705   }
 706
 707   my $rawexp = $parts[1];
 708   my $exp;
 709   if (length($rawexp) > 8) {
 710     # Fudge the result because it's bigger than a 64-bit number
 711     my $lastbyte = unpack('C',substr($rawexp,-1,1));
 712     $exp = $lastbyte & 0x01 ? 65537 : 65536;
 713   }
 714   else {
 715     $exp = 0;
 716     while (length($rawexp)) {
 717       $exp <<= 8;
 718       $exp |= unpack('C',substr($rawexp,0,1));
 719       substr($rawexp,0,1) = '';
 720     }
 721   }
 722
 723   return ($bits,$exp,$id,md5($origData),sha1($origData),$fields[2]||'',$pubrsa);
 724 }
 725
 726 sub GetKeyInfo($)
 727 {
 728   # Input is an RSA PRIVATE KEY in DER format
 729   # Output is an array of:
 730   #   how many bits in the modulus
 731   #   the public exponent
 732   #   the key id
 733   #   the OpenSSH md5 fingerprint
 734   #   the OpenSSH sha1 fingerprint
 735   # or undef if the key is unparseable
 736   #
 737   # Expected format is:
 738   #   SEQUENCE {
 739   #     SEQUENCE {
 740   #       OBJECT IDENTIFIER :rsaEncryption = 1.2.840.113549.1.1.1
 741   #       NULL
 742   #     }
 743   #     BIT STRING (primitive) {
 744   #       0 unused bits
 745   #       SEQUENCE { # this part is the contents of an "RSA PUBLIC KEY" file
 746   #         INTEGER modulus
 747   #         INTEGER publicExponent
 748   #       }
 749   #     }
 750   #   }
 751
 752   no warnings;
 753   my $der = shift;
 754   my $rawmod;
 755   my $rawexp;
 756
 757   return undef if unpack('C',substr($der,0,1)) != 0x30;
 758   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 759   return undef unless length($der) == 1 + $lenbytes + $len;
 760   substr($der, 0, 1 + $lenbytes) = '';
 761
 762   # the algorithm part always encodes as 30 0d 06092a864886f70d010101 0500
 763   return undef
 764     unless substr($der, 0, 15) = pack('H*',"300d06092a864886f70d0101010500");
 765   substr($der, 0, 15) = '';
 766
 767   return undef if unpack('C',substr($der,0,1)) != 0x03;
 768   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 769   return undef unless length($der) == 1 + $lenbytes + $len && $len >= 1;
 770   return undef unless unpack('C',substr($der, 1 + $lenbytes, 1)) == 0x00;
 771   substr($der, 0, 1 + $lenbytes + 1) = '';
 772
 773   return undef if unpack('C',substr($der,0,1)) != 0x30;
 774   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 775   return undef unless length($der) == 1 + $lenbytes + $len;
 776   my $id = sha1($der); # The id is the sha1 hash of the private key part
 777   substr($der, 0, 1 + $lenbytes) = '';
 778
 779   return undef if unpack('C',substr($der,0,1)) != 0x02;
 780   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 781   substr($der, 0, 1 + $lenbytes) = '';
 782   my $derexp = substr($der, $len);
 783   substr($der, $len) = '';
 784   return undef unless $len >= 1;
 785   $rawmod = $der;
 786   my $bits = length($der) * 8;
 787   # But we have to discount any leading 0 bits in the first byte
 788   my $byte = unpack('C',substr($der,0,1));
 789   if (!$byte) {
 790     $bits -= 8;
 791   }
 792   else {
 793     return undef if $byte & 0x80; # negative modulus is not allowed
 794     while (!($byte & 0x80)) {
 795       --$bits;
 796       $byte <<= 1;
 797     }
 798   }
 799
 800   $der = $derexp;
 801   return undef if unpack('C',substr($der,0,1)) != 0x02;
 802   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 803   substr($der, 0, 1 + $lenbytes) = '';
 804   return undef unless length($der) == $len && $len >= 1;
 805   return undef if unpack('C',substr($der,0,1)) & 0x80; # negative pub exp bad
 806   $rawexp = $der;
 807   my $exp;
 808   if ($len > 8) {
 809     # Fudge the result because it's bigger than a 64-bit number
 810     my $lastbyte = unpack('C',substr($der,-1,1));
 811     $exp = $lastbyte & 0x01 ? 65537 : 65536;
 812   }
 813   else {
 814     $exp = 0;
 815     while (length($der)) {
 816       $exp <<= 8;
 817       $exp |= unpack('C',substr($der,0,1));
 818       substr($der,0,1) = '';
 819     }
 820   }
 821
 822   my $tohash = pack('N',7)."ssh-rsa".pack('N',length($rawexp)).$rawexp
 823     .pack('N',length($rawmod)).$rawmod;
 824
 825   return ($bits,$exp,$id,md5($tohash),sha1($tohash));
 826 }
 827
 828 sub GetCertInfo($)
 829 {
 830   # Input is an X.509 "Certificate" (RFC 5280) in DER format
 831   # Output is an array of:
 832   #   version (1, 2, or 3)
 833   #   serial number (just the serial number data bytes, no header or length)
 834   #   issuer name as a DER "Name"
 835   #   validity start as a DER "Time"
 836   #   validity end as a DER "Time"
 837   #   subject name as a DER "Name"
 838   #   subject public key as a DER "SubjectPublicKeyInfo"
 839   #   subject public key id if v3 Extension SubjectKeyIdentifier is present
 840   #     otherwise undef.  This is just the raw bytes of the key id, no DER
 841   #     header.  (Same format as returned by GetKeyInfo and GetOpenSSHKeyInfo.)
 842   # or undef if the certificate is unparseable
 843
 844   no warnings;
 845   my $der = shift;
 846   my $subjectKeyIdentifier = DEROID('2.5.29.14');
 847   return undef if unpack('C',substr($der,0,1)) != 0x30;
 848   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 849   return undef unless length($der) == 1 + $lenbytes + $len;
 850   substr($der, 0, 1 + $lenbytes) = '';
 851   return undef if unpack('C',substr($der,0,1)) != 0x30;
 852   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 853   return undef unless length($der) >= 1 + $lenbytes + $len;
 854   substr($der, 0, 1 + $lenbytes) = '';
 855   substr($der, $len) = '';
 856   my $byte = unpack('C',substr($der,0,1));
 857   my $ver = 1;
 858   if ($byte == 0xA0) {
 859     return undef if length($der) < 5 || substr($der,1,3) != pack('H*','030201');
 860     $byte = unpack('C',substr($der,4,1));
 861     # Zero shouldn't be allowed as it's DEFAULT but we'll let it go by
 862     return undef if $byte > 2; # unrecognized version
 863     $ver = $byte + 1;
 864     substr($der,0,5) = '';
 865   }
 866   return undef if unpack('C',substr($der,0,1)) != 0x02;
 867   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 868   return undef unless length($der) > 1+$lenbytes+$len && $len >= 1;
 869   substr($der, 0, 1 + $lenbytes) = '';
 870   my $serial = substr($der, 0, $len);
 871   substr($der, 0, $len) = '';
 872   return undef if unpack('C',substr($der,0,1)) != 0x30; # Alg ID
 873   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 874   return undef unless length($der) > 1+$lenbytes+$len;
 875   substr($der,0,1+$lenbytes+$len) = '';
 876   return undef if unpack('C',substr($der,0,1)) != 0x30; # Issuer
 877   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 878   return undef unless length($der) > 1+$lenbytes+$len;
 879   my $issuer = substr($der, 0, 1 + $lenbytes + $len);
 880   substr($der,0,1+$lenbytes+$len) = '';
 881   return undef if unpack('C',substr($der,0,1)) != 0x30; # Validity
 882   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 883   return undef unless length($der) > 1+$lenbytes+$len;
 884   my $validlen = $len;
 885   substr($der, 0, 1 + $lenbytes) = '';
 886   $byte = unpack('C', substr($der, 0, 1));
 887   return undef unless $byte == 0x17 || $byte == 0x18;
 888   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 889   return undef unless length($der) > 1+$lenbytes+$len;
 890   my $vst = substr($der, 0, 1 + $lenbytes + $len);
 891   substr($der, 0, 1+$lenbytes+$len) = '';
 892   $byte = unpack('C', substr($der, 0, 1));
 893   return undef unless $byte == 0x17 || $byte == 0x18;
 894   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 895   return undef unless length($der) > 1+$lenbytes+$len;
 896   my $vnd = substr($der, 0, 1 + $lenbytes + $len);
 897   substr($der, 0, 1+$lenbytes+$len) = '';
 898   return undef unless $validlen == length($vst) + length($vnd);
 899   return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject
 900   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 901   return undef unless length($der) > 1+$lenbytes+$len;
 902   my $subj = substr($der, 0, 1 + $lenbytes + $len);
 903   substr($der, 0, 1+$lenbytes+$len) = '';
 904   return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject PubKey
 905   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 906   return undef unless length($der) >= 1+$lenbytes+$len;
 907   my $subjkey = substr($der, 0, 1 + $lenbytes + $len);
 908   substr($der, 0, 1+$lenbytes+$len) = '';
 909   return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,undef)
 910     if !length($der) || $ver < 3;
 911   $byte = unpack('C',substr($der,0,1));
 912   if ($byte == 0x81) {
 913     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 914     return undef unless length($der) >= 1+$lenbytes+$len;
 915     substr($der,0,1+$lenbytes+$len) = '';
 916     $byte = unpack('C',substr($der,0,1));
 917   }
 918   if ($byte == 0x82) {
 919     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 920     return undef unless length($der) >= 1+$lenbytes+$len;
 921     substr($der,0,1+$lenbytes+$len) = '';
 922     $byte = unpack('C',substr($der,0,1));
 923   }
 924   return undef if length($der) && $byte != 0xA3; # exts tag
 925   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 926   return undef unless length($der) == 1+$lenbytes+$len;
 927   my $skid = undef;
 928   substr($der, 0, 1+$lenbytes) = '';
 929   return undef unless unpack('C',substr($der,0,1)) == 0x30; # Extensions
 930   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 931   return undef unless length($der) == 1+$lenbytes+$len;
 932   substr($der, 0, 1+$lenbytes) = '';
 933   while (length($der)) {
 934     return undef unless unpack('C',substr($der,0,1)) == 0x30;
 935     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 936     return undef unless length($der) >= 1+$lenbytes+$len;
 937     substr($der,0,1+$lenbytes) = '';
 938     return undef unless unpack('C',substr($der,0,1)) == 0x06;
 939     if (substr($der,0,length($subjectKeyIdentifier)) ne $subjectKeyIdentifier) {
 940       substr($der,0,$len) = '';
 941       next;
 942     }
 943     substr($der,0,length($subjectKeyIdentifier)) = '';
 944     if (unpack('C',substr($der,0,1)) == 0x01) {
 945       # SHOULDn't really be here, but allow it anyway
 946       return undef unless unpack('C',substr($der,1,1)) == 0x01;
 947       substr($der,0,3) = '';
 948     }
 949     return undef unless unpack('C',substr($der,0,1)) == 0x04;
 950     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 951     return undef unless length($der) >= 1+$lenbytes+$len && $len > 1;
 952     substr($der,0,1+$lenbytes) = '';
 953     return undef unless unpack('C',substr($der,0,1)) == 0x04;
 954     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 955     return undef unless length($der) >= 1+$lenbytes+$len && $len >= 1;
 956     $skid = substr($der,1+$lenbytes,$len);
 957     last;
 958   }
 959   return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,$skid)
 960 }
 961
 962 sub BreakLine($$)
 963 {
 964   my ($line,$width) = @_;
 965   my @ans = ();
 966   return $line if $width < 1;
 967   while (length($line) > $width) {
 968     push(@ans, substr($line, 0, $width));
 969     substr($line, 0, $width) = '';
 970   }
 971   push(@ans, $line) if length($line);
 972   return @ans;
 973 }
 974
 975 sub tests
 976 {
 977   print STDERR unpack('H*', DEROID('2.100.3')),"\n"; # should be 0603813403
 978   for (my $i=0; $i<16; ++$i) {
 979     print STDERR unpack('H*', RandomID(1)),"\n"; # Hi bit should NOT be set
 980   }
 981 }
 982
 983 sub GetDigest($)
 984 {
 985   my $dgst = shift;
 986   my $sha1   = DEROID('1.3.14.3.2.26');
 987   my $sha224 = DEROID('2.16.840.1.101.3.4.2.4');
 988   my $sha256 = DEROID('2.16.840.1.101.3.4.2.1');
 989   my $sha384 = DEROID('2.16.840.1.101.3.4.2.2');
 990   my $sha512 = DEROID('2.16.840.1.101.3.4.2.3');
 991   my $sha1WithRSAEncryption   = DEROID('1.2.840.113549.1.1.5');
 992   my $sha224WithRSAEncryption = DEROID('1.2.840.113549.1.1.14');
 993   my $sha256WithRSAEncryption = DEROID('1.2.840.113549.1.1.11');
 994   my $sha384WithRSAEncryption = DEROID('1.2.840.113549.1.1.12');
 995   my $sha512WithRSAEncryption = DEROID('1.2.840.113549.1.1.13');
 996   return ($sha1, $sha1WithRSAEncryption, \&sha1) if $dgst eq 'sha1';
 997   my $h = undef;
 998   my $oid = undef;
 999   my $func = undef;
1000   for (;;) {
1001     $h=$sha224,$oid=$sha224WithRSAEncryption,$func=\&sha224,last
1002       if $dgst eq 'sha224';
1003     $h=$sha256,$oid=$sha256WithRSAEncryption,$func=\&sha256,last
1004       if $dgst eq 'sha256';
1005     $h=$sha384,$oid=$sha384WithRSAEncryption,$func=\&sha384,last
1006       if $dgst eq 'sha384';
1007     $h=$sha512,$oid=$sha512WithRSAEncryption,$func=\&sha512,last
1008       if $dgst eq 'sha512';
1009     last;
1010   }
1011   die "Invalid digest ($dgst) must be one of:\n"
1012     . "  sha1 sha224 sha256 sha384 sha512\n" unless $h && $oid;
1013   die "Digest $dgst requires Digest::SHA or Digest::SHA::PurePerl "
1014     . "to be available\n" if !$hasSha2;
1015   return ($h,$oid,$func);
1016 }
1017
1018 sub toupper($)
1019 {
1020   my $str = shift;
1021   $str =~ tr/a-z/A-Z/;
1022   return $str;
1023 }
1024
1025 sub tolower($)
1026 {
1027   my $str = shift;
1028   $str =~ tr/A-Z/a-z/;
1029   return $str;
1030 }
1031
1032 sub RSASign($$)
1033 {
1034   my ($data, $keyfile) = @_;
1035   my $sig;
1036   {
1037     local(*CHLD_OUT, *CHLD_IN);
1038     #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1039     #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1040     (my $pid = open2(\*CHLD_OUT, \*CHLD_IN, "openssl", "rsautl", "-sign",
1041         "-inkey", $keyfile))
1042       or die "Cannot start openssl rsautl\n";
1043     print CHLD_IN $data;
1044     close(CHLD_IN);
1045     local $/;
1046     die "Error reading RSA signature from openssl rsautl\n"
1047       unless !!($sig = <CHLD_OUT>);
1048     waitpid($pid, 0);
1049     close(CHLD_OUT);
1050     #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1051   }
1052   return $sig;
1053 }
1054
1055 sub main
1056 {
1057   Make1252(); # Set up the UTF-8 auxiliary conversion table
1058
1059   my $help = '';
1060   my $verbose = '';
1061   my $quiet = '';
1062   my $keyfile = '';
1063   my $certfile = '';
1064   my $useNow = '';
1065   my $useRandom = '';
1066   my $useNoRandom = '';
1067   my $termOK = '';
1068   my $server = '';
1069   my $codesign = '';
1070   my $applecodesign = '';
1071   my $client = '';
1072   my $email = '';
1073   my $subca = '';
1074   my $root = '';
1075   my $rootauth = '';
1076   my $authext = '';
1077   my $digest = $hasSha2 ? 'sha256' : 'sha1';
1078   my $digestChoice = '';
1079   my $debug = 0;
1080   my $pubx509 = '';
1081   my $check = '';
1082   my $pathlen = '';
1083   my $commonName = DEROID('2.5.4.3'); # :commonName
1084   my $serialNumber = DEROID('2.5.4.5'); # :serialNumber
1085   my $userId = DEROID('0.9.2342.19200300.100.1.1'); # :userId
1086   my $emailAddress = DEROID('1.2.840.113549.1.9.1'); # :emailAddress
1087   my $basicConstraints = DEROID('2.5.29.19');
1088   my $keyUsage = DEROID('2.5.29.15');
1089   my $extKeyUsage = DEROID('2.5.29.37');
1090   my $serverAuth = DEROID('1.3.6.1.5.5.7.3.1');
1091   my $clientAuth = DEROID('1.3.6.1.5.5.7.3.2');
1092   my $codeSigning = DEROID('1.3.6.1.5.5.7.3.3');
1093   my $emailProtection = DEROID('1.3.6.1.5.5.7.3.4');
1094   my $appleCodeSigning = DEROID('1.2.840.113635.100.4.1');
1095   my $authKeyId = DEROID('2.5.29.35');
1096   my $subjKeyId = DEROID('2.5.29.14');
1097   my $subjAltName = DEROID('2.5.29.17');
1098   my $boolTRUE = pack('C*',0x01,0x01,0xFF);
1099   my $boolFALSE = pack('C*',0x01,0x01,0x00);
1100   my $v3Begin = pack('C',0x17).DERLength(13)."970811000000Z";
1101   my $noExpiry = pack('C',0x18).DERLength(15)."99991231235959Z";
1102
1103   #tests;
1104   eval {GetOptions(
1105       "help|h" => sub{$help=1;die"!FINISH"},
1106       "verbose|v" => \$verbose,
1107       "version|V" => sub{print STDERR $VERSIONMSG;exit(0)},
1108       "debug" => \$debug,
1109       "quiet" => \$quiet,
1110       "pubx509" => \$pubx509,
1111       "pubX509" => \$pubx509,
1112       "check" => \$check,
1113       "now" => \$useNow,
1114       "random" => \$useRandom,
1115       "no-random" => \$useNoRandom,
1116       "t" => \$termOK,
1117       "server" => \$server,
1118       "codesign" => \$codesign,
1119       "applecodesign" => \$applecodesign,
1120       "email" => \$email,
1121       "client" => \$client,
1122       "subca" => \$subca,
1123       "root" => \$root,
1124       "rootauth" => \$rootauth,
1125       "authext" => \$authext,
1126       "digest=s" => \$digestChoice,
1127       "key|k=s" => \$keyfile,
1128       "cert|c=s" => \$certfile,
1129       "pathlen=i" => \$pathlen
1130     )} || $help
1131       or die $USAGE;
1132   if ($help) {
1133     local *MAN;
1134     my $pager = $ENV{'PAGER'} || 'less';
1135     if (-t STDOUT && open(MAN, "|-", $pager)) {
1136       print MAN formatman($HELP,1);
1137       close(MAN);
1138     }
1139     else {
1140       print formatman($HELP);
1141     }
1142     exit(0);
1143   }
1144   $client = 1 if
1145     !$root && !$subca && !$server && !$codesign && !$applecodesign && !$email;
1146   $verbose = 1 if $debug || $check;
1147   $quiet = 0 if $verbose || $check;
1148   print STDERR $VERSIONMSG if $verbose;
1149   my $keytype = 'OpenSSH';
1150   $keytype = 'pubx509' if $pubx509;
1151   die $USAGE if $root && $useRandom && $useNoRandom;
1152   die $USAGE if !$keyfile || (!$root && !$certfile) || (!$check && @ARGV != 1);
1153   die "Standard input is a tty (which is an unlikely source of a $keytype "
1154     . "public key)\n"
1155     . "If that's what you truly meant, add the -t option to allow it.\n"
1156     if !$root && -t STDIN && !$termOK;
1157   $useRandom = 1 if $root && !$useNoRandom;
1158   die "Name may not be empty\n"
1159     unless $check || $ARGV[0] || ($root && $useRandom);
1160   my $opensshdotpub;
1161   if (!$root) {
1162     local $/ if $pubx509;
1163     !!($opensshdotpub = <STDIN>)
1164       or die "Cannot read $keytype public key from STDIN\n";
1165     if (!$pubx509) {
1166       my $auto509 = 0;
1167       if ($opensshdotpub =~ /^----[- ]BEGIN PUBLIC KEY[- ]----/) {
1168         $auto509 = 1;
1169       }
1170       else {
1171         my $input = $opensshdotpub;
1172         $input =~ s/((?:\r\n|\n|\r).*)$//os;
1173         my @fields = split(' ', $input, 3);
1174         if (@fields < 2 || length($fields[1]) < 16 || $fields[1] !~ m|^[0-9A-Za-z+/=]+$|) {
1175           $auto509 = 1;
1176         }
1177       }
1178       if ($auto509) {
1179         $pubx509 = 1;
1180         $keytype = 'pubx509';
1181         print STDERR "auto detected --pubx509 option\n" if $debug;
1182         local $/;
1183         my $extra = <STDIN>;
1184         $opensshdotpub .= $extra if $extra;
1185       }
1186     }
1187   }
1188   die "Cannot read key file $keyfile\n" if ! -r $keyfile;
1189   die "Cannot read certificate file $certfile\n" if !$root && ! -r $certfile;
1190   my ($did, $dalg, $dfunc) = GetDigest($digestChoice || $digest);
1191   print STDERR "default digest: $digest\n" if $debug;
1192   warn "*** Warning: defaulting to sha1 since sha256 support not available\n"
1193     if !$quiet && $digest eq 'sha1' && !$digestChoice;
1194   $digest = $digestChoice if $digestChoice;
1195   warn "*** Warning: sha1 use is strongly discouraged, continuing anyway\n"
1196     if !$quiet && $digest eq 'sha1';
1197   print STDERR "Using digest $digest\n" if $verbose;
1198
1199   my ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub);
1200   if ($root) {
1201     # need to set $sshkeyid to $pubkeyid
1202     # need to set $opensshpub to $pubkey
1203     # but don't have either yet, so do it later
1204   }
1205   elsif ($pubx509) {
1206     local (*READKEY, *WRITEKEY);
1207     my $inform = $opensshdotpub =~ m|^[\t\n\r\x20-\x7E]*$|os ? 'PEM' : 'DER';
1208     print STDERR "pubx509 -inform $inform\n" if $debug;
1209     open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1210     open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1211     my $pid = open2(\*READKEY, \*WRITEKEY, "openssl", "rsa", "-inform",
1212       $inform, "-pubin", "-outform", "DER", "-pubout");
1213     open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1214     $pid or die "Cannot start openssl rsa\n";
1215     print WRITEKEY $opensshdotpub;
1216     close(WRITEKEY);
1217     local $/;
1218     die "Error reading X.509 format RSA public key from standard input\n"
1219       unless !!($opensshpub = <READKEY>);
1220     waitpid($pid, 0);
1221     close(READKEY);
1222     $sshcmnt = undef;
1223     ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1) = GetKeyInfo($opensshpub);
1224     die "Unparseable X.509 public key format read from standard input\n"
1225       unless $sshkeybits;
1226   }
1227   else {
1228     ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub) =
1229       GetOpenSSHKeyInfo($opensshdotpub);
1230     die "Unparseable OpenSSH public key read from STDIN\n" unless $sshkeybits;
1231     die "Unsupported OpenSSH public key type ($sshkeybits), must be ssh-rsa\n"
1232       unless $sshkeyexp;
1233   }
1234   if (!$root) {
1235     print STDERR "$keytype Public Key Info:\n",
1236         "  bits=$sshkeybits pubexp=$sshkeyexp\n" if $verbose;
1237     print STDERR "  keyid=",
1238       join(":", toupper(unpack("H*",$sshkeyid))=~/../g), "\n" if $verbose;
1239     print STDERR "  fingerprint(md5)=",
1240       join(":", tolower(unpack("H*",$sfmd5))=~/../g), "\n" if $verbose;
1241     print STDERR "  fingerprint(sha1)=",
1242       join(":", tolower(unpack("H*",$sfsha1))=~/../g), "\n" if $verbose;
1243     print STDERR "  comment=",$sshcmnt||'<none present>',"\n"
1244       if $verbose && !$pubx509;
1245     die "*** Error: $keytype key has less than 512 bits ($sshkeybits)\n"
1246       . "***        You might as well just donate your system to hackers now.\n"
1247       if $sshkeybits < 512;
1248     die "*** Error: The $keytype key's public exponent is even ($sshkeyexp)!\n"
1249       if !($sshkeyexp & 0x01);
1250     warn "*** Warning: The $keytype key has less than 2048 bits ($sshkeybits), "
1251       . "continuing anyway\n" if !$quiet && $sshkeybits < 2048;
1252     die "*** Error: The $keytype public key's exponent of $sshkeyexp is "
1253       . "unacceptably weak!\n" if $sshkeyexp < 35; # OpenSSH used 35 until v5.4
1254     warn "*** Warning: The $keytype public key's exponent ($sshkeyexp) is weak "
1255       . "(< 65537), continuing anyway\n" if !$quiet && $sshkeyexp < 65537;
1256   }
1257
1258   my $inform = -T $keyfile ? 'PEM' : 'DER';
1259   print STDERR "keyfile -inform $inform\n" if $debug;
1260   die "Input key does not appear to be in PEM format: $keyfile\n"
1261     unless $inform eq 'PEM';
1262   my $pubkey;
1263   {
1264     local *READKEY;
1265     open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1266     open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1267     open(READKEY, "-|", "openssl", "rsa", "-inform", $inform, "-outform", "DER",
1268         "-pubout", "-passin", "pass:", "-in", $keyfile)
1269       or die "Cannot read RSA private key in $keyfile\n";
1270     open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1271     local $/;
1272     die "Error reading RSA private key in $keyfile\n"
1273       unless !!($pubkey = <READKEY>);
1274     close(READKEY);
1275   }
1276   $opensshpub = $pubkey if $root;
1277   my ($pubkeybits,$pubkeyexp,$pubkeyid,$pfmd5,$pfsha1) = GetKeyInfo($pubkey);
1278   $sshkeyid = $pubkeyid if $root;
1279   die "Unparseable public key format in $keyfile\n" unless $pubkeybits;
1280   print STDERR "RSA Private Key $keyfile:\n",
1281     "  bits=$pubkeybits pubexp=$pubkeyexp\n" if $verbose;
1282   print STDERR "  keyid=",
1283     join(":", toupper(unpack("H*",$pubkeyid))=~/../g), "\n" if $verbose;
1284   print STDERR "  fingerprint(md5)=",
1285     join(":", tolower(unpack("H*",$pfmd5))=~/../g), "\n" if $verbose;
1286   print STDERR "  fingerprint(sha1)=",
1287     join(":", tolower(unpack("H*",$pfsha1))=~/../g), "\n" if $verbose;
1288   die "*** Error: Private key has less than 512 bits ($pubkeybits)\n"
1289     . "***        You might as well just donate your system to hackers now.\n"
1290     if $pubkeybits < 512;
1291   die "*** Error: The private key's public exponent is even ($pubkeyexp)!\n"
1292     if !($pubkeyexp & 0x01);
1293   warn "*** Warning: The private key has less than 2048 bits ($pubkeybits), "
1294     . "continuing anyway\n" if !$quiet && $pubkeybits < 2048;
1295   die "*** Error: The private key's public key exponent of $pubkeyexp is "
1296     . "unacceptably weak!\n" if $pubkeyexp < 35; # ssh-keygen used 35 'til v5.4
1297   warn "*** Warning: The private key's public exponent ($pubkeyexp) is weak "
1298     . "(< 65537), continuing anyway\n" if !$quiet && $pubkeyexp < 65537;
1299
1300   my ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid);
1301   if ($root) {
1302     $vst = $v3Begin;
1303     $vnd = $noExpiry;
1304     $subjkeyid = $pubkeyid;
1305   }
1306   else {
1307     $inform = -T $certfile ? 'PEM' : 'DER';
1308     print STDERR "certfile -inform $inform\n" if $debug;
1309     my $signcert;
1310     {
1311       local *READCERT;
1312       #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1313       #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1314       open(READCERT, "-|", "openssl", "x509", "-inform", $inform, "-outform",
1315           "DER", "-in", $certfile)
1316         or die "Cannot read X.509 certificate in $certfile\n";
1317       #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1318       local $/;
1319       die "Error reading X.509 certificate in $certfile\n"
1320         unless !!($signcert = <READCERT>);
1321       close(READCERT);
1322     }
1323     ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid) =
1324       GetCertInfo($signcert);
1325     die "Unparseable certificate format in $certfile\n" unless $cver;
1326     my $dser = $cser;
1327     substr($dser,0,1) = '' if unpack('C',substr($cser,0,1)) == 0x00;
1328     print STDERR "X.509 Certificate $certfile:\n",
1329       "  ver=v$cver serial=", join(":", tolower(unpack("H*",$dser))=~/../g),"\n"
1330       if $verbose;
1331     print STDERR "  notBefore=",DERTimeStr($vst)||'Invalid Time',
1332       " notAfter=",DERTimeStr($vnd)||'Invalid Time',"\n" if $verbose;
1333     #print STDERR "  issuer=",DERNameStr($issuer),"\n" if $verbose;
1334     #print STDERR "  name=",DERNameStr($subj),"\n" if $verbose;
1335     print STDERR "  subj_keyid=", join(":", toupper(
1336       unpack("H*",$subjkeyid))=~/../g), "\n" if defined($subjkeyid) && $verbose;
1337     die "The private key is not the correct one for the certificate:\n".
1338       "  certificate: $certfile\n".
1339       "  private key: $keyfile\n" unless $subjkey eq $pubkey;
1340     if (!defined($subjkeyid)) {
1341       warn "*** Warning: The certificate has no subjectKeyIdentifier, "
1342         . "using RFC 5280 (1)\n";
1343       $subjkeyid = $pubkeyid;
1344     }
1345     warn "*** Warning: subjectKeyIdentifier non-standard, continuing anyway\n"
1346       unless $subjkeyid eq $pubkeyid;
1347     die "*** Error: The $keytype public key is the same as the certificate's "
1348       . "public key.\n"
1349       . "***        They must be different for security reasons.\n"
1350       if $pubkey eq $opensshpub;
1351   }
1352   return 0 if $check;
1353
1354   my $version = pack('CCCCC', 0xA0, 0x03, 0x02, 0x01, 0x02); # v3
1355   my $randval = $useRandom ? RandomID($quiet) : undef;
1356   my $sigAlg = $dalg . pack('CC',0x05,0x00);
1357   $sigAlg = pack('C',0x30).DERLength(length($sigAlg)).$sigAlg;
1358   my $name = MakeUTF8($ARGV[0]);
1359   $name = pack('C',$email?0x16:0x0C).DERLength(length($name)).$name;
1360   $name = (($server || $codesign || $subca || $root || $applecodesign) ? $commonName :
1361     ($email ? $emailAddress : $userId)) . $name;
1362   $name = pack('C',0x30).DERLength(length($name)).$name;
1363   $name = pack('C',0x31).DERLength(length($name)).$name;
1364   if ($root && $useRandom) {
1365     my $serialRDN = join(":", tolower(unpack("H*",$randval))=~/../g);
1366     $serialRDN = pack('C',0x13).DERLength(length($serialRDN)).$serialRDN;
1367     $serialRDN = $serialNumber . $serialRDN;
1368     $serialRDN = pack('C',0x30).DERLength(length($serialRDN)).$serialRDN;
1369     $serialRDN = pack('C',0x31).DERLength(length($serialRDN)).$serialRDN;
1370     $name = $serialRDN . ($ARGV[0] ? $name : '');
1371   }
1372   $name = pack('C',0x30).DERLength(length($name)).$name;
1373   $subj = $name if $root;
1374   my $validity = ($useNow ? DERTime(time()) : $vst).$vnd;
1375   $validity = pack('C',0x30).DERLength(length($validity)).$validity;
1376   my $extCAVal;
1377   if ($subca || $root) {
1378     $extCAVal = $boolTRUE;
1379     if ($subca && $pathlen ne '') {
1380       $extCAVal .= DERInteger($pathlen);
1381     }
1382     $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
1383   }
1384   else {
1385     #$extCAVal = pack('C',0x30).DERLength(length($boolFALSE)).$boolFALSE;
1386     $extCAVal = pack('C',0x30).DERLength(0); # do not include DEFAULT value
1387   }
1388   $extCAVal = pack('C',0x04).DERLength(length($extCAVal)).$extCAVal;
1389   $extCAVal = $basicConstraints . $boolTRUE . $extCAVal;
1390   $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
1391   my $extKeyBits = ($subca || $root)  ? '0186' :
1392     ($server ? '05A0' : ($email ? '05E0' : '0780'));
1393   my $extKeyUse = pack('H*', '04040302'.$extKeyBits);
1394   $extKeyUse = $keyUsage . $boolTRUE. $extKeyUse;
1395   $extKeyUse = pack('C',0x30).DERLength(length($extKeyUse)).$extKeyUse;
1396   my $extXKeyUse = '';
1397   if ($server || $client || $codesign || $email || $applecodesign) {
1398     $extXKeyUse .= $serverAuth if $server;
1399     $extXKeyUse .= $clientAuth if $client;
1400     $extXKeyUse .= $codeSigning if $codesign;
1401     $extXKeyUse .= $emailProtection if $email;
1402     $extXKeyUse .= $appleCodeSigning if $applecodesign;
1403     $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
1404     $extXKeyUse = pack('C',0x04).DERLength(length($extXKeyUse)).$extXKeyUse;
1405     $extXKeyUse = $extKeyUsage . $boolTRUE . $extXKeyUse;
1406     $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
1407   }
1408   my $extSubjKey = pack('C',0x04).DERLength(length($sshkeyid)).$sshkeyid;
1409   $extSubjKey = pack('C',0x04).DERLength(length($extSubjKey)).$extSubjKey;
1410   $extSubjKey = $subjKeyId . $extSubjKey;
1411   $extSubjKey = pack('C',0x30).DERLength(length($extSubjKey)).$extSubjKey;
1412   my $extAuthKey = '';
1413   if (!$root || $rootauth) {
1414     $extAuthKey = pack('C',0x80).DERLength(length($pubkeyid)).$pubkeyid;
1415     if (!$root && $authext) {
1416       my $gen = pack('C',0xA4).DERLength(length($issuer)).$issuer;
1417       $extAuthKey .= pack('C',0xA1).DERLength(length($gen)).$gen;
1418       $extAuthKey .= pack('C',0x82).DERLength(length($cser)).$cser;
1419     }
1420     $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
1421     $extAuthKey = pack('C',0x04).DERLength(length($extAuthKey)).$extAuthKey;
1422     $extAuthKey = $authKeyId . $extAuthKey;
1423     $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
1424   }
1425   my $exts = $extCAVal . $extKeyUse . $extXKeyUse . $extSubjKey . $extAuthKey;
1426   if ($email) {
1427     my $extSubjAlt = MakeUTF8($ARGV[0]);
1428     $extSubjAlt = pack('C',0x81).DERLength(length($extSubjAlt)).$extSubjAlt;
1429     $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
1430     $extSubjAlt = pack('C',0x04).DERLength(length($extSubjAlt)).$extSubjAlt;
1431     $extSubjAlt = $subjAltName . $extSubjAlt; # not crit unless empty DN
1432     $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
1433     $exts .= $extSubjAlt;
1434   }
1435   $exts = pack('C',0x30).DERLength(length($exts)).$exts;
1436   $exts = pack('C',0xA3).DERLength(length($exts)).$exts;
1437   my $serial;
1438   if ($useRandom) {
1439     $serial = pack('C',0x2).DERLength(length($randval)).$randval;
1440   }
1441   else {
1442     my $idtohash = $version.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
1443     $idtohash = pack('C',0x30).DERLength(length($idtohash)).$idtohash;
1444     my $idhash = sha1($idtohash);
1445     my $byte0 = unpack('C',substr($idhash,0,1));
1446     $byte0 &= 0x7F;
1447     substr($idhash,0,1) = pack('C',$byte0);
1448     $serial = pack('C',0x2).DERLength(length($idhash)).$idhash;
1449   }
1450   my $tbs = $version.$serial.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
1451   $tbs = pack('C',0x30).DERLength(length($tbs)).$tbs;
1452   my $tbsseq = &$dfunc($tbs);
1453   $tbsseq = pack('C',0x04).DERLength(length($tbsseq)).$tbsseq;
1454   my $algid = $did . pack('CC',0x05,0x00);
1455   $algid = pack('C',0x30).DERLength(length($algid)).$algid;
1456   $tbsseq = $algid . $tbsseq;
1457   $tbsseq = pack('C',0x30).DERLength(length($tbsseq)).$tbsseq;
1458   my $sig = RSASign($tbsseq, $keyfile);
1459   $sig = pack('C',0x03).DERLength(length($sig)+1).pack('C',0x00).$sig;
1460   my $cert = $tbs . $sigAlg . $sig;
1461   $cert = pack('C',0x30).DERLength(length($cert)).$cert;
1462   my $base64 = join("\n", BreakLine(encode_base64($cert, ''), 64))."\n";
1463   print "-----BEGIN CERTIFICATE-----\n",
1464         $base64,
1465         "-----END CERTIFICATE-----\n";
1466   return 0;
1467 }