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