CACreateCertClient

   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 exit(&main());
   7
   8 use strict;
   9 use warnings;
  10 use bytes;
  11
  12 use MIME::Base64;
  13 use IPC::Open2;
  14 use Digest::MD5 qw(md5 md5_hex md5_base64);
  15 use Getopt::Long qw(:config gnu_getopt);
  16
  17 our $VERSION;
  18 my $VERSIONMSG;
  19 my $HELP;
  20 my $USAGE;
  21
  22 my $hasSha2;
  23
  24 BEGIN {
  25   *VERSION = \'1.2.2';
  26   $VERSIONMSG = "CACreateCert version $VERSION\n" .
  27     "Copyright (c) 2011-2013 Kyle J. McKay.  All rights reserved.\n";
  28 }
  29
  30 BEGIN {
  31   $hasSha2 = 0;
  32
  33   eval {
  34     require Digest::SHA;
  35     Digest::SHA->import(
  36       qw(
  37         sha1 sha1_hex sha1_base64
  38         sha224 sha224_hex sha224_base64
  39         sha256 sha256_hex sha256_base64
  40         sha384 sha384_hex sha384_base64
  41         sha512 sha512_hex sha512_base64
  42       )
  43     ); $hasSha2=1} ||
  44   eval {
  45     require Digest::SHA::PurePerl;
  46     require Digest::SHA1;
  47     Digest::SHA1->import(
  48       qw(
  49         sha1 sha1_hex sha1_base64
  50       )
  51     );
  52     Digest::SHA::PurePerl->import(
  53       qw(
  54         sha224 sha224_hex sha224_base64
  55         sha256 sha256_hex sha256_base64
  56         sha384 sha384_hex sha384_base64
  57         sha512 sha512_hex sha512_base64
  58       )
  59     ); $hasSha2=1} ||
  60   eval {
  61     require Digest::SHA::PurePerl;
  62     Digest::SHA::PurePerl->import(
  63       qw(
  64         sha1 sha1_hex sha1_base64
  65         sha224 sha224_hex sha224_base64
  66         sha256 sha256_hex sha256_base64
  67         sha384 sha384_hex sha384_base64
  68         sha512 sha512_hex sha512_base64
  69       )
  70     ); $hasSha2=1} ||
  71   eval {
  72     require Digest::SHA1;
  73     Digest::SHA1->import(
  74       qw(
  75         sha1 sha1_hex sha1_base64
  76       )
  77     ); 1} ||
  78   die "One of Digest::SHA1 or Digest::SHA or Digest::SHA::PurePerl "
  79     . "must be available\n";
  80
  81   eval {(`openssl version -v 2>/dev/null` || '') =~ /^OpenSSL /} ||
  82     die "OpenSSL (as the openssl command) is not available in the PATH\n";
  83 }
  84
  85 BEGIN {
  86   $USAGE = <<USAGE;
  87 Usage: CACreateCertClient [-h] [--digest=sha1|sha224|sha256|sha384|sha512]
  88          [--check] [--pubx509] --cert signing_cert --key key_file "username"
  89          < client_openssh_key.pub > out_cert.pem
  90 USAGE
  91   $HELP = <<HELP;
  92 NAME
  93        CACreateCertClient [-h] [--digest=sha1|sha224|sha256|sha384|sha512]
  94          [--check] [--pubx509] --cert signing_cert --key key_file "username"
  95          < client_openssh_key.pub > out_cert.pem
  96
  97 DESCRIPTION
  98        CACreateCertClient creates a new client certificate suitable for a
  99        client to use to authenticate itself to a server using signing_cert as
 100        the client authentication authority.  Typically the "username" provided
 101        will be a *nix user login (all lowercase) on the server to which clients
 102        connect to.  However, it can be any string desired as the created
 103        certificate will be used for authentication and the "username" value may
 104        not actually be tied to any real accounts on the server to which the
 105        client connects and authenticates to.
 106
 107        The "username" value is expected to be either Latin-1 or UTF-8.
 108
 109        The client's RSA public key in OpenSSH .pub format must be provided on
 110        standard input (i.e. redirect standard input to ~/.ssh/id_rsa.pub).
 111        Note that the client's private RSA key IS NOT REQUIRED.  In particular,
 112        the key_file provided is the signing_cert's private key, NOT the
 113        client's.  This allows a server to create client authentication
 114        certificates without requiring access to any of the client's private
 115        data (such as its private key).  The resulting certificate that is
 116        created also need not be protected as it cannot be used without the
 117        client's private key (which presumably the client protects access to).
 118
 119        If --pubx509 is used then the client's RSA public key should be provided
 120        on standard input in OpenSSL X.509 public key format (i.e. the output of
 121        the "openssl rsa -pubout" or "openssl x509 -noout -pubkey" commands)
 122        instead of in OpenSSH format.  This can be more convenient if the
 123        client's public key is readily available from a certificate (where it
 124        can be easily extracted into OpenSSL X.509 public key format) but is not
 125        otherwise readily available in OpenSSH public key format.
 126
 127        The key_file must be an RSA private key file in PEM format and
 128        furthermore it must not have a password (both openssl genrsa and
 129        ssh-keygen -t rsa can create these kinds of RSA private key files).  If
 130        a host is running an OpenSSH sshd daemon, then it probably already has a
 131        suitable host private RSA key in either /etc/ssh/ssh_host_rsa_key or
 132        /etc/ssh_host_rsa_key that can be used if desired.
 133
 134        The signing_cert must be an X.509 certificate that uses key_file as its
 135        private key.  It may be in either PEM or DER format.  The created client
 136        authentication certificate will be signed by the signing_cert.  The
 137        CACreateClientRoot utility can be used to create a suitable signing_cert
 138        certificate authority certificate from the key_file if desired.
 139
 140        All systems support sha1 digest certificates, but sha1 should really not
 141        be used anymore (NIST recommendation SP 800-131A).  OpenSSL starting
 142        with versions 0.9.8 (released 2005-07-05) supports the SHA-2 family of
 143        hash functions (sha224, sha256, sha384 and sha512) which should be used
 144        instead.
 145
 146        NIST SP 800-131A requires use of an RSA key with 2048 or more bits and
 147        a hash function with 224 or more bits after December 31 2010.
 148
 149        RFC 6194 states sha256 is the most commonly used alternative to sha1
 150        (and will be used by default if a suitable SHA module is available).
 151
 152        Note that NIST SP 800-78-3 requires RSA public key exponents to be
 153        greater than or equal to 65537.  OpenSSH version 5.4 and later generate
 154        RSA keys with a public exponent of 65537 otherwise openssl genrsa can
 155        be used together with ssh-keygen -y to create a suitable OpenSSH key.
 156
 157        There is a seldom-used option not shown in the usage example above.
 158        The --now option can be given to set the validity not before date to the
 159        current time rather than the not before time from the signing
 160        certificate.  This option will cause the actual certificate data output
 161        by CACreateCertCilent to differ each time it's run.  If this option is
 162        not used, then for any given pair of signing_cert and "username",
 163        CACreateCertClient will always output a bytewise-identical certificate
 164        which means that only the signing_cert, its RSA private key and the
 165        username is needed to recreate the certificate at any time.
 166
 167        With the --check option, a new certificate is not output, but all the
 168        validity checks are still run.
 169
 170 TIPS
 171        Display the currently available version of OpenSSL with:
 172
 173            openssl version
 174
 175        Display the currently available version of OpenSSH with:
 176
 177            ssh -V
 178 HELP
 179 }
 180
 181 sub IsUTF8($)
 182 {
 183   # Return 0 if non-UTF-8 sequences present
 184   # Return -1 if no characters > 0x7F found
 185   # Return 1 if valid UTF-8 sequences present
 186   use bytes;
 187   return -1 if $_[0] !~ /[\x80-\xFF]/so;
 188   my $l = length($_[0]);
 189   for (my $i=0; $i<$l; ++$i) {
 190     my $c = ord(substr($_[0],$i,1));
 191     next if $c < 0x80;
 192     return 0 if $c < 0xC0 || $c >= 0xF8;
 193     if ($c <= 0xDF) {
 194       # Need 1 more byte
 195       ++$i;
 196       return 0 if $i >= $l;
 197       my $c2 = ord(substr($_[0],$i,1));
 198       return 0 if $c2 < 0x80 || $c2 > 0xBF;
 199       my $u = (($c & 0x1F) << 6) | ($c2 & 0x3F);
 200       return 0 if $u < 0x80;
 201       next;
 202     }
 203     if ($c <= 0xEF) {
 204       # Need 2 more bytes
 205       $i += 2;
 206       return 0 if $i >= $l;
 207       my $c2 = ord(substr($_[0],$i-1,1));
 208       return 0 if $c2 < 0x80 || $c2 > 0xBF;
 209       my $c3 = ord(substr($_[0],$i,1));
 210       return 0 if $c3 < 0x80 || $c3 > 0xBF;
 211       my $u = (($c & 0x0F) << 12) | (($c2 & 0x3F) << 6) | ($c3 & 0x3F);
 212       return 0 if $u < 0x800 || ($u >= 0xD800 && $u <= 0xDFFFF) || $u >= 0xFFFE;
 213       next;
 214     }
 215     # Need 3 more bytes
 216     $i += 3;
 217     return 0 if $i >= $l;
 218     my $c2 = ord(substr($_[0],$i-2,1));
 219     return 0 if $c2 < 0x80 || $c2 > 0xBF;
 220     my $c3 = ord(substr($_[0],$i-1,1));
 221     return 0 if $c3 < 0x80 || $c3 > 0xBF;
 222     my $c4 = ord(substr($_[0],$i,1));
 223     return 0 if $c4 < 0x80 || $c4 > 0xBF;
 224     my $u = (($c & 0x07) << 18) | (($c2 & 0x3F) << 12) | (($c3 & 0x3F) << 6)
 225                                                                  | ($c4 & 0x3F);
 226     return 0 if $u < 0x10000 || $u >= 0x10FFFE || (($u & 0xFFFF) >= 0xFFFE);
 227   }
 228   return 1;
 229 }
 230
 231 sub Make1252()
 232 {
 233   use bytes;
 234   our %W1252;
 235
 236   # Provide translations for 0x80-0x9F into UTF-8
 237   $W1252{0x80} = pack('H*','E282AC'); # 0x20AC Euro
 238   $W1252{0x82} = pack('H*','E2809A'); # 0X201A Single Low-9 Quote
 239   $W1252{0x83} = pack('H*','C692');   # 0x0192 Latin Small Letter f With Hook
 240   $W1252{0x84} = pack('H*','E2809E'); # 0x201E Double Low-9 Quote
 241   $W1252{0x85} = pack('H*','E280A6'); # 0x2026 Horizontal Ellipsis
 242   $W1252{0x86} = pack('H*','E280A0'); # 0x2020 Dagger
 243   $W1252{0x87} = pack('H*','E280A1'); # 0x2021 Double Dagger
 244   $W1252{0x88} = pack('H*','CB86');   # 0x02C6 Modifier Letter Circumflex Accent
 245   $W1252{0x89} = pack('H*','E28080'); # 0x2030 Per Mille Sign
 246   $W1252{0x8A} = pack('H*','C5A0');   # 0x0160 Latin Capital Letter S With Caron
 247   $W1252{0x8B} = pack('H*','E28089'); # 0x2039 Left Single Angle Quote
 248   $W1252{0x8C} = pack('H*','C592');   # 0x0152 Latin Capital Ligature OE
 249   $W1252{0x8E} = pack('H*','C5BD');   # 0x017D Latin Capital Letter Z With Caron
 250   $W1252{0x91} = pack('H*','E28098'); # 0x2018 Left Single Quote
 251   $W1252{0x92} = pack('H*','E28099'); # 0x2019 Right Single Quote
 252   $W1252{0x93} = pack('H*','E2809C'); # 0x201C Left Double Quote
 253   $W1252{0x94} = pack('H*','E2809D'); # 0x201D Right Double Quote
 254   $W1252{0x95} = pack('H*','E280A2'); # 0x2022 Bullet
 255   $W1252{0x96} = pack('H*','E28093'); # 0x2013 En Dash
 256   $W1252{0x97} = pack('H*','E28094'); # 0x2014 Em Dash
 257   $W1252{0x98} = pack('H*','CB9C');   # 0x02DC Small Tilde
 258   $W1252{0x99} = pack('H*','E284A2'); # 0x2122 Trade Mark Sign
 259   $W1252{0x9A} = pack('H*','C5A1');   # 0x0161 Latin Small Letter s With Caron
 260   $W1252{0x9B} = pack('H*','E2808A'); # 0x203A Right Single Angle Quote
 261   $W1252{0x9C} = pack('H*','C593');   # 0x0153 Latin Small Ligature oe
 262   $W1252{0x9E} = pack('H*','C5BE');   # 0x017E Latin Small Letter z With Caron
 263   $W1252{0x9F} = pack('H*','C5B8');   # 0x0178 Latin Cap Letter Y With Diaeresis
 264 }
 265
 266 sub MakeUTF8($)
 267 {
 268   use bytes;
 269   our %W1252;
 270
 271   return $_[0] if (IsUTF8($_[0]));
 272   my $ans = '';
 273   foreach my $c (unpack('C*',$_[0])) {
 274     if ($c < 0x80) {
 275       $ans .= chr($c);
 276     }
 277     else {
 278       # Ass/u/me we have Latin-1 (ISO-8859-1) but per the HTML 5 draft treat
 279       # it as windows-1252
 280       if ($c >= 0xA0 || !defined($W1252{$c})) {
 281         $ans .= chr(0xC0 | ($c >> 6));
 282         $ans .= chr(0x80 | ($c & 0x3F));
 283       }
 284       else {
 285         $ans .= $W1252{$c};
 286       }
 287     }
 288   }
 289   return $ans;
 290 }
 291
 292 sub formatbold($;$)
 293 {
 294   my $str = shift;
 295   my $fancy = shift || 0;
 296   if ($fancy) {
 297     $str = join('',map($_."\b".$_, split(//,$str)));
 298   }
 299   return $str;
 300 }
 301
 302 sub formatul($;$)
 303 {
 304   my $str = shift;
 305   my $fancy = shift || 0;
 306   if ($fancy) {
 307     $str = join('',map("_\b".$_, split(//,$str)));
 308   }
 309   return $str;
 310 }
 311
 312 sub formatman($;$)
 313 {
 314   my $man = shift;
 315   my $fancy = shift || 0;
 316   my @inlines = split(/\n/, $man, -1);
 317   my @outlines = ();
 318   foreach my $line (@inlines) {
 319     if ($line =~ /^[A-Z]+$/) {
 320       $line = formatbold($line, $fancy);
 321     }
 322     else {
 323       $line =~ s/'''(.+?)'''/formatbold($1,$fancy)/gse;
 324       $line =~ s/''(.+?)''/formatul($1,$fancy)/gse;
 325     }
 326     push (@outlines, $line);
 327   }
 328   my $result = join("\n", @outlines);
 329   $result =~ s/\\\n//gso;
 330   return $result;
 331 }
 332
 333 sub DERLength($)
 334 {
 335   # return a DER encoded length
 336   my $len = shift;
 337   return pack('C',$len) if $len <= 127;
 338   return pack('C2',0x81, $len) if $len <= 255;
 339   return pack('Cn',0x82, $len) if $len <= 65535;
 340   return pack('CCn',0x83, ($len >> 16), $len & 0xFFFF) if $len <= 16777215;
 341   # Silently returns invalid result if $len > 2^32-1
 342   return pack('CN',0x84, $len);
 343 }
 344
 345 sub SingleOID($)
 346 {
 347   # return a single DER encoded OID component
 348   no warnings;
 349   my $num = shift;
 350   $num += 0;
 351   my $result = pack('C', $num & 0x7F);
 352   $num >>= 7;
 353   while ($num) {
 354     $result = pack('C', 0x80 | ($num & 0x7F)) . $result;
 355     $num >>= 7;
 356   }
 357   return $result;
 358 }
 359
 360 sub DEROID($)
 361 {
 362   # return a DER encoded OID complete with leading 0x06 and DER length
 363   # Input is a string of decimal numbers separated by '.' with at least
 364   # two numbers required.
 365   no warnings;
 366   my @ids = split(/[.]/,$_[0]);
 367   push(@ids, 0) while @ids < 2; # return something that's kind of valid
 368   unshift(@ids, shift(@ids) * 40 + shift(@ids)); # combine first two
 369   my $ans = '';
 370   foreach my $num (@ids) {
 371     $ans .= SingleOID($num);
 372   }
 373   return pack('C',0x6).DERLength(length($ans)).$ans;
 374 }
 375
 376 sub DERTime($)
 377 {
 378   my $t = shift; # a time() value
 379   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t);
 380   $year += 1900;
 381   ++$mon;
 382   my $tag;
 383   my $tstr;
 384   if (1950 <= $year && $year < 2050) {
 385     # UTCTime
 386     $tag = 0x17;
 387     $tstr = sprintf("%02d%02d%02d%02d%02d%02dZ", $year % 100, $mon, $mday,
 388       $hour, $min, $sec);
 389   }
 390   else {
 391     # GeneralizedTime
 392     $tag = 0x18;
 393     $tstr = sprintf("%04d%02d%02d%02d%02d%02dZ", $year, $mon, $mday,
 394       $hour, $min, $sec);
 395   }
 396   return pack('C',$tag).DERLength(length($tstr)).$tstr;
 397 }
 398
 399 sub DERInteger($)
 400 {
 401   my $int = shift; # an integer value, may be negative
 402   my @bytes = unpack('C*',pack('N',$int));
 403   shift @bytes while @bytes >= 2 && $bytes[0] == 255 && ($bytes[1] & 0x80);
 404   shift @bytes while @bytes >= 2 && $bytes[0] == 0 && !($bytes[1] & 0x80);
 405   return pack('C*',0x02,scalar(@bytes),@bytes);
 406 }
 407
 408 sub RandomID(;$)
 409 {
 410   # return 20 random bytes except that the first byte has its high bit clear
 411   my $suppress = shift || 0;
 412   print STDERR "Generating serial number, please wait...\n" unless $suppress;
 413   open(RANDIN, "<", "/dev/random")
 414     or die "Cannot open /dev/random for input\n";
 415   my $result = '';
 416   for (my $cnt = 0; $cnt < 20; ++$cnt) {
 417     my $byte;
 418     sysread(RANDIN, $byte, 1)
 419       or die "Cannot read from /dev/random\n";
 420     if (!$cnt) {
 421       my $val = unpack('C', $byte);
 422       $val &= 0x7F;
 423       $byte = pack('C', $val);
 424     }
 425     $result .= $byte;
 426   }
 427   close(RANDIN);
 428   print STDERR "...done creating serial number.\n" unless $suppress;
 429   return $result;
 430 }
 431
 432 sub ReadDERLength($)
 433 {
 434   # Input is a DER encoded length with possibly extra trailing bytes
 435   # Output is an array of length and bytes-used-for-encoded-length
 436   my $der = shift;
 437   return undef unless length($der);
 438   my $byte = unpack('C',substr($der,0,1));
 439   return ($byte, 1) if $byte <= 127;
 440   return undef if $byte == 128 || $byte > 128+8; # Fail if greater than 2^64
 441   my $cnt = $byte & 0x7F;
 442   return undef unless length($der) >= $cnt+1; # Fail if not enough bytes
 443   my $val = 0;
 444   for (my $i = 0; $i < $cnt; ++$i) {
 445     $val <<= 8;
 446     $val |= unpack('C',substr($der,$i+1,1));
 447   }
 448   return ($val, $cnt+1);
 449 }
 450
 451 sub DERTimeStr($)
 452 {
 453   my $der = shift;
 454   return undef unless length($der) >= 2;
 455   my $byte = unpack('C',substr($der,0,1));
 456   return undef unless $byte == 0x17 || $byte == 0x18;
 457   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 458   return undef unless length($der) == 1 + $lenbytes + $len;
 459   return undef
 460     unless ($byte == 0x17 && $len == 13) || ($byte == 0x18 && $len == 15);
 461   substr($der,0,1+$lenbytes) = '';
 462   if ($byte == 0x17) {
 463     no warnings;
 464     my $year = substr($der,0,2) + 1900;
 465     $year += 100 if $year < 1950;
 466     $der = sprintf("%04d",$year).substr($der,2);
 467   }
 468   return substr($der,0,4).'-'.substr($der,4,2).'-'.substr($der,6,2).'_'.
 469     substr($der,8,2).':'.substr($der,10,2).':'.substr($der,12,3);
 470 }
 471
 472 sub GetOpenSSHKeyInfo($)
 473 {
 474   # Input is an OpenSSH public key in .pub format
 475   # Output is an array of:
 476   #   how many bits in the modulus
 477   #   the public exponent
 478   #   the key id
 479   #   the OpenSSH md5 fingerprint
 480   #   the OpenSSH sha1 fingerprint
 481   #   the OpenSSH comment (may be '')
 482   #   the OpenSSH public key in OpenSSL PUBLIC KEY DER format
 483   # or undef if the key is unparseable
 484   # or just the key type if it's not ssh-rsa
 485   #
 486   # Expected format is:
 487   #   ssh-rsa BASE64PUBLICKEYDATA optional comment here
 488   # where the BASE64PUBLICKEYDATA when decoded produces:
 489   #   4 Byte Big-Endian length of Key type (must be 7 for RSA)
 490   #   Key type WITHOUT terminating NUL (must be ssh-rsa for RSA)
 491   #   4 Byte Big-Endian length of public exponent
 492   #   Public exponent integer bytes
 493   #   4 Byte Big-Endian length of modulus
 494   #   Modulus integer bytes
 495   # no extra trailing bytes are permitted
 496   my $input = shift;
 497   $input =~ s/((?:\r\n|\n|\r).*)$//os;
 498   my @fields = split(' ', $input, 3);
 499   return undef unless @fields >= 2;
 500   my $data = decode_base64($fields[1]);
 501   my $origData = $data;
 502   my @parts = ();
 503   while (length($data) >= 4) {
 504     my $len = unpack('N',substr($data,0,4));
 505     my $value = '';
 506     if ($len > 0) {
 507       return undef if $len + 4 > length($data);
 508       $value = substr($data,4,$len);
 509     }
 510     push(@parts, $value);
 511     substr($data, 0, 4+$len) = '';
 512   }
 513   return undef unless length($data) == 0;
 514   return $parts[0]
 515     if @parts >= 1 && defined($parts[0]) && $parts[0] && $parts[0] ne 'ssh-rsa';
 516   return undef unless @parts == 3;
 517
 518   my $rsaEncryption = DEROID('1.2.840.113549.1.1.1'); # :rsaEncryption
 519   $rsaEncryption = pack('C',0x30).DERLength(length($rsaEncryption)+2)
 520     .$rsaEncryption.pack('C2',0x05,0x00);
 521   my $pubrsa = pack('C',0x2).DERLength(length($parts[2])).$parts[2]; # modulus
 522   $pubrsa .= pack('C',0x2).DERLength(length($parts[1])).$parts[1]; # exponent
 523   $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
 524   my $id = sha1($pubrsa); # The id is the sha1 hash of the private key part
 525   $pubrsa = pack('C',0x3).DERLength(length($pubrsa)+1).pack('C',0x0).$pubrsa;
 526   $pubrsa = $rsaEncryption.$pubrsa;
 527   $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
 528
 529   my $bits = length($parts[2]) * 8;
 530   # But we have to discount any leading 0 bits in the first byte
 531   my $byte = unpack('C',substr($parts[2],0,1));
 532   if (!$byte) {
 533     $bits -= 8;
 534   }
 535   else {
 536     return undef if $byte & 0x80; # negative modulus is not allowed
 537     while (!($byte & 0x80)) {
 538       --$bits;
 539       $byte <<= 1;
 540     }
 541   }
 542
 543   my $rawexp = $parts[1];
 544   my $exp;
 545   if (length($rawexp) > 8) {
 546     # Fudge the result because it's bigger than a 64-bit number
 547     my $lastbyte = unpack('C',substr($rawexp,-1,1));
 548     $exp = $lastbyte & 0x01 ? 65537 : 65536;
 549   }
 550   else {
 551     $exp = 0;
 552     while (length($rawexp)) {
 553       $exp <<= 8;
 554       $exp |= unpack('C',substr($rawexp,0,1));
 555       substr($rawexp,0,1) = '';
 556     }
 557   }
 558
 559   return ($bits,$exp,$id,md5($origData),sha1($origData),$fields[2]||'',$pubrsa);
 560 }
 561
 562 sub GetKeyInfo($)
 563 {
 564   # Input is an RSA PRIVATE KEY in DER format
 565   # Output is an array of:
 566   #   how many bits in the modulus
 567   #   the public exponent
 568   #   the key id
 569   #   the OpenSSH md5 fingerprint
 570   #   the OpenSSH sha1 fingerprint
 571   # or undef if the key is unparseable
 572   #
 573   # Expected format is:
 574   #   SEQUENCE {
 575   #     SEQUENCE {
 576   #       OBJECT IDENTIFIER :rsaEncryption = 1.2.840.113549.1.1.1
 577   #       NULL
 578   #     }
 579   #     BIT STRING (primitive) {
 580   #       0 unused bits
 581   #       SEQUENCE { # this part is the contents of an "RSA PUBLIC KEY" file
 582   #         INTEGER modulus
 583   #         INTEGER publicExponent
 584   #       }
 585   #     }
 586   #   }
 587
 588   no warnings;
 589   my $der = shift;
 590   my $rawmod;
 591   my $rawexp;
 592
 593   return undef if unpack('C',substr($der,0,1)) != 0x30;
 594   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 595   return undef unless length($der) == 1 + $lenbytes + $len;
 596   substr($der, 0, 1 + $lenbytes) = '';
 597
 598   # the algorithm part always encodes as 30 0d 06092a864886f70d010101 0500
 599   return undef
 600     unless substr($der, 0, 15) = pack('H*',"300d06092a864886f70d0101010500");
 601   substr($der, 0, 15) = '';
 602
 603   return undef if unpack('C',substr($der,0,1)) != 0x03;
 604   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 605   return undef unless length($der) == 1 + $lenbytes + $len && $len >= 1;
 606   return undef unless unpack('C',substr($der, 1 + $lenbytes, 1)) == 0x00;
 607   substr($der, 0, 1 + $lenbytes + 1) = '';
 608
 609   return undef if unpack('C',substr($der,0,1)) != 0x30;
 610   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 611   return undef unless length($der) == 1 + $lenbytes + $len;
 612   my $id = sha1($der); # The id is the sha1 hash of the private key part
 613   substr($der, 0, 1 + $lenbytes) = '';
 614
 615   return undef if unpack('C',substr($der,0,1)) != 0x02;
 616   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 617   substr($der, 0, 1 + $lenbytes) = '';
 618   my $derexp = substr($der, $len);
 619   substr($der, $len) = '';
 620   return undef unless $len >= 1;
 621   $rawmod = $der;
 622   my $bits = length($der) * 8;
 623   # But we have to discount any leading 0 bits in the first byte
 624   my $byte = unpack('C',substr($der,0,1));
 625   if (!$byte) {
 626     $bits -= 8;
 627   }
 628   else {
 629     return undef if $byte & 0x80; # negative modulus is not allowed
 630     while (!($byte & 0x80)) {
 631       --$bits;
 632       $byte <<= 1;
 633     }
 634   }
 635
 636   $der = $derexp;
 637   return undef if unpack('C',substr($der,0,1)) != 0x02;
 638   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 639   substr($der, 0, 1 + $lenbytes) = '';
 640   return undef unless length($der) == $len && $len >= 1;
 641   return undef if unpack('C',substr($der,0,1)) & 0x80; # negative pub exp bad
 642   $rawexp = $der;
 643   my $exp;
 644   if ($len > 8) {
 645     # Fudge the result because it's bigger than a 64-bit number
 646     my $lastbyte = unpack('C',substr($der,-1,1));
 647     $exp = $lastbyte & 0x01 ? 65537 : 65536;
 648   }
 649   else {
 650     $exp = 0;
 651     while (length($der)) {
 652       $exp <<= 8;
 653       $exp |= unpack('C',substr($der,0,1));
 654       substr($der,0,1) = '';
 655     }
 656   }
 657
 658   my $tohash = pack('N',7)."ssh-rsa".pack('N',length($rawexp)).$rawexp
 659     .pack('N',length($rawmod)).$rawmod;
 660
 661   return ($bits,$exp,$id,md5($tohash),sha1($tohash));
 662 }
 663
 664 sub GetCertInfo($)
 665 {
 666   # Input is an X.509 "Certificate" (RFC 5280) in DER format
 667   # Output is an array of:
 668   #   version (1, 2, or 3)
 669   #   serial number (just the serial number data bytes, no header or length)
 670   #   issuer name as a DER "Name"
 671   #   validity start as a DER "Time"
 672   #   validity end as a DER "Time"
 673   #   subject name as a DER "Name"
 674   #   subject public key as a DER "SubjectPublicKeyInfo"
 675   #   subject public key id if v3 Extension SubjectKeyIdentifier is present
 676   #     otherwise undef.  This is just the raw bytes of the key id, no DER
 677   #     header.  (Same format as returned by GetKeyInfo and GetOpenSSHKeyInfo.)
 678   # or undef if the certificate is unparseable
 679
 680   no warnings;
 681   my $der = shift;
 682   my $subjectKeyIdentifier = DEROID('2.5.29.14');
 683   return undef if unpack('C',substr($der,0,1)) != 0x30;
 684   my ($len, $lenbytes) = ReadDERLength(substr($der,1));
 685   return undef unless length($der) == 1 + $lenbytes + $len;
 686   substr($der, 0, 1 + $lenbytes) = '';
 687   return undef if unpack('C',substr($der,0,1)) != 0x30;
 688   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 689   return undef unless length($der) >= 1 + $lenbytes + $len;
 690   substr($der, 0, 1 + $lenbytes) = '';
 691   substr($der, $len) = '';
 692   my $byte = unpack('C',substr($der,0,1));
 693   my $ver = 1;
 694   if ($byte == 0xA0) {
 695     return undef if length($der) < 5 || substr($der,1,3) != pack('H*','030201');
 696     $byte = unpack('C',substr($der,4,1));
 697     # Zero shouldn't be allowed as it's DEFAULT but we'll let it go by
 698     return undef if $byte > 2; # unrecognized version
 699     $ver = $byte + 1;
 700     substr($der,0,5) = '';
 701   }
 702   return undef if unpack('C',substr($der,0,1)) != 0x02;
 703   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 704   return undef unless length($der) > 1+$lenbytes+$len && $len >= 1;
 705   substr($der, 0, 1 + $lenbytes) = '';
 706   my $serial = substr($der, 0, $len);
 707   substr($der, 0, $len) = '';
 708   return undef if unpack('C',substr($der,0,1)) != 0x30; # Alg ID
 709   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 710   return undef unless length($der) > 1+$lenbytes+$len;
 711   substr($der,0,1+$lenbytes+$len) = '';
 712   return undef if unpack('C',substr($der,0,1)) != 0x30; # Issuer
 713   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 714   return undef unless length($der) > 1+$lenbytes+$len;
 715   my $issuer = substr($der, 0, 1 + $lenbytes + $len);
 716   substr($der,0,1+$lenbytes+$len) = '';
 717   return undef if unpack('C',substr($der,0,1)) != 0x30; # Validity
 718   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 719   return undef unless length($der) > 1+$lenbytes+$len;
 720   my $validlen = $len;
 721   substr($der, 0, 1 + $lenbytes) = '';
 722   $byte = unpack('C', substr($der, 0, 1));
 723   return undef unless $byte == 0x17 || $byte == 0x18;
 724   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 725   return undef unless length($der) > 1+$lenbytes+$len;
 726   my $vst = substr($der, 0, 1 + $lenbytes + $len);
 727   substr($der, 0, 1+$lenbytes+$len) = '';
 728   $byte = unpack('C', substr($der, 0, 1));
 729   return undef unless $byte == 0x17 || $byte == 0x18;
 730   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 731   return undef unless length($der) > 1+$lenbytes+$len;
 732   my $vnd = substr($der, 0, 1 + $lenbytes + $len);
 733   substr($der, 0, 1+$lenbytes+$len) = '';
 734   return undef unless $validlen == length($vst) + length($vnd);
 735   return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject
 736   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 737   return undef unless length($der) > 1+$lenbytes+$len;
 738   my $subj = substr($der, 0, 1 + $lenbytes + $len);
 739   substr($der, 0, 1+$lenbytes+$len) = '';
 740   return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject PubKey
 741   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 742   return undef unless length($der) >= 1+$lenbytes+$len;
 743   my $subjkey = substr($der, 0, 1 + $lenbytes + $len);
 744   substr($der, 0, 1+$lenbytes+$len) = '';
 745   return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,undef)
 746     if !length($der) || $ver < 3;
 747   $byte = unpack('C',substr($der,0,1));
 748   if ($byte == 0x81) {
 749     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 750     return undef unless length($der) >= 1+$lenbytes+$len;
 751     substr($der,0,1+$lenbytes+$len) = '';
 752     $byte = unpack('C',substr($der,0,1));
 753   }
 754   if ($byte == 0x82) {
 755     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 756     return undef unless length($der) >= 1+$lenbytes+$len;
 757     substr($der,0,1+$lenbytes+$len) = '';
 758     $byte = unpack('C',substr($der,0,1));
 759   }
 760   return undef if length($der) && $byte != 0xA3; # exts tag
 761   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 762   return undef unless length($der) == 1+$lenbytes+$len;
 763   my $skid = undef;
 764   substr($der, 0, 1+$lenbytes) = '';
 765   return undef unless unpack('C',substr($der,0,1)) == 0x30; # Extensions
 766   ($len, $lenbytes) = ReadDERLength(substr($der,1));
 767   return undef unless length($der) == 1+$lenbytes+$len;
 768   substr($der, 0, 1+$lenbytes) = '';
 769   while (length($der)) {
 770     return undef unless unpack('C',substr($der,0,1)) == 0x30;
 771     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 772     return undef unless length($der) >= 1+$lenbytes+$len;
 773     substr($der,0,1+$lenbytes) = '';
 774     return undef unless unpack('C',substr($der,0,1)) == 0x06;
 775     if (substr($der,0,length($subjectKeyIdentifier)) ne $subjectKeyIdentifier) {
 776       substr($der,0,$len) = '';
 777       next;
 778     }
 779     substr($der,0,length($subjectKeyIdentifier)) = '';
 780     if (unpack('C',substr($der,0,1)) == 0x01) {
 781       # SHOULDn't really be here, but allow it anyway
 782       return undef unless unpack('C',substr($der,1,1)) == 0x01;
 783       substr($der,0,3) = '';
 784     }
 785     return undef unless unpack('C',substr($der,0,1)) == 0x04;
 786     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 787     return undef unless length($der) >= 1+$lenbytes+$len && $len > 1;
 788     substr($der,0,1+$lenbytes) = '';
 789     return undef unless unpack('C',substr($der,0,1)) == 0x04;
 790     ($len, $lenbytes) = ReadDERLength(substr($der,1));
 791     return undef unless length($der) >= 1+$lenbytes+$len && $len >= 1;
 792     $skid = substr($der,1+$lenbytes,$len);
 793     last;
 794   }
 795   return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,$skid)
 796 }
 797
 798 sub BreakLine($$)
 799 {
 800   my ($line,$width) = @_;
 801   my @ans = ();
 802   return $line if $width < 1;
 803   while (length($line) > $width) {
 804     push(@ans, substr($line, 0, $width));
 805     substr($line, 0, $width) = '';
 806   }
 807   push(@ans, $line) if length($line);
 808   return @ans;
 809 }
 810
 811 sub tests
 812 {
 813   print STDERR unpack('H*', DEROID('2.100.3')),"\n"; # should be 0603813403
 814   for (my $i=0; $i<16; ++$i) {
 815     print STDERR unpack('H*', RandomID(1)),"\n"; # Hi bit should NOT be set
 816   }
 817 }
 818
 819 sub GetDigest($)
 820 {
 821   my $dgst = shift;
 822   my $sha1   = DEROID('1.3.14.3.2.26');
 823   my $sha224 = DEROID('2.16.840.1.101.3.4.2.4');
 824   my $sha256 = DEROID('2.16.840.1.101.3.4.2.1');
 825   my $sha384 = DEROID('2.16.840.1.101.3.4.2.2');
 826   my $sha512 = DEROID('2.16.840.1.101.3.4.2.3');
 827   my $sha1WithRSAEncryption   = DEROID('1.2.840.113549.1.1.5');
 828   my $sha224WithRSAEncryption = DEROID('1.2.840.113549.1.1.14');
 829   my $sha256WithRSAEncryption = DEROID('1.2.840.113549.1.1.11');
 830   my $sha384WithRSAEncryption = DEROID('1.2.840.113549.1.1.12');
 831   my $sha512WithRSAEncryption = DEROID('1.2.840.113549.1.1.13');
 832   return ($sha1, $sha1WithRSAEncryption, \&sha1) if $dgst eq 'sha1';
 833   my $h = undef;
 834   my $oid = undef;
 835   my $func = undef;
 836   for (;;) {
 837     $h=$sha224,$oid=$sha224WithRSAEncryption,$func=\&sha224,last
 838       if $dgst eq 'sha224';
 839     $h=$sha256,$oid=$sha256WithRSAEncryption,$func=\&sha256,last
 840       if $dgst eq 'sha256';
 841     $h=$sha384,$oid=$sha384WithRSAEncryption,$func=\&sha384,last
 842       if $dgst eq 'sha384';
 843     $h=$sha512,$oid=$sha512WithRSAEncryption,$func=\&sha512,last
 844       if $dgst eq 'sha512';
 845     last;
 846   }
 847   die "Invalid digest ($dgst) must be one of:\n"
 848     . "  sha1 sha224 sha256 sha384 sha512\n" unless $h && $oid;
 849   die "Digest $dgst requires Digest::SHA or Digest::SHA::PurePerl "
 850     . "to be available\n" if !$hasSha2;
 851   return ($h,$oid,$func);
 852 }
 853
 854 sub toupper($)
 855 {
 856   my $str = shift;
 857   $str =~ tr/a-z/A-Z/;
 858   return $str;
 859 }
 860
 861 sub tolower($)
 862 {
 863   my $str = shift;
 864   $str =~ tr/A-Z/a-z/;
 865   return $str;
 866 }
 867
 868 sub RSASign($$)
 869 {
 870   my ($data, $keyfile) = @_;
 871   my $sig;
 872   {
 873     local(*CHLD_OUT, *CHLD_IN);
 874     #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
 875     #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
 876     (my $pid = open2(\*CHLD_OUT, \*CHLD_IN, "openssl", "rsautl", "-sign",
 877         "-inkey", $keyfile))
 878       or die "Cannot start openssl rsautl\n";
 879     print CHLD_IN $data;
 880     close(CHLD_IN);
 881     local $/;
 882     die "Error reading RSA signature from openssl rsautl\n"
 883       unless !!($sig = <CHLD_OUT>);
 884     waitpid($pid, 0);
 885     close(CHLD_OUT);
 886     #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
 887   }
 888   return $sig;
 889 }
 890
 891 sub main
 892 {
 893   Make1252(); # Set up the UTF-8 auxiliary conversion table
 894
 895   my $help = '';
 896   my $verbose = '';
 897   my $quiet = '';
 898   my $keyfile = '';
 899   my $certfile = '';
 900   my $useNow = '';
 901   my $useRandom = '';
 902   my $termOK = '';
 903   my $server = '';
 904   my $codesign = '';
 905   my $applecodesign = '';
 906   my $client = '';
 907   my $email = '';
 908   my $subca = '';
 909   my $root = '';
 910   my $rootauth = '';
 911   my $authext = '';
 912   my $digest = $hasSha2 ? 'sha256' : 'sha1';
 913   my $digestChoice = '';
 914   my $debug = 0;
 915   my $pubx509 = '';
 916   my $check = '';
 917   my $pathlen = '';
 918   my $commonName = DEROID('2.5.4.3'); # :commonName
 919   my $serialNumber = DEROID('2.5.4.5'); # :serialNumber
 920   my $userId = DEROID('0.9.2342.19200300.100.1.1'); # :userId
 921   my $emailAddress = DEROID('1.2.840.113549.1.9.1'); # :emailAddress
 922   my $basicConstraints = DEROID('2.5.29.19');
 923   my $keyUsage = DEROID('2.5.29.15');
 924   my $extKeyUsage = DEROID('2.5.29.37');
 925   my $serverAuth = DEROID('1.3.6.1.5.5.7.3.1');
 926   my $clientAuth = DEROID('1.3.6.1.5.5.7.3.2');
 927   my $codeSigning = DEROID('1.3.6.1.5.5.7.3.3');
 928   my $emailProtection = DEROID('1.3.6.1.5.5.7.3.4');
 929   my $appleCodeSigning = DEROID('1.2.840.113635.100.4.1');
 930   my $authKeyId = DEROID('2.5.29.35');
 931   my $subjKeyId = DEROID('2.5.29.14');
 932   my $subjAltName = DEROID('2.5.29.17');
 933   my $boolTRUE = pack('C*',0x01,0x01,0xFF);
 934   my $boolFALSE = pack('C*',0x01,0x01,0x00);
 935   my $v3Begin = pack('C',0x17).DERLength(13)."970811000000Z";
 936   my $noExpiry = pack('C',0x18).DERLength(15)."99991231235959Z";
 937
 938   #tests;
 939   eval {GetOptions(
 940       "help|h" => sub{$help=1;die"!FINISH"},
 941       "verbose|v" => \$verbose,
 942       "version|V" => sub{print STDERR $VERSIONMSG;exit(0)},
 943       "debug" => \$debug,
 944       "quiet" => \$quiet,
 945       "pubx509" => \$pubx509,
 946       "pubX509" => \$pubx509,
 947       "check" => \$check,
 948       "now" => \$useNow,
 949       "random" => \$useRandom,
 950       "t" => \$termOK,
 951       "server" => \$server,
 952       "codesign" => \$codesign,
 953       "applecodesign" => \$applecodesign,
 954       "email" => \$email,
 955       "client" => \$client,
 956       "subca" => \$subca,
 957       "root" => \$root,
 958       "rootauth" => \$rootauth,
 959       "authext" => \$authext,
 960       "digest=s" => \$digestChoice,
 961       "key|k=s" => \$keyfile,
 962       "cert|c=s" => \$certfile,
 963       "pathlen=i" => \$pathlen
 964     )} || $help
 965       or die $USAGE;
 966   if ($help) {
 967     local *MAN;
 968     my $pager = $ENV{'PAGER'} || 'less';
 969     if (-t STDOUT && open(MAN, "|-", $pager)) {
 970       print MAN formatman($HELP,1);
 971       close(MAN);
 972     }
 973     else {
 974       print formatman($HELP);
 975     }
 976     exit(0);
 977   }
 978   $client = 1 if
 979     !$root && !$subca && !$server && !$codesign && !$applecodesign && !$email;
 980   $verbose = 1 if $debug || $check;
 981   $quiet = 0 if $verbose || $check;
 982   print STDERR $VERSIONMSG if $verbose;
 983   my $keytype = 'OpenSSH';
 984   $keytype = 'pubx509' if $pubx509;
 985   die $USAGE if !$keyfile || (!$root && !$certfile) || (!$check && @ARGV != 1);
 986   die "Standard input is a tty (which is an unlikely source of a $keytype "
 987     . "public key)\n"
 988     . "If that's what you truly meant, add the -t option to allow it.\n"
 989     if !$root && -t STDIN && !$termOK;
 990   die "Name may not be empty\n"
 991     unless $check || $ARGV[0] || ($root && $useRandom);
 992   my $opensshdotpub;
 993   if (!$root) {
 994     local $/ if $pubx509;
 995     !!($opensshdotpub = <STDIN>)
 996       or die "Cannot read $keytype public key from STDIN\n";
 997   }
 998   die "Cannot read key file $keyfile\n" if ! -r $keyfile;
 999   die "Cannot read certificate file $certfile\n" if !$root && ! -r $certfile;
1000   my ($did, $dalg, $dfunc) = GetDigest($digestChoice || $digest);
1001   print STDERR "default digest: $digest\n" if $debug;
1002   warn "*** Warning: defaulting to sha1 since sha256 support not available\n"
1003     if !$quiet && $digest eq 'sha1' && !$digestChoice;
1004   $digest = $digestChoice if $digestChoice;
1005   warn "*** Warning: sha1 use is strongly discouraged, continuing anyway\n"
1006     if !$quiet && $digest eq 'sha1';
1007   print STDERR "Using digest $digest\n" if $verbose;
1008
1009   my ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub);
1010   if ($root) {
1011     # need to set $sshkeyid to $pubkeyid
1012     # need to set $opensshpub to $pubkey
1013     # but don't have either yet, so do it later
1014   }
1015   elsif ($pubx509) {
1016     local (*READKEY, *WRITEKEY);
1017     my $inform = $opensshdotpub =~ m|^[\t\n\r\x20-\x7E]*$|os ? 'PEM' : 'DER';
1018     print STDERR "pubx509 -inform $inform\n" if $debug;
1019     open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1020     open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1021     my $pid = open2(\*READKEY, \*WRITEKEY, "openssl", "rsa", "-inform",
1022       $inform, "-pubin", "-outform", "DER", "-pubout");
1023     open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1024     $pid or die "Cannot start openssl rsa\n";
1025     print WRITEKEY $opensshdotpub;
1026     close(WRITEKEY);
1027     local $/;
1028     die "Error reading X.509 format RSA public key from standard input\n"
1029       unless !!($opensshpub = <READKEY>);
1030     waitpid($pid, 0);
1031     close(READKEY);
1032     $sshcmnt = undef;
1033     ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1) = GetKeyInfo($opensshpub);
1034     die "Unparseable X.509 public key format read from standard input\n"
1035       unless $sshkeybits;
1036   }
1037   else {
1038     ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub) =
1039       GetOpenSSHKeyInfo($opensshdotpub);
1040     die "Unparseable OpenSSH public key read from STDIN\n" unless $sshkeybits;
1041     die "Unsupported OpenSSH public key type ($sshkeybits), must be ssh-rsa\n"
1042       unless $sshkeyexp;
1043   }
1044   if (!$root) {
1045     print STDERR "$keytype Public Key Info:\n",
1046         "  bits=$sshkeybits pubexp=$sshkeyexp\n" if $verbose;
1047     print STDERR "  keyid=",
1048       join(":", toupper(unpack("H*",$sshkeyid))=~/../g), "\n" if $verbose;
1049     print STDERR "  fingerprint(md5)=",
1050       join(":", tolower(unpack("H*",$sfmd5))=~/../g), "\n" if $verbose;
1051     print STDERR "  fingerprint(sha1)=",
1052       join(":", tolower(unpack("H*",$sfsha1))=~/../g), "\n" if $verbose;
1053     print STDERR "  comment=",$sshcmnt||'<none present>',"\n"
1054       if $verbose && !$pubx509;
1055     die "*** Error: $keytype key has less than 512 bits ($sshkeybits)\n"
1056       . "***        You might as well just donate your system to hackers now.\n"
1057       if $sshkeybits < 512;
1058     die "*** Error: The $keytype key's public exponent is even ($sshkeyexp)!\n"
1059       if !($sshkeyexp & 0x01);
1060     warn "*** Warning: The $keytype key has less than 2048 bits ($sshkeybits), "
1061       . "continuing anyway\n" if !$quiet && $sshkeybits < 2048;
1062     die "*** Error: The $keytype public key's exponent of $sshkeyexp is "
1063       . "unacceptably weak!\n" if $sshkeyexp < 35; # OpenSSH used 35 until v5.4
1064     warn "*** Warning: The $keytype public key's exponent ($sshkeyexp) is weak "
1065       . "(< 65537), continuing anyway\n" if !$quiet && $sshkeyexp < 65537;
1066   }
1067
1068   my $inform = -T $keyfile ? 'PEM' : 'DER';
1069   print STDERR "keyfile -inform $inform\n" if $debug;
1070   die "Input key does not appear to be in PEM format: $keyfile\n"
1071     unless $inform eq 'PEM';
1072   my $pubkey;
1073   {
1074     local *READKEY;
1075     open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1076     open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1077     open(READKEY, "-|", "openssl", "rsa", "-inform", $inform, "-outform", "DER",
1078         "-pubout", "-passin", "pass:", "-in", $keyfile)
1079       or die "Cannot read RSA private key in $keyfile\n";
1080     open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1081     local $/;
1082     die "Error reading RSA private key in $keyfile\n"
1083       unless !!($pubkey = <READKEY>);
1084     close(READKEY);
1085   }
1086   $opensshpub = $pubkey if $root;
1087   my ($pubkeybits,$pubkeyexp,$pubkeyid,$pfmd5,$pfsha1) = GetKeyInfo($pubkey);
1088   $sshkeyid = $pubkeyid if $root;
1089   die "Unparseable public key format in $keyfile\n" unless $pubkeybits;
1090   print STDERR "RSA Private Key $keyfile:\n",
1091     "  bits=$pubkeybits pubexp=$pubkeyexp\n" if $verbose;
1092   print STDERR "  keyid=",
1093     join(":", toupper(unpack("H*",$pubkeyid))=~/../g), "\n" if $verbose;
1094   print STDERR "  fingerprint(md5)=",
1095     join(":", tolower(unpack("H*",$pfmd5))=~/../g), "\n" if $verbose;
1096   print STDERR "  fingerprint(sha1)=",
1097     join(":", tolower(unpack("H*",$pfsha1))=~/../g), "\n" if $verbose;
1098   die "*** Error: Private key has less than 512 bits ($pubkeybits)\n"
1099     . "***        You might as well just donate your system to hackers now.\n"
1100     if $pubkeybits < 512;
1101   die "*** Error: The private key's public exponent is even ($pubkeyexp)!\n"
1102     if !($pubkeyexp & 0x01);
1103   warn "*** Warning: The private key has less than 2048 bits ($pubkeybits), "
1104     . "continuing anyway\n" if !$quiet && $pubkeybits < 2048;
1105   die "*** Error: The private key's public key exponent of $pubkeyexp is "
1106     . "unacceptably weak!\n" if $pubkeyexp < 35; # ssh-keygen used 35 'til v5.4
1107   warn "*** Warning: The private key's public exponent ($pubkeyexp) is weak "
1108     . "(< 65537), continuing anyway\n" if !$quiet && $pubkeyexp < 65537;
1109
1110   my ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid);
1111   if ($root) {
1112     $vst = $v3Begin;
1113     $vnd = $noExpiry;
1114     $subjkeyid = $pubkeyid;
1115   }
1116   else {
1117     $inform = -T $certfile ? 'PEM' : 'DER';
1118     print STDERR "certfile -inform $inform\n" if $debug;
1119     my $signcert;
1120     {
1121       local *READCERT;
1122       #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
1123       #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
1124       open(READCERT, "-|", "openssl", "x509", "-inform", $inform, "-outform",
1125           "DER", "-in", $certfile)
1126         or die "Cannot read X.509 certificate in $certfile\n";
1127       #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
1128       local $/;
1129       die "Error reading X.509 certificate in $certfile\n"
1130         unless !!($signcert = <READCERT>);
1131       close(READCERT);
1132     }
1133     ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid) =
1134       GetCertInfo($signcert);
1135     die "Unparseable certificate format in $certfile\n" unless $cver;
1136     my $dser = $cser;
1137     substr($dser,0,1) = '' if unpack('C',substr($cser,0,1)) == 0x00;
1138     print STDERR "X.509 Certificate $certfile:\n",
1139       "  ver=v$cver serial=", join(":", tolower(unpack("H*",$dser))=~/../g),"\n"
1140       if $verbose;
1141     print STDERR "  notBefore=",DERTimeStr($vst)||'Invalid Time',
1142       " notAfter=",DERTimeStr($vnd)||'Invalid Time',"\n" if $verbose;
1143     #print STDERR "  issuer=",DERNameStr($issuer),"\n" if $verbose;
1144     #print STDERR "  name=",DERNameStr($subj),"\n" if $verbose;
1145     print STDERR "  subj_keyid=", join(":", toupper(
1146       unpack("H*",$subjkeyid))=~/../g), "\n" if defined($subjkeyid) && $verbose;
1147     die "The private key is not the correct one for the certificate:\n".
1148       "  certificate: $certfile\n".
1149       "  private key: $keyfile\n" unless $subjkey eq $pubkey;
1150     if (!defined($subjkeyid)) {
1151       warn "*** Warning: The certificate has no subjectKeyIdentifier, "
1152         . "using RFC 5280 (1)\n";
1153       $subjkeyid = $pubkeyid;
1154     }
1155     warn "*** Warning: subjectKeyIdentifier non-standard, continuing anyway\n"
1156       unless $subjkeyid eq $pubkeyid;
1157     die "*** Error: The $keytype public key is the same as the certificate's "
1158       . "public key.\n"
1159       . "***        They must be different for security reasons.\n"
1160       if $pubkey eq $opensshpub;
1161   }
1162   return 0 if $check;
1163
1164   my $version = pack('CCCCC', 0xA0, 0x03, 0x02, 0x01, 0x02); # v3
1165   my $randval = $useRandom ? RandomID($quiet) : undef;
1166   my $sigAlg = $dalg . pack('CC',0x05,0x00);
1167   $sigAlg = pack('C',0x30).DERLength(length($sigAlg)).$sigAlg;
1168   my $name = MakeUTF8($ARGV[0]);
1169   $name = pack('C',$email?0x16:0x0C).DERLength(length($name)).$name;
1170   $name = (($server || $codesign || $subca || $root) ? $commonName :
1171     ($email ? $emailAddress : $userId)) . $name;
1172   $name = pack('C',0x30).DERLength(length($name)).$name;
1173   $name = pack('C',0x31).DERLength(length($name)).$name;
1174   if ($root && $useRandom) {
1175     my $serialRDN = join(":", tolower(unpack("H*",$randval))=~/../g);
1176     $serialRDN = pack('C',0x13).DERLength(length($serialRDN)).$serialRDN;
1177     $serialRDN = $serialNumber . $serialRDN;
1178     $serialRDN = pack('C',0x30).DERLength(length($serialRDN)).$serialRDN;
1179     $serialRDN = pack('C',0x31).DERLength(length($serialRDN)).$serialRDN;
1180     $name = $serialRDN . ($ARGV[0] ? $name : '');
1181   }
1182   $name = pack('C',0x30).DERLength(length($name)).$name;
1183   $subj = $name if $root;
1184   my $validity = ($useNow ? DERTime(time()) : $vst).$vnd;
1185   $validity = pack('C',0x30).DERLength(length($validity)).$validity;
1186   my $extCAVal;
1187   if ($subca || $root) {
1188     $extCAVal = $boolTRUE;
1189     if ($subca && $pathlen ne '') {
1190       $extCAVal .= DERInteger($pathlen);
1191     }
1192     $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
1193   }
1194   else {
1195     #$extCAVal = pack('C',0x30).DERLength(length($boolFALSE)).$boolFALSE;
1196     $extCAVal = pack('C',0x30).DERLength(0); # do not include DEFAULT value
1197   }
1198   $extCAVal = pack('C',0x04).DERLength(length($extCAVal)).$extCAVal;
1199   $extCAVal = $basicConstraints . $boolTRUE . $extCAVal;
1200   $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
1201   my $extKeyBits = ($subca || $root)  ? '0186' :
1202     ($server ? '05A0' : ($email ? '05E0' : '0780'));
1203   my $extKeyUse = pack('H*', '04040302'.$extKeyBits);
1204   $extKeyUse = $keyUsage . $boolTRUE. $extKeyUse;
1205   $extKeyUse = pack('C',0x30).DERLength(length($extKeyUse)).$extKeyUse;
1206   my $extXKeyUse = '';
1207   if ($server || $client || $codesign || $email || $applecodesign) {
1208     $extXKeyUse .= $serverAuth if $server;
1209     $extXKeyUse .= $clientAuth if $client;
1210     $extXKeyUse .= $codeSigning if $codesign;
1211     $extXKeyUse .= $emailProtection if $email;
1212     $extXKeyUse .= $appleCodeSigning if $applecodesign;
1213     $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
1214     $extXKeyUse = pack('C',0x04).DERLength(length($extXKeyUse)).$extXKeyUse;
1215     $extXKeyUse = $extKeyUsage . $boolTRUE . $extXKeyUse;
1216     $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
1217   }
1218   my $extSubjKey = pack('C',0x04).DERLength(length($sshkeyid)).$sshkeyid;
1219   $extSubjKey = pack('C',0x04).DERLength(length($extSubjKey)).$extSubjKey;
1220   $extSubjKey = $subjKeyId . $extSubjKey;
1221   $extSubjKey = pack('C',0x30).DERLength(length($extSubjKey)).$extSubjKey;
1222   my $extAuthKey = '';
1223   if (!$root || $rootauth) {
1224     $extAuthKey = pack('C',0x80).DERLength(length($pubkeyid)).$pubkeyid;
1225     if (!$root && $authext) {
1226       my $gen = pack('C',0xA4).DERLength(length($issuer)).$issuer;
1227       $extAuthKey .= pack('C',0xA1).DERLength(length($gen)).$gen;
1228       $extAuthKey .= pack('C',0x82).DERLength(length($cser)).$cser;
1229     }
1230     $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
1231     $extAuthKey = pack('C',0x04).DERLength(length($extAuthKey)).$extAuthKey;
1232     $extAuthKey = $authKeyId . $extAuthKey;
1233     $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
1234   }
1235   my $exts = $extCAVal . $extKeyUse . $extXKeyUse . $extSubjKey . $extAuthKey;
1236   if ($email) {
1237     my $extSubjAlt = MakeUTF8($ARGV[0]);
1238     $extSubjAlt = pack('C',0x81).DERLength(length($extSubjAlt)).$extSubjAlt;
1239     $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
1240     $extSubjAlt = pack('C',0x04).DERLength(length($extSubjAlt)).$extSubjAlt;
1241     $extSubjAlt = $subjAltName . $extSubjAlt; # not crit unless empty DN
1242     $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
1243     $exts .= $extSubjAlt;
1244   }
1245   $exts = pack('C',0x30).DERLength(length($exts)).$exts;
1246   $exts = pack('C',0xA3).DERLength(length($exts)).$exts;
1247   my $serial;
1248   if ($useRandom) {
1249     $serial = pack('C',0x2).DERLength(length($randval)).$randval;
1250   }
1251   else {
1252     my $idtohash = $version.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
1253     $idtohash = pack('C',0x30).DERLength(length($idtohash)).$idtohash;
1254     my $idhash = sha1($idtohash);
1255     my $byte0 = unpack('C',substr($idhash,0,1));
1256     $byte0 &= 0x7F;
1257     substr($idhash,0,1) = pack('C',$byte0);
1258     $serial = pack('C',0x2).DERLength(length($idhash)).$idhash;
1259   }
1260   my $tbs = $version.$serial.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
1261   $tbs = pack('C',0x30).DERLength(length($tbs)).$tbs;
1262   my $tbsseq = &$dfunc($tbs);
1263   $tbsseq = pack('C',0x04).DERLength(length($tbsseq)).$tbsseq;
1264   my $algid = $did . pack('CC',0x05,0x00);
1265   $algid = pack('C',0x30).DERLength(length($algid)).$algid;
1266   $tbsseq = $algid . $tbsseq;
1267   $tbsseq = pack('C',0x30).DERLength(length($tbsseq)).$tbsseq;
1268   my $sig = RSASign($tbsseq, $keyfile);
1269   $sig = pack('C',0x03).DERLength(length($sig)+1).pack('C',0x00).$sig;
1270   my $cert = $tbs . $sigAlg . $sig;
1271   $cert = pack('C',0x30).DERLength(length($cert)).$cert;
1272   my $base64 = join("\n", BreakLine(encode_base64($cert, ''), 64))."\n";
1273   print "-----BEGIN CERTIFICATE-----\n",
1274         $base64,
1275         "-----END CERTIFICATE-----\n";
1276   return 0;
1277 }