CACreateCert: support --request and --utf8

[ezcert.git] / CACreateCert

#!/usr/bin/env perl

# CACreateCert - Create various types of certificates
# Copyright (C) 2011-2017 Kyle J. McKay.
# All rights reserved.

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

exit(&main());

use strict;
use warnings;
use bytes;

use MIME::Base64;
use IPC::Open2;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Getopt::Long qw(:config gnu_getopt);

our $VERSION;
my $VERSIONMSG;
my $HELP;
my $USAGE;

my $hasSha2;

BEGIN {
  *VERSION = \'1.4.0';
  $VERSIONMSG = "CACreateCert version $VERSION\n" .
    "Copyright (C) 2011-2017 Kyle J. McKay.  All rights reserved.\n" .
    "License AGPLv3+: GNU Affero GPL version 3 or later.\n" .
    "http://gnu.org/licenses/agpl.html\n" .
    "This is free software: you are free to change and redistribute it.\n" .
    "There is NO WARRANTY, to the extent permitted by law.\n";
}

BEGIN {
  $hasSha2 = 0;

  eval {
    require Digest::SHA;
    Digest::SHA->import(
      qw(
        sha1 sha1_hex sha1_base64
        sha224 sha224_hex sha224_base64
        sha256 sha256_hex sha256_base64
        sha384 sha384_hex sha384_base64
        sha512 sha512_hex sha512_base64
      )
    ); $hasSha2=1} ||
  eval {
    require Digest::SHA::PurePerl;
    require Digest::SHA1;
    Digest::SHA1->import(
      qw(
        sha1 sha1_hex sha1_base64
      )
    );
    Digest::SHA::PurePerl->import(
      qw(
        sha224 sha224_hex sha224_base64
        sha256 sha256_hex sha256_base64
        sha384 sha384_hex sha384_base64
        sha512 sha512_hex sha512_base64
      )
    ); $hasSha2=1} ||
  eval {
    require Digest::SHA::PurePerl;
    Digest::SHA::PurePerl->import(
      qw(
        sha1 sha1_hex sha1_base64
        sha224 sha224_hex sha224_base64
        sha256 sha256_hex sha256_base64
        sha384 sha384_hex sha384_base64
        sha512 sha512_hex sha512_base64
      )
    ); $hasSha2=1} ||
  eval {
    require Digest::SHA1;
    Digest::SHA1->import(
      qw(
        sha1 sha1_hex sha1_base64
      )
    ); 1} ||
  die "One of Digest::SHA1 or Digest::SHA or Digest::SHA::PurePerl "
    . "must be available\n";

  eval {(`openssl version -v 2>/dev/null` || '') =~ /^(?:Open|Libre)SSL /} ||
    die "OpenSSL/LibreSSL (as the openssl command) is not available in the PATH\n";
}

BEGIN {
  $USAGE = <<USAGE;
Usage: CACreateCert [-h] [--version] [--verbose] [--debug] [--quiet] [--check]
         [--now] [--pubx509] [-t] [--digest=sha1|sha224|sha256|sha384|sha512]
         [--root | --subca | --server | --codesign | --applecodesign | --email]
         [--client] [--rootauth] [--authext] [--pathlen n] [--suffix suffix.pem]
         [--random | --no-random] [--in pub_key_file] [--out out_cert.pem]
         [--cert signing_cert] [--dni k=v] [--dns "name-or-ip"] [--dnq "qual"]
         [--request [--no-extensions]] [--utf8] --key priv_key_file "name str"
USAGE
  $HELP = <<HELP;
NAME
       CACreateCert -- create X.509 certificate

SYNOPSIS
       CACreateCert [-h] [--version] [--verbose] [--debug] [--quiet] [--check]
         [--now] [--pubx509] [-t] [--digest=sha1|sha224|sha256|sha384|sha512]
         [--root | --subca | --server | --codesign | --applecodesign | --email]
         [--client] [--rootauth] [--authext] [--pathlen n] [--suffix suffix.pem]
         [--random | --no-random] [--in pubkeyfile] [--out pemcertfile]
         [--cert signing_cert] [--dni k=v] [--dns "name-or-ip"] [--dnq "qual"]
         [--request [--no-extensions]] [--utf8] --key priv_key_file "name str"
       CACreateCert --root [--random] --key priv_key_file "name string" > ca.pem
       CACreateCert --key priv_key_file --cert signing_cert "name string"
         < pub_key_file > out_cert.pem

DESCRIPTION
       CACreateCert creates a new certificate.  Various certificate types are
       supported including root CA certificates, sub CA certificates, server
       certificates, code signing certificates, email certificates and client
       certificates.

       When creating a certificate, the only private key required is that of
       the signer.  This means that, for example, a new client authentication
       certifcate can be created given only the public key of the client and
       the private key of the signing certificate.

       The public key for the certificate being created may be provided in
       either OpenSSH .pub format or X.509 public key format.  The
       "openssl rsa -pubout" or "openssl x509 -noout -pubkey" or
       "openssl req -noout -pubkey" command can be used to produce an X.509
       format public key from either an RSA private key or an X.509 certificate
       or an X.509 certificate signing request respectively.  Note that only
       OpenSSH RSA public keys in protocol format 2 are supported (they start
       with "ssh-rsa ").

       When creating a root certificate no public key is required.

       The "name string" value given must be appropriate for the type of
       certificate being created.  For a client authentication certificate it
       will typically be a *nix user login (all lowercase) on the server to
       which clients connect to.  For an email certificate it will typically
       be the full email address.  For a server it will generally be the
       canonical DNS name of the server.

       No validation is performed on the "name string" value except that it
       must not be the empty string.  It may be provided in either Latin-1 or
       UTF-8.

       The priv_key_file must be an RSA private key file in PEM or DER format
       and furthermore it must not have a password (both openssl genrsa and
       ssh-keygen -t rsa can create these kinds of RSA private key files).  If
       a host is running an OpenSSH sshd daemon, then it probably already has a
       suitable host private RSA key in either /etc/ssh/ssh_host_rsa_key or
       /etc/ssh_host_rsa_key that can be used if desired.

       The signing_cert must be an X.509 certificate that uses priv_key_file as
       its private key.  It may be in either PEM or DER format.  The created
       certificate will be signed by the signing_cert.  The CACreateCert utility
       can be used to create a suitable signing_cert certificate authority
       certificate from the priv_key_file if desired by using the --root option.

       When creating a root certificate no signing_cert is required.

       On success the new certificate is written in PEM format to standard
       output.  (All error/information messages are written to standard error.)

       Note that certificates created by CACreateCert are deterministic (i.e.
       the bytewise identical certificate will be output) given the identical
       input arguments only so long as neither the --random nor --now options
       are used.

       Also note that the root certificates created by this utility do not
       expire.  Non-root certificates receive the same notAfter date as their
       signing certificate.

       Instead of actually outputting an X.509 certificate, adding the
       --request option will output a Certificate Signing Request (CSR).  In
       which case the --cert (if given) and public key (if provided) are
       completely ignored -- only the --key is required to create a CSR.

OPTIONS
       -h/--help
              Show this help

       -V/--version
              Show the CACreateCert version

       -v/--verbose
              Produce extra informational messages to standard error.
              Suppresses --quiet.

       --list-oid-names
              Show a list of recognized key names for the --dni option.  If
              given other options are ignored.

       --man
              Same as --verbose --help.

       --debug
              Show debugging information.  Automatically enables --verbose.
              Suppresses --quiet.

       --quiet
              Suppress all messages except errors.  Ignored if --debug or
              --verbose given.

       --check
              Perform all normal validation checks (except for a non-empty
              "name string") but do not actually produce a certificate.
              Automatically enables --verbose.

       --now
              Normally the validity not before date will be set to the signing
              certificate's not before date or the approval date of the X.509
              v3 standard (root certificates).  Using this option causes the
              not before validity date of the generated certificate to be set
              to the current time.  Use of this option will preclude production
              of byte-exact matching output certificates for the same input
              arguments.

       --utf8
              Normally strings that can be encoded as either a PrintableString
              or a UTF8String are encoded as a PrintableString if they contain
              only PrintableString characters.  Using this option causes such
              strings to always use UTF8String instead.  Note that this option
              does NOT affect the encoding of any items that are required to
              use a different type.

       --pubx509/--pubX509
              Force the public key read from standard input to be interpreted
              as an X.509 format public key.  Normally this should be
              automatically detected and this option should not be needed.
              This option is ignored if --root is given.

       -t
              Allow reading the public key from standard input when standard
              input is a tty.  In most cases attempting to read the public key
              from standard input that is a tty indicates that the public key
              was accidentally omitted.  If that is not the case, the -t option
              must be given to allow reading the public key from standard input
              when standard input is a tty.  This option is always implied if
              the --in option is used with a value other than "-".

       --digest name
              Select the digest to use in the generated certificate.  Must be
              one of sha1, sha224, sha256, sha384 or sha512.  By default sha256
              will be used if available otherwise sha1 will be used (and a
              warning issued).  All systems support sha1 digest certificates,
              but sha1 should really not be used anymore (see NIST
              recommendation SP 800-131A).  OpenSSL starting with version 0.9.8
              (released 2005-07-05) supports the SHA-2 family of hash functions
              (sha224, sha256, sha384 and sha512) which should be used instead
              of sha1.  Note that either Digest::SHA or Digest::SHA::PurePerl
              must be available to use sha224, sha256, sha384 or sha512.

       --root
       --subca
       --server
       --codesign
       --applecodesign
       --email
       --client
              Select the type of certificate to generate.  If --root is given
              then a root certificate will be created and any --cert option will
              be ignored as well as standard input.  If none of these options is
              given then --client will be assumed.  Both --root and --subca
              generate certificate authority certificates (CA:TRUE).
              Specifying any of --root, --subca, --server, --codesign or
              --applecodesign will cause the "name string" to be embedded as
              a commonName (CN).  Otherwise if --email is specified
              "name string" will be embedded as an emailAddress (and a subject
              alternative name email type).  Finally if none of those apply then
              "name string" will be embedded as a userId (UID) instead
              (client certificates).  The certificate's key usage bits will be
              set to one of four values.  --root or --subca select the first,
              --server selects the second, --email selects the third otherwise
              the fourth is used.  If any of --server, --client (explicit or
              implied), --codesign, --email or --applecodesign are given then
              extended key usage items will be included (up to five -- one for
              each option given).

       --request
              Output a Certificate Signing Request (CSR) instead of a standard
              X.509 certificate.  Note that this causes any --cert or provided
              public key to be completely ignored.  It may be used with any of
              the certificate types.  The output CSR will be self-signed by the
              given --key.

       --no-extensions
              Only valid when used with --request.  Normally when creating a
              CSR the extensions that would have been included in the X.509
              certificate are included in a special section of the CSR.  If
              this option is given then the extensions section of the CSR will
              be completely omitted.  Use of this option is not recommended
              unless the expected consumer of the produced CSR requires it.

       --acme
              Giving this option causes most of the other options to be ignored.
              A unique "Acme" root certificate will be created and output each
              time CACreateCert is run with this option.  The only required
              option is --key when generating an "Acme" certificate.

       --pathlen n
              The --pathlen option will be ignored unless --subca is given in
              which case the X509v3 Basic Constraints will include the
              specified pathlen value.

       --rootauth
              Ignored unless --root given.  Normally --root certificates do not
              include an X509v3 Authority Key Identifier.  If this option is
              given then they will (with only a keyid value).

       --authext
              Ignored if --root given.  Normally non --root certificates include
              an X509v3 Authority Key Identifier section with only a keyid
              value.  If this option is given, then the name and serial number
              will also be included.

       --random
              Use a random serial number instead of one determined by the actual
              contents of the certificate.  When generating a --root certificate
              the issuer name will also include a serialNumber attribute as the
              first item followed by the "name string" value (as the CN
              attribute).  This can be modified by use of one or more --dni
              options and if a --dni serialNumber=# option is used then the '#'
              will be replaced by the actual serial number generated and in the
              case of a --root certificate the extra serialNumber attribute at
              the beginning of the issuer name will be suppressed.  Only one
              --dni serialNumber=# is allowed and it must be non-multivalued.
              Use of this option will preclude production of byte-exact matching
              output certificates for the same input arguments.  This is now the
              default when --root is given.  Roughly equivalent to adding a
              --dni serialNumber=randomvalue option BEFORE any other --dni
              options and then using --no-random.

       --no-random
              Ignored unless --root given.  Turns off the default --random
              option that is normally enabled by default when --root is given.

       --key priv_key_file
              The RSA private key in either PEM or DER format.  This option
              is always required.

       --cert signing_cert
              Ignored if --root is given.  The signing X.509 certificate in
              either PEM or DER format.  The public key embedded in signing_cert
              must match the one in the priv_key_file or an error will occur.

       --in pub_key_file
              Ignored if --root is given.  The public key for the certificate
              to be created.  Must be different than the public key contained in
              priv_key_file.  May be an OpenSSH protocol 2 format RSA public key
              or an X.509 format public key (in either PEM or DER format).  See
              also the --pubx509 option.  If pub_key_file is "-" or this option
              is omitted then standard input is read.

       --out out_cert.pem
              The generated certificate will be written to out_cert.pem.  If
              this option is omitted or out_cert.pem is "-" then the generated
              certificate is written to standard output.

       --suffix suffix.pem
              Primarily intended to be used when generating client certificates,
              if this option is given, then the entire contents of suffix.pem is
              written to the same location as the generated certificate
              immediately following the certificate.  This option may be given
              more than once in which case the files will be appended to the
              output in the order the --suffix options were given.  See the
              NOTES section below for relevant information on use of --suffix.

       --dni [+]key=value | \@filename
              Add distinguished name information.  This option may be repeated
              multiple times as desired.  Key is either the name of an OID
              attribute to add or a dotted OID number.  Recognized names may be
              listed with the --list-oid-names option.  Value is a string value
              to assign to the key.  Whitespace before and after as well as any
              surrounding the '+' and '=' is completely ignored.  If a '+' is
              prefixed to the key, the value will be combined with the previous
              --dni item to make it multi-valued.  The '+' prefix requires at
              least one previous --dni item that does NOT have a '+' prefix.
              Instead of '[+]key=value', '\@filename' may be used instead.  If
              filename is '-' then standard input will be read provided it is
              not already being used to read the public key.  The 'filename'
              must contain one --dni directive per line (with the '--dni' part
              omitted).  Blank lines and lines with the first non-blank
              character a '#' are ignored.  The directives in the file are
              processed exactly as though they each appeared as a command line
              '--dni' option in the order they appear in the file.  See also
              the description for the --random option for details of the
              '--dni serialNumber=#' variant and the description of the "name
              string" for details of the '--dni emailAddress=\@' variant.

       --no-max-len
              Ignore any maximum length limits on most --dni values.  A warning
              will still be issued unless --quiet is also used.

       --dns domain-name-or-ip
              Ignored unless --server given.  Adds the given domain-name-or-ip
              as a subject alternative name (either DNS or IPAddress).  May
              be repeated to add multiple alternative names.  A DNS name must
              satisfy RFC 1034 section 3.5 as modified by RFC 1123 section 2.1
              except that the leftmost label may be the single character '*'.
              An IP address may be either IPv4 or IPv6 (do NOT use surrounding
              '[', ']' characters on an IPv6 address). An IPv6 address MUST NOT
              have a scope identifier.  Note that when --server is given, the
              common name (CN) value is NOT automatically added as a subject
              alternative name -- it must be specified explicitly with a --dns
              option if that is desired (and normally it IS desirable).

       --dnq qual
              Optional for all certificate types.  If given must not be the
              empty string.  Will be embedded into the subject's distinguished
              name as the final component.  Use of this option is not
              recommended when using --server or --email.  The value must be
              a PrintableString (needs to match [A-Za-z0-9 '()+,./:=?-]+).
              Equivalent to adding a --dni dnQualifier=qual option after any
              other --dni options except that it is also placed AFTER any
              "name string" value as well.

       name string
              The name to embed in the certificate as the subject.  This will
              be embedded as a common name (CN) except when --client is in
              effect in which case it will be embedded as a user id (UID) or
              when --email is in effect in which case it will be embedded as
              an email address in both the subject and subject alternative name.
              The "name string" value may never be omitted but may be explictly
              given as the empty string ('' or "") when generating a root
              certificate using a random serial number or when the distinguished
              name attribute key that would be embedded (e.g. CN or UID) has
              already had a value specified using a --dni option AND the
              --email option has NOT been given.  The name string is ignored,
              if present, when --acme is used.  For --email, however, if a
              --dni emailAddress=\@ option appears then the email address will
              be embedded into the subject at that location rather than at the
              default location (which is after the --dni values but before the
              --dnq value).

NOTES
       All systems support sha1 digest certificates, but sha1 should really not
       be used anymore (NIST recommendation SP 800-131A).  OpenSSL starting
       with versions 0.9.8 (released 2005-07-05) supports the SHA-2 family of
       hash functions (sha224, sha256, sha384 and sha512) which should be used
       instead.

       NIST SP 800-131A requires use of an RSA key with 2048 or more bits and
       a hash function with 224 or more bits after December 31 2010.

       RFC 6194 states sha256 is the most commonly used alternative to sha1
       (and will be used by default if a suitable SHA module is available).

       Note that NIST SP 800-78-3 requires RSA public key exponents to be
       greater than or equal to 65537.  OpenSSH version 5.4 and later generate
       RSA keys with a public exponent of 65537 otherwise openssl genrsa can
       be used together with ssh-keygen -y to create a suitable OpenSSH key that
       uses an exponent of 65537 instead of 35.

       A client attempting to authenticate a server and following the rules in
       RFC 6125 will COMPLETELY IGNORE the value given for a server certificate's
       common name (CN) if any alternative name DNS values are present.  Although
       that standard does not discuss IP alternative names, the user of this
       utility is strongly advised to include the value from the server's CN
       as one of the --dns values given if ANY --dns values are given.

       Using an IPv6 address as a --dns value will not interfere with the
       correct working of an IPv4 address and/or DNS name as a --dns value, but
       some older clients do not seem to reliably support checking IPv6 address
       alternative name values so do not rely on them actually working
       everywhere in practice.  The problematic clients stubbornly insist there
       is a host name mismatch.

       Link-local IPv6 addresses are unlikely to work since there's no way to
       embed a scope value (and client support for a scope specifier is rare).
       However, some platforms (i.e. Darwin) allow the scope number to be
       embedded as octets 2 and 3 so that address FE80::... with a scope_id
       value of 5 can be represented as FE80:5::... instead.  Of course the
       correct scope_id value is host-specific, so a range of possibilities
       would have to be included although since the loopback interface is
       almost always scope_id 1 that one can be skipped.  Current versions
       of the cURL command line utility DO actually correctly handle scope
       ids as described in RFC 6874, correctly stripping off the zone value
       from the host name included in the 'Host:' HTTP header.

       The TLS (Transport Layer Security -- also sometimes referred to by the
       previous standard's name, SSL [Secure Sockets Layer]) requires the peer
       (either the server when the client is authenticating it or the client
       when the server is authenticating it if client certificates are in use)
       to supply the ENTIRE certificate chain in order from the leaf
       certificate (that identifies the peer) on up through and INCLUDING the
       root certificate (also known as the certificate authority).  Reference
       RFC 5246 section 7.4.2 and the description of "certificate_list".  But
       there is an exception listed, you MAY omit the last certificate (aka the
       "root" certificate, "certificate authority" certificate or "self-signed"
       certificate) under the assumption that the peer already has that or it
       would not be able to decide whether or not to trust the certificate
       even if it turns out to be a valid one.  What this means is that if you
       are generating a client certificate and the client certificate's issuer
       is not the root certificate for the chain, then you should probably add
       the --suffix <path_to_issuer_cert> option for its issuer and if the
       issuer's issuer is not the root certificate, add another --suffix option
       and so on until the issuer of the certificate listed with the final
       --suffix option is the root certificate (you may also go ahead and
       include one more --suffix option for the root certificate but it's
       likely unnecessary since the server should have that).  But, if the
       server is using public key pinning to validate the root certificate then
       you must include the root certificate just as RFC 5246 says to do.

TIPS
       Display the currently available version of OpenSSL with:

           openssl version

       Display the currently available version of OpenSSH with:

           ssh -V

       When adding --dni values, the convention is to list the most general
       first (e.g. country) moving on to more specific and ending with common
       name (CN) (and for email, the emailAddress), possibly finally followed
       by a dnQualifier if any.  This ordering is not set in stone but is
       generally recommended.

       Convert a regular certificate into a certificate request using openssl:

         openssl x509 -in cert.pem -signkey key.pem -x509toreq -out csr.pem

       Verify the signature of a certificate signing request:

         openssl req -in csr.pem -noout -verify

       Extract the subject of a certificate signing request into a form that
       can be passed using the "--dni \@dnifile.txt" format:

         openssl req -in csr.pem -noout -subject |
         sed 's,^subject= */,,;y,/,\\n,' >dnifile.txt

       The same trick can be used on X.509 certificates simply by substituting
       "x509" for "req" in the "openssl" command.

EXAMPLES
       Valid certificate chains always must contain at least two certificates,
       the leaf certificate and the root certificate.  There may be additional
       intermediate certificates in the chain between them.

       '''CREATING A SERVER CERTIFICATE'''

       Here's an example of how to quickly create a valid web server
       certificate chain for an 'example.com' web server:

       1. Create a root certificate key:

          openssl genrsa -f4 -out root_key.pem 3072

       2. Generate a server certificate key and extract its public key:

          openssl genrsa -f4 -out server_key.pem 3072
          openssl rsa -in server_key.pem -pubout -out server_key_pub.pem

       3. Generate an Acme root certificate:

          CACreateCert --acme --key root_key.pem --out root_cert.pem

       4. Generate a server certificate for 'example.com':

          CACreateCert --server --key root_key.pem --cert root_cert.pem \
            --in server_key_pub.pem --out server_cert.pem "example.com"

       Optionally add one or more --dns and/or --dni options when generating
       the --server certificate.

       To configure a web server to serve 'example.com' over https the
       root_cert.pem, server_cert.pem and server_key.pem files will be needed.

       Clients connecting to 'example.com' over https will get an untrusted
       root certificate error unless they trust root_cert.pem as a certificate
       authority or otherwise add an exception.

       '''CREATING AN EMAIL CERTIFICATE'''

       Here's an example of how to quickly create a valid email certificate
       chain for the name "John Smith" with email address <jsmith\@example.com>:

       1. Create a root certificate key:

          openssl genrsa -f4 -out root_key.pem 3072

       2. Generate an email certificate key and extract its public key:

          openssl genrsa -f4 -out email_key.pem 3072
          openssl rsa -in email_key.pem -pubout -out email_key_pub.pem

       3. Generate an Acme root certificate:

          CACreateCert --acme --key root_key.pem --out root_cert.pem

       4. Generate an email certificate for "John Smith" <jsmith\@example.com>:

          CACreateCert --email --key root_key.pem --cert root_cert.pem \
            --in email_key_pub.pem --out email_cert.pem --dni CN="John Smith" \
            "jsmith\@example.com"

       Additional information may be added with more --dni options or the
       common name (CN) may even just be omitted entirely.

       5. Create a .p12 file containing the two certs and the private key:

       This step is optional but may be the only way to get the key into your
       system (e.g. Mac OS X Keychain -- which also requires you to either
       trust the root for basic X.509 policy or the cert itself for S/MIME).

          openssl pkcs12 -export -inkey email_key.pem -in email_cert.pem \
            -certfile root_cert.pem -nodes -out email_certs.p12 \
            -passout pass:"dummy" -name "My Email Key"

       Use a better password than dummy though.  :)

       To configure an email client to use the new certificate, the
       root_cert.pem, email_cert.pem and email_key.pem files will be needed or
       alternatively the email_certs.p12 file.
       (Some email software will let you squeak by without root_cert.pem.)

       '''CREATING AN EMAIL CERTIFICATE SIGNING REQUEST'''

       Instead of using a self-generated "Acme" root certificate, this example
       creates a Certificate Signing Request (CSR), sends it off to be turned
       into a signed X.059 email certificate and then uses that.

       1. Generate an email certificate key:

          openssl genrsa -f4 -out email_key.pem 3072

       2. Generate an email CSR for "John Smith" <jsmith\@example.com>:

          CACreateCert --request --email --key email_key.pem \
            --out email_csr.pem --dni CN="John Smith" "jsmith\@example.com"

       3. Send the email_csr.pem file to your certificate authority and wait.

       4. Eventually receive a signed certificate file back.  It may be in
          PEM, DER or even possibly P12 format.

          To convert into P12 format see step (5) above.  In this case the
          -certfile option to "openssl pkcs12" may be omitted.

       At this point it should be possible to configure an email client; see
       the directions above after step (5).

BUGS
       The ability to create self-signed types other than --root by combining
       the --root option with one of the others (e.g. --client, --email,
       --codesign, --server) is poorly documented.  Furthermore, since the
       standard (see RFC 5280) effectively requires at least two certificates
       in any certificate chain (because a chain must have a non-root leaf
       certificate), such self-signed combination root certificates, when used
       by themselves, are technically unable to create a valid certificate
       chain.

       DSA is not supported even though it is possible to create a valid
       certificate that uses dsaWithSHA1.  But since SHA-1 should not be used
       any longer after 2010-12-31 (NIST SP 800-131A) it's no big loss.  And
       there do not seem to be any identifiers available for DSA with longer
       hash algorithms anyway.

       The ability to sign using whirlpool, should, perhaps, not be allowed.
       However, the RFC 6931 standard is very clear in section 2.3.8 that the
       "RSA-Whirlpool" combination always uses RSA so specifying the whirlpool
       OID 1.0.10118.3.0.55 as both the hash algorithm and signature algorithm
       should be sufficient.

HELP
}

sub IsUTF8($)
{
  # Return 0 if non-UTF-8 sequences present
  # Return -1 if no characters > 0x7F found
  # Return 1 if valid UTF-8 sequences present
  use bytes;
  return -1 if $_[0] !~ /[\x80-\xFF]/so;
  my $l = length($_[0]);
  for (my $i=0; $i<$l; ++$i) {
    my $c = ord(substr($_[0],$i,1));
    next if $c < 0x80;
    return 0 if $c < 0xC0 || $c >= 0xF8;
    if ($c <= 0xDF) {
      # Need 1 more byte
      ++$i;
      return 0 if $i >= $l;
      my $c2 = ord(substr($_[0],$i,1));
      return 0 if $c2 < 0x80 || $c2 > 0xBF;
      my $u = (($c & 0x1F) << 6) | ($c2 & 0x3F);
      return 0 if $u < 0x80;
      next;
    }
    if ($c <= 0xEF) {
      # Need 2 more bytes
      $i += 2;
      return 0 if $i >= $l;
      my $c2 = ord(substr($_[0],$i-1,1));
      return 0 if $c2 < 0x80 || $c2 > 0xBF;
      my $c3 = ord(substr($_[0],$i,1));
      return 0 if $c3 < 0x80 || $c3 > 0xBF;
      my $u = (($c & 0x0F) << 12) | (($c2 & 0x3F) << 6) | ($c3 & 0x3F);
      return 0 if $u < 0x800 || ($u >= 0xD800 && $u <= 0xDFFFF) || $u >= 0xFFFE;
      next;
    }
    # Need 3 more bytes
    $i += 3;
    return 0 if $i >= $l;
    my $c2 = ord(substr($_[0],$i-2,1));
    return 0 if $c2 < 0x80 || $c2 > 0xBF;
    my $c3 = ord(substr($_[0],$i-1,1));
    return 0 if $c3 < 0x80 || $c3 > 0xBF;
    my $c4 = ord(substr($_[0],$i,1));
    return 0 if $c4 < 0x80 || $c4 > 0xBF;
    my $u = (($c & 0x07) << 18) | (($c2 & 0x3F) << 12) | (($c3 & 0x3F) << 6)
                                                                 | ($c4 & 0x3F);
    return 0 if $u < 0x10000 || $u >= 0x10FFFE || (($u & 0xFFFF) >= 0xFFFE);
  }
  return 1;
}

sub Make1252()
{
  use bytes;
  our %W1252;

  # Provide translations for 0x80-0x9F into UTF-8
  $W1252{0x80} = pack('H*','E282AC'); # 0x20AC Euro
  $W1252{0x82} = pack('H*','E2809A'); # 0X201A Single Low-9 Quote
  $W1252{0x83} = pack('H*','C692');   # 0x0192 Latin Small Letter f With Hook
  $W1252{0x84} = pack('H*','E2809E'); # 0x201E Double Low-9 Quote
  $W1252{0x85} = pack('H*','E280A6'); # 0x2026 Horizontal Ellipsis
  $W1252{0x86} = pack('H*','E280A0'); # 0x2020 Dagger
  $W1252{0x87} = pack('H*','E280A1'); # 0x2021 Double Dagger
  $W1252{0x88} = pack('H*','CB86');   # 0x02C6 Modifier Letter Circumflex Accent
  $W1252{0x89} = pack('H*','E28080'); # 0x2030 Per Mille Sign
  $W1252{0x8A} = pack('H*','C5A0');   # 0x0160 Latin Capital Letter S With Caron
  $W1252{0x8B} = pack('H*','E28089'); # 0x2039 Left Single Angle Quote
  $W1252{0x8C} = pack('H*','C592');   # 0x0152 Latin Capital Ligature OE
  $W1252{0x8E} = pack('H*','C5BD');   # 0x017D Latin Capital Letter Z With Caron
  $W1252{0x91} = pack('H*','E28098'); # 0x2018 Left Single Quote
  $W1252{0x92} = pack('H*','E28099'); # 0x2019 Right Single Quote
  $W1252{0x93} = pack('H*','E2809C'); # 0x201C Left Double Quote
  $W1252{0x94} = pack('H*','E2809D'); # 0x201D Right Double Quote
  $W1252{0x95} = pack('H*','E280A2'); # 0x2022 Bullet
  $W1252{0x96} = pack('H*','E28093'); # 0x2013 En Dash
  $W1252{0x97} = pack('H*','E28094'); # 0x2014 Em Dash
  $W1252{0x98} = pack('H*','CB9C');   # 0x02DC Small Tilde
  $W1252{0x99} = pack('H*','E284A2'); # 0x2122 Trade Mark Sign
  $W1252{0x9A} = pack('H*','C5A1');   # 0x0161 Latin Small Letter s With Caron
  $W1252{0x9B} = pack('H*','E2808A'); # 0x203A Right Single Angle Quote
  $W1252{0x9C} = pack('H*','C593');   # 0x0153 Latin Small Ligature oe
  $W1252{0x9E} = pack('H*','C5BE');   # 0x017E Latin Small Letter z With Caron
  $W1252{0x9F} = pack('H*','C5B8');   # 0x0178 Latin Cap Letter Y With Diaeresis
}

sub MakeUTF8($)
{
  use bytes;
  our %W1252;

  return $_[0] if (IsUTF8($_[0]));
  my $ans = '';
  foreach my $c (unpack('C*',$_[0])) {
    if ($c < 0x80) {
      $ans .= chr($c);
    }
    else {
      # Ass/u/me we have Latin-1 (ISO-8859-1) but per the HTML 5 draft treat
      # it as windows-1252
      if ($c >= 0xA0 || !defined($W1252{$c})) {
        $ans .= chr(0xC0 | ($c >> 6));
        $ans .= chr(0x80 | ($c & 0x3F));
      }
      else {
        $ans .= $W1252{$c};
      }
    }
  }
  return $ans;
}

sub formatbold($;$)
{
  my $str = shift;
  my $fancy = shift || 0;
  if ($fancy) {
    $str = join('',map($_."\b".$_, split(//,$str)));
  }
  return $str;
}

sub formatul($;$)
{
  my $str = shift;
  my $fancy = shift || 0;
  if ($fancy) {
    $str = join('',map("_\b".$_, split(//,$str)));
  }
  return $str;
}

sub formatman($;$)
{
  my $man = shift;
  my $fancy = shift || 0;
  my @inlines = split(/\n/, $man, -1);
  my @outlines = ();
  foreach my $line (@inlines) {
    if ($line =~ /^[A-Z]+$/) {
      $line = formatbold($line, $fancy);
    }
    else {
      $line =~ s/'''(.+?)'''/formatbold($1,$fancy)/gse;
      $line =~ s/''(.+?)''/formatul($1,$fancy)/gse;
    }
    push (@outlines, $line);
  }
  my $result = join("\n", @outlines);
  $result =~ s/\\\n//gso;
  return $result;
}

my %oidnames;
my %knownoids;
my %oidstringtypes;
my %oidstringlengths;
my %oidstringrestrictions;
my $oidnamelist;

BEGIN {
  my %oiddata = (
    'commonName'                        => '2.5.4.3',
    'CN'                                => '2.5.4.3',
    'surname'                           => '2.5.4.4',
    'SN'                                => '2.5.4.4',
    'serialNumber'                      => '2.5.4.5',
    'serial'                            => '2.5.4.5',
    'countryName'                       => '2.5.4.6',
    'C'                                 => '2.5.4.6',
    'localityName'                      => '2.5.4.7',
    'L'                                 => '2.5.4.7',
    'stateOrProvinceName'               => '2.5.4.8',
    'ST'                                => '2.5.4.8',
    'streetAddress'                     => '2.5.4.9',
    'street'                            => '2.5.4.9',
    'organizationName'                  => '2.5.4.10',
    'O'                                 => '2.5.4.10',
    'organizationalUnitName'            => '2.5.4.11',
    'OU'                                => '2.5.4.11',
    'title'                             => '2.5.4.12',
    'description'                       => '2.5.4.13',
    'businessCategory'                  => '2.5.4.15',
    'postalCode'                        => '2.5.4.17',
    'telephoneNumber'                   => '2.5.4.20',
    'facsimileTelephoneNumber'          => '2.5.4.23',
    'givenName'                         => '2.5.4.42',
    'GN'                                => '2.5.4.42',
    'initials'                          => '2.5.4.43',
    'generationQualifier'               => '2.5.4.44',
    'dnQualifier'                       => '2.5.4.46',
    'pseudonym'                         => '2.5.4.65',
    'organizationIdentifier'            => '2.5.4.97',
    'userId'                            => '0.9.2342.19200300.100.1.1',
    'UID'                               => '0.9.2342.19200300.100.1.1',
    'domainComponent'                   => '0.9.2342.19200300.100.1.25',
    'DC'                                => '0.9.2342.19200300.100.1.25',
    'emailAddress'                      => '1.2.840.113549.1.9.1',
    'jurisdictionOfIncorporationLocalityName'=> '1.3.6.1.4.1.311.60.2.1.1',
    'jurisdictionOfIncorporationLocality'=> '1.3.6.1.4.1.311.60.2.1.1',
    'jurisdictionLocalityName'          => '1.3.6.1.4.1.311.60.2.1.1',
    'jurisdictionLocality'              => '1.3.6.1.4.1.311.60.2.1.1',
    'jurisdictionOfIncorporationStateOrProvinceName'=> '1.3.6.1.4.1.311.60.2.1.2',
    'jurisdictionOfIncorporationStateOrProvince'=> '1.3.6.1.4.1.311.60.2.1.2',
    'jurisdictionStateOrProvinceName'   => '1.3.6.1.4.1.311.60.2.1.2',
    'jurisdictionStateOrProvince'       => '1.3.6.1.4.1.311.60.2.1.2',
    'jurisdictionOfIncorporationCountryName'=> '1.3.6.1.4.1.311.60.2.1.3',
    'jurisdictionOfIncorporationCountry'=> '1.3.6.1.4.1.311.60.2.1.3',
    'jurisdictionCountryName'           => '1.3.6.1.4.1.311.60.2.1.3',
    'jurisdictionCountry'               => '1.3.6.1.4.1.311.60.2.1.3',

    # Some extra help here for those last long ones and some obvious abbreviations
    'joiL'                              => '1.3.6.1.4.1.311.60.2.1.1',
    'joiST'                             => '1.3.6.1.4.1.311.60.2.1.2',
    'joiC'                              => '1.3.6.1.4.1.311.60.2.1.3',
    'country'                           => '2.5.4.6',
    'city'                              => '2.5.4.7',
    'locality'                          => '2.5.4.7',
    'state'                             => '2.5.4.8',
    'province'                          => '2.5.4.8',
    'stateOrProvince'                   => '2.5.4.8',
    'organization'                      => '2.5.4.10',
    'organizationalUnit'                => '2.5.4.11',
    'zip'                               => '2.5.4.17',
    'zipCode'                           => '2.5.4.17',
    'phone'                             => '2.5.4.20',
    'phoneNumber'                       => '2.5.4.20',
    'fax'                               => '2.5.4.23',
    'faxNumber'                         => '2.5.4.23',
    'DNQ'                               => '2.5.4.46',
    'email'                             => '1.2.840.113549.1.9.1'
  );
  # p => PrintableString, i => IA5String, u => UTF8String
  # If not listed prefer PrintableString if compatible otherwise UTF8String
  %oidstringtypes = (
    '2.5.4.5' => 'p',  # serialNumber
    '2.5.4.6' => 'p',  # countryName
    '2.5.4.46' => 'p', # dnQualifier
    '1.2.840.113549.1.9.1' => 'i',      # emailAddress
    '0.9.2342.19200300.100.1.25' => 'i' # domainComponent
  );
  # Exact number of characters required if single number "n"
  # Minimum number of characters required if "n,"
  # Maximum number of characters if ",n"
  # Minimum and maximum number of characters if "n,m"
  %oidstringlengths = (
    '2.5.4.3'               =>  ',64',    # commonName
    '2.5.4.4'               =>  ',40',    # surname
    '2.5.4.5'               =>  ',64',    # serialNumber
    '2.5.4.6'               =>     2 ,    # countryName
    '2.5.4.7'               => ',128',    # localityName
    '2.5.4.8'               => ',128',    # stateOrProvinceName
    '2.5.4.9'               =>  ',30',    # streetAddress
    '2.5.4.10'              =>  ',64',    # organizationName
    '2.5.4.11'              =>  ',32',    # organizationUnitName
    '2.5.4.12'              =>  ',64',    # title
    '2.5.4.17'              =>  ',16',    # postalCode
    '2.5.4.42'              =>  ',16',    # givenName
    '2.5.4.43'              =>   ',5',    # initials
    '2.5.4.44'              =>   ',3',    # generationQualifier
    '2.5.4.65'              => ',128',    # pseudonym
    '1.2.840.113549.1.9.1'  => ',255'     # emailAddress
  );
  # 'e' => must be an email address, 'd' => must be a domain name label
  # 'c' => must be ISO 3166 2-character country code (2 'A'-'Z' will do)
  %oidstringrestrictions = (
    '2.5.4.6' => 'c',              # 2-character country code
    '1.2.840.113549.1.9.1' => 'e',   # emailAddress RFC 5280 4.2.1.6 rfc822Name
                                     # See 'Mailbox' Section 4.1.2 of RFC 2821
    '0.9.2342.19200300.100.1.25' => 'd' # domainComponent RFC 4519
  );
  my %aliases = ();
  my $maxlen = 0;
  %oidnames = ();
  %knownoids = ();
  foreach my $key (keys(%oiddata)) {
    my $l = length($key);
    $maxlen = $l if $l > $maxlen;
    my $value = $oiddata{$key};
    $knownoids{$value} = 1;
    $oidnames{lc($key)} = $value;
    my $nlist = $aliases{$value};
    $nlist = [], $aliases{$value} = $nlist unless $nlist;
    push(@$nlist, $key);
  }
  my @list = ();
  foreach my $oid (keys(%aliases)) {
    my $aliases = $aliases{$oid};
    my @sorted = sort({length($b) <=> length($a)} @$aliases);
    my $canon = shift(@sorted);
    push(@list, sprintf('%-*s =  %s', $maxlen, $canon, $oid));
    foreach my $alias (@sorted) {
      push(@list, sprintf('%-*s -> %s', $maxlen, $alias, $canon));
    }
  }
  $oidnamelist = join('', map("$_\n", sort({lc($a) cmp lc($b)} @list)));
}

sub DERLength($)
{
  # return a DER encoded length
  my $len = shift;
  return pack('C',$len) if $len <= 127;
  return pack('C2',0x81, $len) if $len <= 255;
  return pack('Cn',0x82, $len) if $len <= 65535;
  return pack('CCn',0x83, ($len >> 16), $len & 0xFFFF) if $len <= 16777215;
  # Silently returns invalid result if $len > 2^32-1
  return pack('CN',0x84, $len);
}

sub SingleOID($)
{
  # return a single DER encoded OID component
  no warnings;
  my $num = shift;
  $num += 0;
  my $result = pack('C', $num & 0x7F);
  $num >>= 7;
  while ($num) {
    $result = pack('C', 0x80 | ($num & 0x7F)) . $result;
    $num >>= 7;
  }
  return $result;
}

sub DEROID($)
{
  # return a DER encoded OID complete with leading 0x06 and DER length
  # Input is a string of decimal numbers separated by '.' with at least
  # two numbers required.
  no warnings;
  my @ids = split(/[.]/,$_[0]);
  push(@ids, 0) while @ids < 2; # return something that's kind of valid
  unshift(@ids, shift(@ids) * 40 + shift(@ids)); # combine first two
  my $ans = '';
  foreach my $num (@ids) {
    $ans .= SingleOID($num);
  }
  return pack('C',0x6).DERLength(length($ans)).$ans;
}

sub DERTime($)
{
  my $t = shift; # a time() value
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t);
  $year += 1900;
  ++$mon;
  my $tag;
  my $tstr;
  if (1950 <= $year && $year < 2050) {
    # UTCTime
    $tag = 0x17;
    $tstr = sprintf("%02d%02d%02d%02d%02d%02dZ", $year % 100, $mon, $mday,
      $hour, $min, $sec);
  }
  else {
    # GeneralizedTime
    $tag = 0x18;
    $tstr = sprintf("%04d%02d%02d%02d%02d%02dZ", $year, $mon, $mday,
      $hour, $min, $sec);
  }
  return pack('C',$tag).DERLength(length($tstr)).$tstr;
}

sub DERInteger($)
{
  my $int = shift; # an integer value, may be negative
  my @bytes = unpack('C*',pack('N',$int));
  shift @bytes while @bytes >= 2 && $bytes[0] == 255 && ($bytes[1] & 0x80);
  shift @bytes while @bytes >= 2 && $bytes[0] == 0 && !($bytes[1] & 0x80);
  return pack('C*',0x02,scalar(@bytes),@bytes);
}

sub RandomID(;$)
{
  # return 20 random bytes except that the first byte has its high bit clear
  my $suppress = shift || 0;
  print STDERR "Generating serial number, please wait...\n" unless $suppress;
  my $randfile = "/dev/random";
  $randfile = "/dev/urandom" if -e "/dev/urandom";
  open(RANDIN, "<", $randfile)
    or die "Cannot open $randfile for input: $!\n";
  my $result = '';
  for (my $cnt = 0; $cnt < 20; ++$cnt) {
    my $byte;
    sysread(RANDIN, $byte, 1)
      or die "Cannot read from $randfile: $!\n";
    if (!$cnt) {
      my $val = unpack('C', $byte);
      $val &= 0x7F;
      $byte = pack('C', $val);
    }
    $result .= $byte;
  }
  close(RANDIN);
  print STDERR "...done creating serial number.\n" unless $suppress;
  return $result;
}

sub ReadDERLength($)
{
  # Input is a DER encoded length with possibly extra trailing bytes
  # Output is an array of length and bytes-used-for-encoded-length
  my $der = shift;
  return undef unless length($der);
  my $byte = unpack('C',substr($der,0,1));
  return ($byte, 1) if $byte <= 127;
  return undef if $byte == 128 || $byte > 128+8; # Fail if greater than 2^64
  my $cnt = $byte & 0x7F;
  return undef unless length($der) >= $cnt+1; # Fail if not enough bytes
  my $val = 0;
  for (my $i = 0; $i < $cnt; ++$i) {
    $val <<= 8;
    $val |= unpack('C',substr($der,$i+1,1));
  }
  return ($val, $cnt+1);
}

sub DERTimeStr($)
{
  my $der = shift;
  return undef unless length($der) >= 2;
  my $byte = unpack('C',substr($der,0,1));
  return undef unless $byte == 0x17 || $byte == 0x18;
  my ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) == 1 + $lenbytes + $len;
  return undef
    unless ($byte == 0x17 && $len == 13) || ($byte == 0x18 && $len == 15);
  substr($der,0,1+$lenbytes) = '';
  if ($byte == 0x17) {
    no warnings;
    my $year = substr($der,0,2) + 1900;
    $year += 100 if $year < 1950;
    $der = sprintf("%04d",$year).substr($der,2);
  }
  return substr($der,0,4).'-'.substr($der,4,2).'-'.substr($der,6,2).'_'.
    substr($der,8,2).':'.substr($der,10,2).':'.substr($der,12,3);
}

sub GetOpenSSHKeyInfo($)
{
  # Input is an OpenSSH public key in .pub format
  # Output is an array of:
  #   how many bits in the modulus
  #   the public exponent
  #   the key id
  #   the OpenSSH md5 fingerprint
  #   the OpenSSH sha1 fingerprint
  #   the OpenSSH comment (may be '')
  #   the OpenSSH public key in OpenSSL PUBLIC KEY DER format
  # or undef if the key is unparseable
  # or just the key type if it's not ssh-rsa
  #
  # Expected format is:
  #   ssh-rsa BASE64PUBLICKEYDATA optional comment here
  # where the BASE64PUBLICKEYDATA when decoded produces:
  #   4 Byte Big-Endian length of Key type (must be 7 for RSA)
  #   Key type WITHOUT terminating NUL (must be ssh-rsa for RSA)
  #   4 Byte Big-Endian length of public exponent
  #   Public exponent integer bytes
  #   4 Byte Big-Endian length of modulus
  #   Modulus integer bytes
  # no extra trailing bytes are permitted
  my $input = shift;
  $input =~ s/((?:\r\n|\n|\r).*)$//os;
  my @fields = split(' ', $input, 3);
  return undef unless @fields >= 2;
  my $data = decode_base64($fields[1]);
  my $origData = $data;
  my @parts = ();
  while (length($data) >= 4) {
    my $len = unpack('N',substr($data,0,4));
    my $value = '';
    if ($len > 0) {
      return undef if $len + 4 > length($data);
      $value = substr($data,4,$len);
    }
    push(@parts, $value);
    substr($data, 0, 4+$len) = '';
  }
  return undef unless length($data) == 0;
  return $parts[0]
    if @parts >= 1 && defined($parts[0]) && $parts[0] && $parts[0] ne 'ssh-rsa';
  return undef unless @parts == 3;

  my $rsaEncryption = DEROID('1.2.840.113549.1.1.1'); # :rsaEncryption
  $rsaEncryption = pack('C',0x30).DERLength(length($rsaEncryption)+2)
    .$rsaEncryption.pack('C2',0x05,0x00);
  my $pubrsa = pack('C',0x2).DERLength(length($parts[2])).$parts[2]; # modulus
  $pubrsa .= pack('C',0x2).DERLength(length($parts[1])).$parts[1]; # exponent
  $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;
  my $id = sha1($pubrsa); # The id is the sha1 hash of the private key part
  $pubrsa = pack('C',0x3).DERLength(length($pubrsa)+1).pack('C',0x0).$pubrsa;
  $pubrsa = $rsaEncryption.$pubrsa;
  $pubrsa = pack('C',0x30).DERLength(length($pubrsa)).$pubrsa;

  my $bits = length($parts[2]) * 8;
  # But we have to discount any leading 0 bits in the first byte
  my $byte = unpack('C',substr($parts[2],0,1));
  if (!$byte) {
    $bits -= 8;
  }
  else {
    return undef if $byte & 0x80; # negative modulus is not allowed
    while (!($byte & 0x80)) {
      --$bits;
      $byte <<= 1;
    }
  }

  my $rawexp = $parts[1];
  my $exp;
  if (length($rawexp) > 8) {
    # Fudge the result because it's bigger than a 64-bit number
    my $lastbyte = unpack('C',substr($rawexp,-1,1));
    $exp = $lastbyte & 0x01 ? 65537 : 65536;
  }
  else {
    $exp = 0;
    while (length($rawexp)) {
      $exp <<= 8;
      $exp |= unpack('C',substr($rawexp,0,1));
      substr($rawexp,0,1) = '';
    }
  }

  return ($bits,$exp,$id,md5($origData),sha1($origData),$fields[2]||'',$pubrsa);
}

sub GetKeyInfo($)
{
  # Input is an RSA PRIVATE KEY in DER format
  # Output is an array of:
  #   how many bits in the modulus
  #   the public exponent
  #   the key id
  #   the OpenSSH md5 fingerprint
  #   the OpenSSH sha1 fingerprint
  # or undef if the key is unparseable
  #
  # Expected format is:
  #   SEQUENCE {
  #     SEQUENCE {
  #       OBJECT IDENTIFIER :rsaEncryption = 1.2.840.113549.1.1.1
  #       NULL
  #     }
  #     BIT STRING (primitive) {
  #       0 unused bits
  #       SEQUENCE { # this part is the contents of an "RSA PUBLIC KEY" file
  #         INTEGER modulus
  #         INTEGER publicExponent
  #       }
  #     }
  #   }

  no warnings;
  my $der = shift;
  my $rawmod;
  my $rawexp;

  return undef if unpack('C',substr($der,0,1)) != 0x30;
  my ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) == 1 + $lenbytes + $len;
  substr($der, 0, 1 + $lenbytes) = '';

  # the algorithm part always encodes as 30 0d 06092a864886f70d010101 0500
  return undef
    unless substr($der, 0, 15) = pack('H*',"300d06092a864886f70d0101010500");
  substr($der, 0, 15) = '';

  return undef if unpack('C',substr($der,0,1)) != 0x03;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) == 1 + $lenbytes + $len && $len >= 1;
  return undef unless unpack('C',substr($der, 1 + $lenbytes, 1)) == 0x00;
  substr($der, 0, 1 + $lenbytes + 1) = '';

  return undef if unpack('C',substr($der,0,1)) != 0x30;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) == 1 + $lenbytes + $len;
  my $id = sha1($der); # The id is the sha1 hash of the private key part
  substr($der, 0, 1 + $lenbytes) = '';

  return undef if unpack('C',substr($der,0,1)) != 0x02;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  substr($der, 0, 1 + $lenbytes) = '';
  my $derexp = substr($der, $len);
  substr($der, $len) = '';
  return undef unless $len >= 1;
  $rawmod = $der;
  my $bits = length($der) * 8;
  # But we have to discount any leading 0 bits in the first byte
  my $byte = unpack('C',substr($der,0,1));
  if (!$byte) {
    $bits -= 8;
  }
  else {
    return undef if $byte & 0x80; # negative modulus is not allowed
    while (!($byte & 0x80)) {
      --$bits;
      $byte <<= 1;
    }
  }

  $der = $derexp;
  return undef if unpack('C',substr($der,0,1)) != 0x02;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  substr($der, 0, 1 + $lenbytes) = '';
  return undef unless length($der) == $len && $len >= 1;
  return undef if unpack('C',substr($der,0,1)) & 0x80; # negative pub exp bad
  $rawexp = $der;
  my $exp;
  if ($len > 8) {
    # Fudge the result because it's bigger than a 64-bit number
    my $lastbyte = unpack('C',substr($der,-1,1));
    $exp = $lastbyte & 0x01 ? 65537 : 65536;
  }
  else {
    $exp = 0;
    while (length($der)) {
      $exp <<= 8;
      $exp |= unpack('C',substr($der,0,1));
      substr($der,0,1) = '';
    }
  }

  my $tohash = pack('N',7)."ssh-rsa".pack('N',length($rawexp)).$rawexp
    .pack('N',length($rawmod)).$rawmod;

  return ($bits,$exp,$id,md5($tohash),sha1($tohash));
}

sub GetCertInfo($)
{
  # Input is an X.509 "Certificate" (RFC 5280) in DER format
  # Output is an array of:
  #   version (1, 2, or 3)
  #   serial number (just the serial number data bytes, no header or length)
  #   issuer name as a DER "Name"
  #   validity start as a DER "Time"
  #   validity end as a DER "Time"
  #   subject name as a DER "Name"
  #   subject public key as a DER "SubjectPublicKeyInfo"
  #   subject public key id if v3 Extension SubjectKeyIdentifier is present
  #     otherwise undef.  This is just the raw bytes of the key id, no DER
  #     header.  (Same format as returned by GetKeyInfo and GetOpenSSHKeyInfo.)
  # or undef if the certificate is unparseable

  no warnings;
  my $der = shift;
  my $subjectKeyIdentifier = DEROID('2.5.29.14');
  return undef if unpack('C',substr($der,0,1)) != 0x30;
  my ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) == 1 + $lenbytes + $len;
  substr($der, 0, 1 + $lenbytes) = '';
  return undef if unpack('C',substr($der,0,1)) != 0x30;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) >= 1 + $lenbytes + $len;
  substr($der, 0, 1 + $lenbytes) = '';
  substr($der, $len) = '';
  my $byte = unpack('C',substr($der,0,1));
  my $ver = 1;
  if ($byte == 0xA0) {
    return undef if length($der) < 5 || substr($der,1,3) != pack('H*','030201');
    $byte = unpack('C',substr($der,4,1));
    # Zero shouldn't be allowed as it's DEFAULT but we'll let it go by
    return undef if $byte > 2; # unrecognized version
    $ver = $byte + 1;
    substr($der,0,5) = '';
  }
  return undef if unpack('C',substr($der,0,1)) != 0x02;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) > 1+$lenbytes+$len && $len >= 1;
  substr($der, 0, 1 + $lenbytes) = '';
  my $serial = substr($der, 0, $len);
  substr($der, 0, $len) = '';
  return undef if unpack('C',substr($der,0,1)) != 0x30; # Alg ID
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) > 1+$lenbytes+$len;
  substr($der,0,1+$lenbytes+$len) = '';
  return undef if unpack('C',substr($der,0,1)) != 0x30; # Issuer
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) > 1+$lenbytes+$len;
  my $issuer = substr($der, 0, 1 + $lenbytes + $len);
  substr($der,0,1+$lenbytes+$len) = '';
  return undef if unpack('C',substr($der,0,1)) != 0x30; # Validity
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) > 1+$lenbytes+$len;
  my $validlen = $len;
  substr($der, 0, 1 + $lenbytes) = '';
  $byte = unpack('C', substr($der, 0, 1));
  return undef unless $byte == 0x17 || $byte == 0x18;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) > 1+$lenbytes+$len;
  my $vst = substr($der, 0, 1 + $lenbytes + $len);
  substr($der, 0, 1+$lenbytes+$len) = '';
  $byte = unpack('C', substr($der, 0, 1));
  return undef unless $byte == 0x17 || $byte == 0x18;
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) > 1+$lenbytes+$len;
  my $vnd = substr($der, 0, 1 + $lenbytes + $len);
  substr($der, 0, 1+$lenbytes+$len) = '';
  return undef unless $validlen == length($vst) + length($vnd);
  return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) > 1+$lenbytes+$len;
  my $subj = substr($der, 0, 1 + $lenbytes + $len);
  substr($der, 0, 1+$lenbytes+$len) = '';
  return undef if unpack('C',substr($der,0,1)) != 0x30; # Subject PubKey
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) >= 1+$lenbytes+$len;
  my $subjkey = substr($der, 0, 1 + $lenbytes + $len);
  substr($der, 0, 1+$lenbytes+$len) = '';
  return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,undef)
    if !length($der) || $ver < 3;
  $byte = unpack('C',substr($der,0,1));
  if ($byte == 0x81) {
    ($len, $lenbytes) = ReadDERLength(substr($der,1));
    return undef unless length($der) >= 1+$lenbytes+$len;
    substr($der,0,1+$lenbytes+$len) = '';
    $byte = unpack('C',substr($der,0,1));
  }
  if ($byte == 0x82) {
    ($len, $lenbytes) = ReadDERLength(substr($der,1));
    return undef unless length($der) >= 1+$lenbytes+$len;
    substr($der,0,1+$lenbytes+$len) = '';
    $byte = unpack('C',substr($der,0,1));
  }
  return undef if length($der) && $byte != 0xA3; # exts tag
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) == 1+$lenbytes+$len;
  my $skid = undef;
  substr($der, 0, 1+$lenbytes) = '';
  return undef unless unpack('C',substr($der,0,1)) == 0x30; # Extensions
  ($len, $lenbytes) = ReadDERLength(substr($der,1));
  return undef unless length($der) == 1+$lenbytes+$len;
  substr($der, 0, 1+$lenbytes) = '';
  while (length($der)) {
    return undef unless unpack('C',substr($der,0,1)) == 0x30;
    ($len, $lenbytes) = ReadDERLength(substr($der,1));
    return undef unless length($der) >= 1+$lenbytes+$len;
    substr($der,0,1+$lenbytes) = '';
    return undef unless unpack('C',substr($der,0,1)) == 0x06;
    if (substr($der,0,length($subjectKeyIdentifier)) ne $subjectKeyIdentifier) {
      substr($der,0,$len) = '';
      next;
    }
    substr($der,0,length($subjectKeyIdentifier)) = '';
    if (unpack('C',substr($der,0,1)) == 0x01) {
      # SHOULDn't really be here, but allow it anyway
      return undef unless unpack('C',substr($der,1,1)) == 0x01;
      substr($der,0,3) = '';
    }
    return undef unless unpack('C',substr($der,0,1)) == 0x04;
    ($len, $lenbytes) = ReadDERLength(substr($der,1));
    return undef unless length($der) >= 1+$lenbytes+$len && $len > 1;
    substr($der,0,1+$lenbytes) = '';
    return undef unless unpack('C',substr($der,0,1)) == 0x04;
    ($len, $lenbytes) = ReadDERLength(substr($der,1));
    return undef unless length($der) >= 1+$lenbytes+$len && $len >= 1;
    $skid = substr($der,1+$lenbytes,$len);
    last;
  }
  return ($ver,$serial,$issuer,$vst,$vnd,$subj,$subjkey,$skid)
}

sub BreakLine($$)
{
  my ($line,$width) = @_;
  my @ans = ();
  return $line if $width < 1;
  while (length($line) > $width) {
    push(@ans, substr($line, 0, $width));
    substr($line, 0, $width) = '';
  }
  push(@ans, $line) if length($line);
  return @ans;
}

sub whirlpool($)
{
  my $data = shift;
  my $hash;
  {
    local(*CHLD_OUT, *CHLD_IN);
    #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
    #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
    (my $pid = open2(\*CHLD_OUT, \*CHLD_IN, "openssl", "dgst", "-whirlpool",
        "-binary"))
      or die "Cannot start openssl dgst\n";
    print CHLD_IN $data;
    close(CHLD_IN);
    local $/;
    die "Error reading whirlpool digest from openssl dgst\n"
      unless !!($hash = <CHLD_OUT>);
    waitpid($pid, 0);
    close(CHLD_OUT);
    #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
  }
  return $hash;
}

sub GetDigest($)
{
  my $dgst = shift;
  my $sha1   = DEROID('1.3.14.3.2.26');
  my $sha224 = DEROID('2.16.840.1.101.3.4.2.4'); # RFC 3560
  my $sha256 = DEROID('2.16.840.1.101.3.4.2.1'); # RFC 3560
  my $sha384 = DEROID('2.16.840.1.101.3.4.2.2'); # RFC 3560
  my $sha512 = DEROID('2.16.840.1.101.3.4.2.3'); # RFC 3560
  my $whirlpoolAlgorithm = DEROID('1.0.10118.3.0.55'); # RFC 6931
  my $sha1WithRSAEncryption   = DEROID('1.2.840.113549.1.1.5');  # RFC 2437
  my $sha224WithRSAEncryption = DEROID('1.2.840.113549.1.1.14'); # RFC 4055
  my $sha256WithRSAEncryption = DEROID('1.2.840.113549.1.1.11'); # RFC 4055
  my $sha384WithRSAEncryption = DEROID('1.2.840.113549.1.1.12'); # RFC 4055
  my $sha512WithRSAEncryption = DEROID('1.2.840.113549.1.1.13'); # RFC 4055
  my $sha512_224WithRSAEncryption = DEROID('1.2.840.113549.1.1.15'); # RFC 8017
  my $sha512_256WithRSAEncryption = DEROID('1.2.840.113549.1.1.16'); # RFC 8017
  my $whirlpoolWithRSAEncryption = DEROID('1.0.10118.3.0.55'); # RFC 6931 2.3.8
  return ($sha1, $sha1WithRSAEncryption, \&sha1) if $dgst eq 'sha1';
  my $h = undef;
  my $oid = undef;
  my $func = undef;
  for (;;) {
    $h=$sha224,$oid=$sha224WithRSAEncryption,$func=\&sha224,last
      if $dgst eq 'sha224';
    $h=$sha256,$oid=$sha256WithRSAEncryption,$func=\&sha256,last
      if $dgst eq 'sha256';
    $h=$sha384,$oid=$sha384WithRSAEncryption,$func=\&sha384,last
      if $dgst eq 'sha384';
    $h=$sha512,$oid=$sha512WithRSAEncryption,$func=\&sha512,last
      if $dgst eq 'sha512';
    $h=$whirlpoolAlgorithm,$oid=$whirlpoolWithRSAEncryption,
      $func=\&whirlpool,last if $dgst eq 'whirlpool';
    last;
  }
  die "Invalid digest ($dgst) must be one of:\n"
    . "  sha1 sha224 sha256 sha384 sha512\n" unless $h && $oid;
  die "Digest $dgst requires Digest::SHA or Digest::SHA::PurePerl "
    . "to be available\n" if !$hasSha2;
  return ($h,$oid,$func);
}

sub GetDigestStrength($)
{
  return 80 if $_[0] eq 'sha1';
  return 112 if $_[0] eq 'sha224';
  return 128 if $_[0] eq 'sha256';
  return 192 if $_[0] eq 'sha384';
  return 256 if $_[0] eq 'sha512';
  return 256 if $_[0] eq 'whirlpool';
}

sub GetDigestNameForBits($)
{
  return 'sha1' if $_[0] <= 80;
  return 'sha224' if $_[0] <= 112;
  return 'sha256' if $_[0] <= 128;
  return 'sha384' if $_[0] <= 192;
  return 'sha512';
}

sub toupper($)
{
  my $str = shift;
  $str =~ tr/a-z/A-Z/;
  return $str;
}

sub tolower($)
{
  my $str = shift;
  $str =~ tr/A-Z/a-z/;
  return $str;
}

sub RSASign($$)
{
  my ($data, $keyfile) = @_;
  my $sig;
  {
    local(*CHLD_OUT, *CHLD_IN);
    #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
    #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
    (my $pid = open2(\*CHLD_OUT, \*CHLD_IN, "openssl", "rsautl", "-sign",
        "-inkey", $keyfile))
      or die "Cannot start openssl rsautl\n";
    print CHLD_IN $data;
    close(CHLD_IN);
    local $/;
    die "Error reading RSA signature from openssl rsautl\n"
      unless !!($sig = <CHLD_OUT>);
    waitpid($pid, 0);
    close(CHLD_OUT);
    #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
  }
  return $sig;
}

my %rsadsa_known_strengths;
BEGIN {
  %rsadsa_known_strengths = (
    1024 => 80,
    2048 => 112,
    3072 => 128,
    7680 => 192,
    15360 => 256,
  );
}

sub compute_rsa_strength($)
{
  my $rsadsabits = shift;
  return 0 unless $rsadsabits && $rsadsabits > 0;
  return ($rsadsa_known_strengths{$rsadsabits},'')
    if $rsadsa_known_strengths{$rsadsabits};
  my $guess;
  if ($rsadsabits < 1024) {
    $guess = 80 * sqrt($rsadsabits/1024);
  } elsif ($rsadsabits > 15360) {
    $guess = 256 * sqrt($rsadsabits/15360);
  } else {
    $guess = 34.141 + sqrt(34.141*34.141 - 4*0.344*(1554.7-$rsadsabits));
    $guess = $guess / (2 * 0.344);
  }
  $guess = 79 if $rsadsabits < 1024 && $guess >= 80;
  $guess = 80 if $rsadsabits > 1024 && $guess < 80;
  $guess = 111 if $rsadsabits > 1024 && $rsadsabits < 2048 && $guess >= 112;
  $guess = 112 if $rsadsabits > 2048 && $guess < 112;
  $guess = 127 if $rsadsabits > 2048 && $rsadsabits < 3072 && $guess >= 128;
  $guess = 128 if $rsadsabits > 3072 && $guess < 128;
  $guess = 191 if $rsadsabits > 3072 && $rsadsabits < 7680 && $guess >= 192;
  $guess = 192 if $rsadsabits > 7680 && $guess < 192;
  $guess = 255 if $rsadsabits > 7680 && $rsadsabits < 15360 && $guess >= 256;
  $guess = 256 if $rsadsabits > 15360 && $guess < 256;
  return (int($guess),1);
}

sub is_ipv4($)
{
  my $octet = '(?:\d|[1-9]\d|1\d{2}|2[0-4]\d|25[0-5])';
  return $_[0] =~ /^$octet\.$octet\.$octet\.$octet$/o;
}

# 1-8 groups of 1-4 hex digits separated by ':' except that the groups may be
# divided into two and separated by '::' instead and finally the last two
# groups may be specified using IPv4 notation.  No scope allowed.
sub parseipv6($)
{
  my $a = shift;
  return undef unless $a =~ /^[:0-9a-fA-F.]+$/;
  my $two = 0;
  my @group1 = ();
  my @group2 = ();
  if ($a =~ /^(.*)::(.*)$/) {
    @group1 = split(/:/, $1) if $1;
    @group2 = split(/:/, $2) if $2;
    $two = 1;
  } else {
    @group2 = split(/:/, $a);
  }
  if (@group2 && is_ipv4($group2[@group2 - 1])) {
    my @ipv4 = split(/\./, pop(@group2));
    push(@group2, sprintf("%x", ($ipv4[0] << 8) | $ipv4[1]));
    push(@group2, sprintf("%x", ($ipv4[2] << 8) | $ipv4[3]));
  }
  return undef unless @group1 + @group2 >= 1 && @group1 + @group2 <= 8;
  return undef if $two && @group1 + @group2 >= 8;
  if ($two) {
    my $zcomps = 8 - (@group1 + @group2);
    for (my $i=0; $i < $zcomps; ++$i) {
      push(@group1, 0);
    }
  }
  my $ans = '';
  foreach my $comp (@group1,@group2) {
    return undef unless $comp =~ /^[0-9a-fA-F]{1,4}$/;
    $ans .= pack('n', hex($comp));
  }
  return $ans;
}

sub parseip($)
{
  my $a = shift;
  if (is_ipv4($a)) {
    return pack('CCCC', split(/\./, $a, 4));
  } else {
    return parseipv6($a);
  }
}

# See these RFCs:
#   RFC 1034 section 3.5
#   RFC 1123 section 2.1
#   RFC 1738 section 3.1
#   RFC 3986 section 3.2.2
sub is_dns_valid($)
{
  my $dns = shift;
  defined($dns) or $dns = '';
  return 0 if $dns eq '' || $dns =~ /\s/;
  my @labels = split(/\./, $dns, -1);
  # Check each label
  my $i = -1;
  foreach my $label (@labels) {
    ++$i;
    return 0 unless length($label) > 0 && length($label) <= 63;
    return 0 unless $label =~ /^[A-Za-z0-9](?:[A-Za-z0-9-]*[A-Za-z0-9])?$/ ||
                              ($i == 0 && $label eq '*' && @labels > 1);
  }
  return 0 unless length($dns) <= 255;
  return 1;
}

sub handle_dns_opt($$)
{
  my $val = shift;
  my $altsref = shift;
  my $ip = parseip($val);
  if (defined($ip)) {
    die "Internal error: parsed IP not 4 or 16 bytes long"
      unless length($ip) == 4 || length($ip) == 16;
    push(@$altsref, [0x87, $ip]);
  } else {
    $val =~ s/\.$//;
    die "Not a valid dns name or IPv4/IPv6 address: $val\n"
      unless is_dns_valid($val);
    push(@$altsref, [0x82, $val]);
  }
}

sub is_oid_valid($)
{
  my $oid = shift;
  return 0 unless $oid =~ /^\d+(?:\.\d+)*$/os;
  my @ids = split(/[.]/, $oid);
  return 0 unless @ids >= 2;
  return 0 unless $ids[0] <= 2;
  return 0 if $ids[0] < 2 && $ids[1] >= 40;
  return 1;
}

sub is_email_valid($;$$)
{
  my ($val, $emailatok, $emailatseen) = @_;
  my $isat;
  if ($val eq "@") {
    return 0 if !$emailatok || $$emailatseen;
    $val = $emailatok;
    $isat = 1;
  }
  return 0 unless $val =~ /^([^@\s]+)\@([A-Za-z0-9.-]+)$/;
  my ($local,$host) = ($1,$2);
  return 0 unless is_dns_valid($host);
  return 0 unless $local =~ /^[[:print:]]+$/os;
  if ($isat) {
    $_[0] = $emailatok;
    $$emailatseen = 1;
  }
  return 1;
}

sub validate_oid_value($$$;$$)
{
  our $quiet;
  our $nomaxlen;
  our $useRandom;
  my ($oid, $value, $key, $emailatok, $emailatseen) = @_;
  if (defined($oidstringlengths{$oid})) {
    my $len = $oidstringlengths{$oid};
    if ($len =~ /^\d+$/) {
      if (length($value) != $len) {
        warn "--dni key type '$key' requires exactly $len characters\n";
        return 0;
      }
    } elsif ($len =~ /^,(\d+)$/) {
      my $max = $1;
      if (length($value) > $max) {
        warn "--dni key type '$key' requires no more than $max characters\n"
          unless $quiet;
        return 0 unless $nomaxlen;
      }
    } elsif ($len =~ /^(\d+),$/) {
      my $min = $1;
      if (length($value) < $min) {
        warn "--dni key type '$key' requires at least $min characters\n";
        return 0;
      }
    } elsif ($len =~ /^(\d+),(\d+)$/) {
      my ($min,$max) = ($1, $2);
      if (length($value) < $min || length($value) > $max) {
        warn "--dni key type '$key' requires $min-$max characters\n"
          unless $quiet && length($value) >= $min;
        return 0 unless $nomaxlen && length($value) >= $min;
      }
    } else {
      die "Bad value \"$len\" in \%oidstringlengths for '$key'\n";
    }
  }
  warn("--dni key values may not be empty (key '$key')\n"), return 0
    unless length($value);
  if (defined($oidstringtypes{$oid})) {
    my $st = $oidstringtypes{$oid};
    die "Invalid \%oidstringtype value '$st' for $oid\n"
      unless $st eq 'u' || $st eq 'p' || $st eq 'i';
    warn("--dni key type '$key' requires a PrintableString (must match ".
      "[A-Za-z0-9 '()+,./:=?-]+)\n"), return 0
      if $st eq 'p' && $value !~ m|^[A-Za-z0-9 '()+,./:=?-]+$|os &&
         ($oid ne '2.5.4.5' || !$useRandom || $value ne '#');
    warn("--dni key type '$key' requires an IA5String (must match ".
      "[\x00-\x7F]+)\n"), return 0
      if $st eq 'i' && $value !~ m|^[\x00-\x7F]+$|os;
    warn("--dni key type '$key' requires a UTF8String\n"), return 0
      if $st eq 'u' && !IsUTF8(MakeUTF8($value));
  }
  if (defined($oidstringrestrictions{$oid})) {
    my $r = $oidstringrestrictions{$oid};
    die "Invalid \%oidstringrestrictions value '$r' for $oid\n"
      unless $r eq 'c' || $r eq 'd' || $r eq 'e';
    warn("--dni key type '$key' requires 2 A-Z characters\n"), return 0
      if $r eq 'c' && $value !~ m|^[A-Z]{2}$|;
    warn("--dni key type '$key' requires 1-63 character dns label ".
      "(letdig(letdighyp*)letdig*)\n"), return 0
      if $r eq 'd' && (length($value) > 63 ||
         $value !~ m|^[A-Za-z0-9](?:[A-Za-z0-9-]*[A-Za-z0-9])?$|);
    warn("--dni key type '$key' requires an email address (local\@host)\n"),
      return 0 if $r eq 'e' && !is_email_valid($_[1], $emailatok, $emailatseen);
  }
  return 1;
}

sub get_oid_string_type($$)
{
  our $useutf8;
  my ($oid, $value) = @_;
  if (defined($oidstringtypes{$oid})) {
    my $st = $oidstringtypes{$oid};
    return 12 if $st eq 'u';
    return 19 if $st eq 'p';
    return 22 if $st eq 'i';
    die "Invalid \%oidstringtype value '$st' for $oid\n";
  }
  return 19 if !$useutf8 && $value =~ m|^[A-Za-z0-9 '()+,./:=?-]*$|os;
  return 12;
}

sub handle_dni_opt($$$$$)
{
  my $opt = shift;
  my $listref = shift;
  my $stdinokref = shift;
  my $emailatok = shift;
  my $emailatseen = shift;
  my $dor;
  if ($$stdinokref && $$stdinokref > 2) {
    $dor = sub {warn "@_"; return 0}
  } else {
    $dor = sub {die "@_"}
  }
  $opt =~ s/^\s+//;
  $opt =~ s/\s+$//;
  if ($opt =~ /^\@(.*)$/os) {
    my $fn = $1;
    if ($$stdinokref && $$stdinokref > 2) {
      warn "May not use \@filename syntax within a --dni \@filename file\n";
      return 0;
    }
    die "May not use --dni \@- if stdin is being used for a public key\n"
      if $fn eq '-' && !$$stdinokref;
    die "May not use --dni \@- more than once\n"
      if $fn eq '-' && $$stdinokref && $$stdinokref > 1;
    ++$$stdinokref if $fn eq '-';
    my $stdinnotok = 3;
    my $input;
    my $infilename;
    if ($fn ne '-') {
      $infilename = "\"$fn\"";
      open($input, '<', $fn)
        or die "Cannot open $infilename for input: $!\n";
    } else {
      $input = *STDIN;
      $infilename = 'standard input';
    }
    my $lineno = 0;
    while (my $line = <$input>) {
      ++$lineno;
      $line =~ s/(?:\r|\r\n|\n)$//os;
      next if $line =~ /^\s*$/os || $line =~ /^\s*#/os;
      &handle_dni_opt($line, $listref, \$stdinnotok, $emailatok, $emailatseen)
        or die "$infilename:$lineno: error: --dni \@filename syntax error\n";
    }
    close($input) if $fn ne '-';
    return 1;
  }
  return &$dor("Bad --dni key=value option: $opt\n")
    unless $opt =~ /^([+]?)\s*([^+=\s]+)\s*=\s*(.+)$/;
  my ($mv,$key,$value) = ($1,$2,$3);
  my $oid;
  if ($key =~ /^[\d.]+$/) {
    return &$dor("Bad --dni option invalid oid key: $key\n")
      unless is_oid_valid($key);
    warn "*** Warning: The OID $key is not recognized, value will be encoded ".
      "as a PrintableString or UTF8String type\n" unless $knownoids{$key};
    $oid = $key;
  } else {
    return &$dor("Bad --dni option unrecognized key name ".
      "(use --list-oid-names): $key\n") unless $oidnames{lc($key)};
    $oid = $oidnames{lc($key)};
  }
  return &$dor("Bad --dni option '+key=value' requires previous non-'+': $opt\n")
    if $mv && !@$listref;
  return &$dor("Bad --dni option invalid value for key: $opt\n")
    unless validate_oid_value($oid, $value, $key, $emailatok, $emailatseen);
  push(@$listref, []) unless $mv;
  push(@{$$listref[$#$listref]}, [$oid, $value]);
  return 1;
}

sub main
{
  Make1252(); # Set up the UTF-8 auxiliary conversion table

  my $help = '';
  my $verbose = '';
  our $quiet = '';
  our $nomaxlen = '';
  my $acme = '';
  my $keyfile = '';
  my $certfile = '';
  my $useNow = '';
  our $useutf8 = '';
  our $useRandom = '';
  my $useNoRandom = '';
  my $termOK = '';
  my $server = '';
  my @serverAltNames = ();
  my $codesign = '';
  my $applecodesign = '';
  my $client = '';
  my $email = '';
  my $subca = '';
  our $root = '';
  my $rootauth = '';
  our $request = '';
  my $noext = '';
  my $authext = '';
  my $digest = $hasSha2 ? 'sha256' : 'sha1';
  my $digestChoice = '';
  my $debug = 0;
  my $pubx509 = '';
  my $check = '';
  my $pathlen = '';
  my $commonNameOID = '2.5.4.3'; # :commonName
  my $serialNumber = DEROID('2.5.4.5'); # :serialNumber
  my $userIdOID = '0.9.2342.19200300.100.1.1'; # :userId
  my $emailAddressOID = '1.2.840.113549.1.9.1'; # :emailAddress
  my $dnQualifier = DEROID('2.5.4.46'); # :dnQualifier
  my $basicConstraints = DEROID('2.5.29.19');
  my $keyUsage = DEROID('2.5.29.15');
  my $extKeyUsage = DEROID('2.5.29.37');
  my $serverAuth = DEROID('1.3.6.1.5.5.7.3.1');
  my $clientAuth = DEROID('1.3.6.1.5.5.7.3.2');
  my $codeSigning = DEROID('1.3.6.1.5.5.7.3.3');
  my $emailProtection = DEROID('1.3.6.1.5.5.7.3.4');
  my $appleCodeSigning = DEROID('1.2.840.113635.100.4.1');
  my $authKeyId = DEROID('2.5.29.35');
  my $subjKeyId = DEROID('2.5.29.14');
  my $subjAltName = DEROID('2.5.29.17');
  my $boolTRUE = pack('C*',0x01,0x01,0xFF);
  my $boolFALSE = pack('C*',0x01,0x01,0x00);
  my $v3Begin = pack('C',0x17).DERLength(13)."970811000000Z";
  my $noExpiry = pack('C',0x18).DERLength(15)."99991231235959Z";
  my $csrPwCheck = DEROID('1.2.840.113549.1.9.11');
  my $csrExtReq = DEROID('1.2.840.113549.1.9.14');
  my $infile = '-';
  my $outfile = '-';
  my @suffixfiles = ();
  my $suffix = '';
  my $qualifier = undef;
  my @dnilist = ();

  eval {GetOptions(
      "help|h" => sub{$help=1;die"!FINISH"},
      "verbose|v" => \$verbose,
      "man" => sub{$verbose=1;$help=1;die"!FINISH"},
      "version|V" => sub{print $VERSIONMSG;exit(0)},
      "list-oid-names" => sub{print $oidnamelist;exit(0)},
      "debug" => \$debug,
      "quiet" => \$quiet,
      "pubx509" => \$pubx509,
      "pubX509" => \$pubx509,
      "check" => \$check,
      "acme" => \$acme,
      "now" => \$useNow,
      "utf8" => \$useutf8,
      "random" => \$useRandom,
      "no-random" => \$useNoRandom,
      "no-max-len" => \$nomaxlen,
      "t" => \$termOK,
      "server" => \$server,
      "codesign" => \$codesign,
      "applecodesign" => \$applecodesign,
      "email" => \$email,
      "client" => \$client,
      "subca" => \$subca,
      "root" => \$root,
      "rootauth" => \$rootauth,
      "request" => \$request,
      "no-extensions" => \$noext,
      "authext" => \$authext,
      "digest=s" => \$digestChoice,
      "key|k=s" => \$keyfile,
      "cert|c=s" => \$certfile,
      "pathlen=i" => \$pathlen,
      "in=s" => \$infile,
      "out=s" => \$outfile,
      "suffix=s" => sub{push(@suffixfiles, $_[1])},
      "dnq=s" => \$qualifier,
      "dns=s" => sub{handle_dns_opt($_[1], \@serverAltNames)},
      "dni=s" => sub{push(@dnilist, $_[1])}
    )} || $help
      or die $USAGE;
  if ($help) {
    local *MAN;
    my $pager = $ENV{'PAGER'} || 'less';
    if (-t STDOUT && open(MAN, "|-", $pager)) {
      print MAN formatman($HELP,1);
      close(MAN);
    }
    else {
      print formatman($HELP);
    }
    exit(0);
  }
  die "--acme and --check are not compatible\n" if $acme && $check;
  die("May not combine --random and --no-random\n", $USAGE)
    if $root && $useRandom && $useNoRandom;
  die "--no-extensions requires use of --request\n" if $noext && !$request;
  $useRandom = 1 if (!$request || !$noext) && $root && !$useNoRandom;
  my @dnseq = ();
  if ($acme) {
    $useNow = '';
    $useNoRandom = '';
    $useRandom = 1;
    $root = 1;
    $rootauth = '';
    $qualifier = undef;
    @serverAltNames = ();
    $client = $subca = $server = $codesign = $applecodesign = $email = '';
    @suffixfiles = ();
    @dnseq = (
      [[$oidnames{'o'}, 'Acme Products Corporation']],
      [[$oidnames{'ou'}, 'Internet Services Division']],
      [[$oidnames{'ou'}, 'Acme Certificate Co.']],
      [[$oidnames{'ou'}, 'Certificate Services']],
      [[$oidnames{'ou'}, 'Root Certificate Production']],
      [[$oidnames{'serial'}, '#']],
      [[$oidnames{'cn'}, 'Acme Root Certificate']]
    );
  }
  die "--in requires a filename\n" if !$request && !$root && !$infile;
  die "--out requires a filename\n" if !$outfile;
  foreach my $suffixfile (@suffixfiles) {
    die "--suffix requires a filename\n" if defined($suffixfile) && !$suffixfile;
    die "--suffix file '$suffixfile' does not exist or is not readable\n"
      if ! -e $suffixfile || ! -r $suffixfile;
  }
  $client = 1 if
    !$root && !$subca && !$server && !$codesign && !$applecodesign && !$email;
  my $dnistdinok = $request || $root || $infile ne '-';
  my ($emailatok, $emailatseen);
  if (!$client && $email && defined($ARGV[0]) && $ARGV[0] ne "") {
    $emailatok = $ARGV[0];
    $emailatseen = 0;
  }
  foreach my $dnitem (@dnilist) {
    handle_dni_opt($dnitem, \@dnseq, \$dnistdinok, $emailatok, \$emailatseen);
  }
  if ($useRandom) {
    my $stuffcount = 0;
    my $seenbad = 0;
    RDN: foreach my $rdn (@dnseq) {
      if (@$rdn == 1) {
        ++$stuffcount if ${$$rdn[0]}[0] eq '2.5.4.5' && ${$$rdn[0]}[1] eq '#';
      } else {
        foreach my $mv (@$rdn) {
          $seenbad = 1, last RDN if $$mv[0] eq '2.5.4.5' && $$mv[1] eq '#';
        }
      }
    }
    die "--dni serialNumber=# can only be used at most once and only ".
      "non-multivalued\n" if $seenbad || $stuffcount > 1;
  }
  my %seensingletons = ();
  foreach my $rdn (@dnseq) {
    $seensingletons{${$$rdn[0]}[0]} = 1 if @$rdn == 1;
  }
  $verbose = 1 if $debug || $check;
  $quiet = 0 if $verbose || $check;
  print STDERR $VERSIONMSG if $verbose;
  my $keytype = 'OpenSSH';
  my $n = 'n';
  $keytype = 'pubx509', $n = '' if $pubx509;
  die("Missing required --key option\n", $USAGE) if !$keyfile;
  die("Missing required --cert option\n", $USAGE) if !$request && !$root && !$certfile;
  die("Must have exactly one \"name string\" argument\n", $USAGE)
    if !$check && !$acme && @ARGV != 1;
  die "Standard input is a tty (which is an unlikely source of a$n $keytype "
    . "public key)\n"
    . "If that's what you truly meant, add the -t option to allow it.\n"
    if !$request && !$root && $infile eq '-' && -t STDIN && !$termOK;
  my $emptynameok = $check || ($root && $useRandom);
  if (!$emptynameok && $ARGV[0] eq '') {
    if ($client) {
      # Okay to be empty if we've seen a user id singleton
      $emptynameok = 1 if $seensingletons{$userIdOID};
    } elsif (!$email) {
      # Okay to be empty if we've seen a common name singleton
      $emptynameok = 1 if $seensingletons{$commonNameOID};
    }
    die "\"name string\" may not be empty\n" unless $emptynameok;
  }
  die "Distinguished name qualifier may not be empty string\n"
    unless !defined($qualifier) || $qualifier ne '';
  die "Invalid distinguished name qualifier (must match [A-Za-z0-9 '()+,./:=?-]+)\n"
    unless !$qualifier || $qualifier =~ m|^[A-Za-z0-9 '()+,./:=?-]+$|;
  if (!$check && @ARGV && $ARGV[0] ne '') {
    my ($oid, $key);
    if ($client) {
      $oid = $userIdOID;
      $key = 'UID';
    } elsif ($email) {
      $oid = $emailAddressOID;
      $key = 'emailAddress';
    } else {
      $oid = $commonNameOID;
      $key = 'CN';
    }
    die "Bad \"name string\" value\n"
      unless $emailatseen || validate_oid_value($oid, $ARGV[0], $key);
    push(@dnseq, [[$oid, $ARGV[0]]]) unless $emailatseen;
  }
  my $opensshdotpub;
  my $infilename;
  foreach my $suffixfile (@suffixfiles) {
    open(SUFFIX, '<', $suffixfile)
      or die "Cannot open '$suffixfile' for input: $!\n";
    local $/;
    $suffix .= <SUFFIX>;
    close(SUFFIX);
  }
  if (!$request && !$root) {
    local $/ if $pubx509;
    my $input;
    if ($infile ne '-') {
      $infilename = "\"$infile\"";
      open($input, '<', $infile)
        or die "Cannot open $infilename for input: $!\n";
    } else {
      $input = *STDIN;
      $infilename = 'standard input';
    }
    !!($opensshdotpub = <$input>)
      or die "Cannot read $keytype public key from $infilename\n";
    if (!$pubx509) {
      my $auto509 = 0;
      if ($opensshdotpub =~ /^----[- ]BEGIN PUBLIC KEY[- ]----/) {
        $auto509 = 1;
      }
      else {
        my $input = $opensshdotpub;
        $input =~ s/((?:\r\n|\n|\r).*)$//os;
        my @fields = split(' ', $input, 3);
        if (@fields < 2 ||
            length($fields[1]) < 16 ||
            $fields[1] !~ m|^[0-9A-Za-z+/=]+$|) {
          $auto509 = 1;
        }
      }
      if ($auto509) {
        $pubx509 = 1;
        $keytype = 'pubx509';
        print STDERR "auto detected --pubx509 option\n" if $debug;
        local $/;
        my $extra = <$input>;
        $opensshdotpub .= $extra if $extra;
      }
    }
    close($input) if $infile ne '-';
  }
  die "Cannot read key file $keyfile\n" if ! -r $keyfile;
  die "Cannot read certificate file $certfile\n"
    if !$request && !$root && ! -r $certfile;

  my ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub);
  if ($request || $root) {
    # need to set $sshkeyid to $pubkeyid
    # need to set $opensshpub to $pubkey
    # but don't have either yet, so do it later
  }
  elsif ($pubx509) {
    local (*READKEY, *WRITEKEY);
    my $inform = $opensshdotpub =~ m|^[\t\n\r\x20-\x7E]*$|os ? 'PEM' : 'DER';
    print STDERR "pubx509 -inform $inform\n" if $debug;
    open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
    open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
    my $pid = open2(\*READKEY, \*WRITEKEY, "openssl", "rsa", "-inform",
      $inform, "-pubin", "-outform", "DER", "-pubout");
    open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
    $pid or die "Cannot start openssl rsa\n";
    print WRITEKEY $opensshdotpub;
    close(WRITEKEY);
    local $/;
    die "Error reading X.509 format RSA public key from $infilename\n"
      unless !!($opensshpub = <READKEY>);
    waitpid($pid, 0);
    close(READKEY);
    $sshcmnt = undef;
    ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1) = GetKeyInfo($opensshpub);
    die "Unparseable X.509 public key format read from $infilename\n"
      unless $sshkeybits;
  }
  else {
    ($sshkeybits,$sshkeyexp,$sshkeyid,$sfmd5,$sfsha1,$sshcmnt,$opensshpub) =
      GetOpenSSHKeyInfo($opensshdotpub);
    die "Unparseable OpenSSH public key read from $infilename\n"
      unless $sshkeybits;
    die "Unsupported OpenSSH public key type ($sshkeybits), must be ssh-rsa\n"
      unless $sshkeyexp;
  }
  my $sshkeystrength;
  if (!$request && !$root) {
    my $sshkeyapprox;
    ($sshkeystrength, $sshkeyapprox) = compute_rsa_strength($sshkeybits);
    printf(STDERR "$keytype Public Key Info:\n".
        "  bits=$sshkeybits pubexp=$sshkeyexp secstrenth=%s%s\n",
        $sshkeystrength, ($sshkeyapprox ? ' (approximately)' : '')) if $verbose;
    print STDERR "  keyid=",
      join(":", toupper(unpack("H*",$sshkeyid))=~/../g), "\n" if $verbose;
    print STDERR "  fingerprint(md5)=",
      join(":", tolower(unpack("H*",$sfmd5))=~/../g), "\n" if $verbose;
    print STDERR "  fingerprint(sha1)=",
      join(":", tolower(unpack("H*",$sfsha1))=~/../g), "\n" if $verbose;
    print STDERR "  comment=",$sshcmnt||'<none present>',"\n"
      if $verbose && !$pubx509;
    die "*** Error: $keytype key has less than 512 bits ($sshkeybits)\n"
      . "***        You might as well just donate your system to hackers now.\n"
      if $sshkeybits < 512;
    die "*** Error: The $keytype key's public exponent is even ($sshkeyexp)!\n"
      if !($sshkeyexp & 0x01);
    warn "*** Warning: The $keytype key has less than 2048 bits ($sshkeybits), "
      . "continuing anyway\n" if !$quiet && $sshkeybits < 2048;
    die "*** Error: The $keytype public key's exponent of $sshkeyexp is "
      . "unacceptably weak!\n" if $sshkeyexp < 35; # OpenSSH used 35 until v5.4
    warn "*** Warning: The $keytype public key's exponent ($sshkeyexp) is weak "
      . "(< 65537), continuing anyway\n" if !$quiet && $sshkeyexp < 65537;
  }

  my $inform = -T $keyfile ? 'PEM' : 'DER';
  print STDERR "keyfile -inform $inform\n" if $debug;
  die "Input key does not appear to be in PEM format: $keyfile\n"
    unless $inform eq 'PEM';
  my $pubkey;
  {
    local *READKEY;
    open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
    open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
    open(READKEY, "-|", "openssl", "rsa", "-inform", $inform, "-outform", "DER",
        "-pubout", "-passin", "pass:", "-in", $keyfile)
      or die "Cannot read RSA private key in \"$keyfile\": $!\n";
    open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
    local $/;
    die "Error reading RSA private key in \"$keyfile\"\n"
      unless !!($pubkey = <READKEY>);
    close(READKEY);
  }
  $opensshpub = $pubkey if $request || $root;
  my ($pubkeybits,$pubkeyexp,$pubkeyid,$pfmd5,$pfsha1) = GetKeyInfo($pubkey);
  $sshkeyid = $pubkeyid if $request || $root;
  die "Unparseable public key format in \"$keyfile\"\n" unless $pubkeybits;
  my ($pubkeystrength, $pubkeyapprox) = compute_rsa_strength($pubkeybits);
  printf(STDERR "RSA Private Key $keyfile:\n".
    "  bits=$pubkeybits pubexp=$pubkeyexp secstrength=%s%s\n",
    $pubkeystrength, ($pubkeyapprox?' (approximately)':'')) if $verbose;
  print STDERR "  keyid=",
    join(":", toupper(unpack("H*",$pubkeyid))=~/../g), "\n" if $verbose;
  print STDERR "  fingerprint(md5)=",
    join(":", tolower(unpack("H*",$pfmd5))=~/../g), "\n" if $verbose;
  print STDERR "  fingerprint(sha1)=",
    join(":", tolower(unpack("H*",$pfsha1))=~/../g), "\n" if $verbose;
  die "*** Error: Private key has less than 512 bits ($pubkeybits)\n"
    . "***        You might as well just donate your system to hackers now.\n"
    if $pubkeybits < 512;
  die "*** Error: The private key's public exponent is even ($pubkeyexp)!\n"
    if !($pubkeyexp & 0x01);
  warn "*** Warning: The private key has less than 2048 bits ($pubkeybits), "
    . "continuing anyway\n" if !$quiet && $pubkeybits < 2048;
  die "*** Error: The private key's public key exponent of $pubkeyexp is "
    . "unacceptably weak!\n" if $pubkeyexp < 35; # ssh-keygen used 35 'til v5.4
  warn "*** Warning: The private key's public exponent ($pubkeyexp) is weak "
    . "(< 65537), continuing anyway\n" if !$quiet && $pubkeyexp < 65537;

  my $maxkeystrength = $pubkeystrength;
  $maxkeystrength = $sshkeystrength
    if $sshkeystrength && $sshkeystrength > $maxkeystrength;
  my $digeststrength = GetDigestStrength($digestChoice || $digest);
  my $digestsuggest = GetDigestNameForBits($maxkeystrength);
  my $digestsuggestbits = GetDigestStrength($digestsuggest);
  # Never warn or auto-choose if both keys are <= 1024 bits in length
  if ($maxkeystrength > 80) {
    if (!$digestChoice) {
      if (!$hasSha2 && $digestsuggestbits > $digeststrength) {
        warn "*** Warning: automatic digest selection $digestsuggest ".
          "support not available\n" unless $quiet;
      } else {
        $digest = $digestsuggest if $digestsuggestbits > $digeststrength;
      }
    }
  }
  my ($did, $dalg, $dfunc) = GetDigest($digestChoice || $digest);
  print STDERR "default digest: $digest\n" if $debug;
  if ($digestChoice && $digestsuggestbits > $digeststrength) {
    warn "*** Warning: $digestsuggest (or stronger) is recommended for ".
      "security strength $maxkeystrength keys, continuing anyway\n"
      unless $quiet;
  }
  warn "*** Warning: defaulting to sha1 since SHA-2 support not available\n"
    if !$quiet && $digest eq 'sha1' && !$digestChoice;
  $digest = $digestChoice if $digestChoice;
  warn "*** Warning: sha1 use is strongly discouraged, continuing anyway\n"
    if !$quiet && $digest eq 'sha1';
  warn <<EOT if !$quiet && $digest eq 'whirlpool';
*** Warning: whirlpool use requires use of the same OID (1.0.10118.3.0.55)
***          for both the hash algorithm and signature algorithm identifiers.
***          While this is an official OID and RFC 6931 section 2.3.8 does
***          make it clear that the only valid encryption method to be used
***          with whirlpool is RSA, such certificates are unlikely to work.
***
***          Previous versions of this software used an unofficial OID
***          suggested on one of the OpenSSL mailing lists for the signature
***          algorithm identifier, but that's really not necessary as RFC 6931
***          makes it clear that use of whirlpool implies use of RSA.  RFC 8017
***          has since assigned that unofficial OID officially to something
***          else so it must not be used as an RSA-Whirlpool unofficial OID.
***
***          Unless you have a specific application that you know supports use
***          of the whirlpool OID as the encryption identifier, you should
***          select a different signing digest as whirlpool certificates are
***          unlikely to work.
***
***          Continuing anyway.
EOT
  print STDERR "Using digest $digest\n" if $verbose;

  my ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid);
  if ($request || $root) {
    $vst = $v3Begin;
    $vnd = $noExpiry;
    $subjkeyid = $pubkeyid;
  }
  else {
    $inform = -T $certfile ? 'PEM' : 'DER';
    print STDERR "certfile -inform $inform\n" if $debug;
    my $signcert;
    {
      local *READCERT;
      #open(my $olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
      #open(STDERR, '>', "/dev/null") or die "Cannot redirect STDERR: $!";
      open(READCERT, "-|", "openssl", "x509", "-inform", $inform, "-outform",
          "DER", "-in", $certfile)
        or die "Cannot read X.509 certificate in \"$certfile\"\n";
      #open(STDERR, ">&", $olderr) or die "Cannot dup \$olderr: $!";
      local $/;
      die "Error reading X.509 certificate in \"$certfile\"\n"
        unless !!($signcert = <READCERT>);
      close(READCERT);
    }
    ($cver,$cser,$issuer,$vst,$vnd,$subj,$subjkey,$subjkeyid) =
      GetCertInfo($signcert);
    die "Unparseable certificate format in \"$certfile\"\n" unless $cver;
    my $dser = $cser;
    substr($dser,0,1) = '' if unpack('C',substr($cser,0,1)) == 0x00;
    print STDERR "X.509 Certificate $certfile:\n",
      "  ver=v$cver serial=", join(":", tolower(unpack("H*",$dser))=~/../g),"\n"
      if $verbose;
    print STDERR "  notBefore=",DERTimeStr($vst)||'Invalid Time',
      " notAfter=",DERTimeStr($vnd)||'Invalid Time',"\n" if $verbose;
    #print STDERR "  issuer=",DERNameStr($issuer),"\n" if $verbose;
    #print STDERR "  name=",DERNameStr($subj),"\n" if $verbose;
    print STDERR "  subj_keyid=", join(":", toupper(
      unpack("H*",$subjkeyid))=~/../g), "\n" if defined($subjkeyid) && $verbose;
    die "The private key is not the correct one for the certificate:\n".
      "  certificate: $certfile\n".
      "  private key: $keyfile\n" unless $subjkey eq $pubkey;
    if (!defined($subjkeyid)) {
      warn "*** Warning: The certificate has no subjectKeyIdentifier, "
        . "using RFC 5280 (1)\n";
      $subjkeyid = $pubkeyid;
    }
    warn "*** Warning: subjectKeyIdentifier non-standard, continuing anyway\n"
      unless $subjkeyid eq $pubkeyid;
    die "*** Error: The $keytype public key is the same as the certificate's "
      . "public key.\n"
      . "***        They must be different for security reasons.\n"
      if $pubkey eq $opensshpub;
  }
  return 0 if $check;

  my $version = $request ?
    pack('CCC', 0x02, 0x01, 0x00) : # CSR v1
    pack('CCCCC', 0xA0, 0x03, 0x02, 0x01, 0x02); # X.509 v3
  my $randval;
  my $serialRDN;
  if ($useRandom) {
    $randval = RandomID($quiet);
    $serialRDN = join(":", tolower(unpack("H*",$randval))=~/../g);
  }
  my $sigAlg = $dalg . pack('CC',0x05,0x00);
  $sigAlg = pack('C',0x30).DERLength(length($sigAlg)).$sigAlg;
  my $stuffedrand = '';
  if ($useRandom && $seensingletons{'2.5.4.5'}) {
    foreach my $rdn (@dnseq) {
      if (@$rdn == 1 && ${$$rdn[0]}[0] eq '2.5.4.5') {
        if (${$$rdn[0]}[1] eq '#') {
          ${$$rdn[0]}[1] = $serialRDN;
          $stuffedrand = 1;
          last;
        }
      }
    }
  }
  my $name = '';
  foreach my $rdn (@dnseq) {
    my $packedrdn = '';
    foreach my $pair (@$rdn) {
      my $packedoid = DEROID($$pair[0]);
      my $val = MakeUTF8($$pair[1]);
      my $st = get_oid_string_type($$pair[0], $$pair[1]);
      my $packed = $packedoid.pack('C',$st).DERLength(length($val)).$val;
      $packedrdn .= pack('C',0x30).DERLength(length($packed)).$packed;
    }
    $name .= pack('C',0x31).DERLength(length($packedrdn)).$packedrdn;
  }
  if ($root && $useRandom && !$stuffedrand) {
    $serialRDN = pack('C',0x13).DERLength(length($serialRDN)).$serialRDN;
    $serialRDN = $serialNumber . $serialRDN;
    $serialRDN = pack('C',0x30).DERLength(length($serialRDN)).$serialRDN;
    $serialRDN = pack('C',0x31).DERLength(length($serialRDN)).$serialRDN;
    $name = $serialRDN . $name;
  }
  if ($qualifier) {
    my $dnq = $qualifier;
    $dnq = pack('C',0x13).DERLength(length($dnq)).$dnq;
    $dnq = $dnQualifier . $dnq;
    $dnq = pack('C',0x30).DERLength(length($dnq)).$dnq;
    $dnq = pack('C',0x31).DERLength(length($dnq)).$dnq;
    $name .= $dnq;
  }
  $name = pack('C',0x30).DERLength(length($name)).$name;
  $subj = $name if $request || $root;
  my $validity = ($useNow ? DERTime(time()) : $vst).$vnd;
  $validity = pack('C',0x30).DERLength(length($validity)).$validity;
  my $extCAVal;
  if ($subca || $root) {
    $extCAVal = $boolTRUE;
    if ($subca && $pathlen ne '') {
      $extCAVal .= DERInteger($pathlen);
    }
    $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
  }
  else {
    #$extCAVal = pack('C',0x30).DERLength(length($boolFALSE)).$boolFALSE;
    $extCAVal = pack('C',0x30).DERLength(0); # do not include DEFAULT value
  }
  $extCAVal = pack('C',0x04).DERLength(length($extCAVal)).$extCAVal;
  $extCAVal = $basicConstraints . $boolTRUE . $extCAVal;
  $extCAVal = pack('C',0x30).DERLength(length($extCAVal)).$extCAVal;
  my $extKeyBits = 0x80;
  $extKeyBits |= 0x06 if $subca || $root;
  $extKeyBits |= 0x20 if $server;
  $extKeyBits |= 0x60 if $email;
  my $extKeySpare = scalar(@{[
    unpack("B*", chr((($extKeyBits & ($extKeyBits-1)) ^ $extKeyBits) - 1))
    =~ /1/g]});
  my $extKeyUse = pack('H*', '04040302').pack('CC',$extKeySpare,$extKeyBits);
  $extKeyUse = $keyUsage . $boolTRUE. $extKeyUse;
  $extKeyUse = pack('C',0x30).DERLength(length($extKeyUse)).$extKeyUse;
  my $extXKeyUse = '';
  if ($server || $client || $codesign || $email || $applecodesign) {
    $extXKeyUse .= $serverAuth if $server;
    $extXKeyUse .= $clientAuth if $client;
    $extXKeyUse .= $codeSigning if $codesign;
    $extXKeyUse .= $emailProtection if $email;
    $extXKeyUse .= $appleCodeSigning if $applecodesign;
    $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
    $extXKeyUse = pack('C',0x04).DERLength(length($extXKeyUse)).$extXKeyUse;
    $extXKeyUse = $extKeyUsage . $boolTRUE . $extXKeyUse;
    $extXKeyUse = pack('C',0x30).DERLength(length($extXKeyUse)).$extXKeyUse;
  }
  my $extSubjKey = pack('C',0x04).DERLength(length($sshkeyid)).$sshkeyid;
  $extSubjKey = pack('C',0x04).DERLength(length($extSubjKey)).$extSubjKey;
  $extSubjKey = $subjKeyId . $extSubjKey;
  $extSubjKey = pack('C',0x30).DERLength(length($extSubjKey)).$extSubjKey;
  my $extAuthKey = '';
  if (!($request || $root) || $rootauth) {
    $extAuthKey = pack('C',0x80).DERLength(length($pubkeyid)).$pubkeyid;
    if (!($request || $root) && $authext) {
      my $gen = pack('C',0xA4).DERLength(length($issuer)).$issuer;
      $extAuthKey .= pack('C',0xA1).DERLength(length($gen)).$gen;
      $extAuthKey .= pack('C',0x82).DERLength(length($cser)).$cser;
    }
    $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
    $extAuthKey = pack('C',0x04).DERLength(length($extAuthKey)).$extAuthKey;
    $extAuthKey = $authKeyId . $extAuthKey;
    $extAuthKey = pack('C',0x30).DERLength(length($extAuthKey)).$extAuthKey;
  }
  my $exts = $extCAVal . $extKeyUse . $extXKeyUse . $extSubjKey . $extAuthKey;
  if ($email || ($server && @serverAltNames)) {
    my $extSubjAlt;
    if ($email) {
      $extSubjAlt = MakeUTF8($ARGV[0]);
      $extSubjAlt = pack('C',0x81).DERLength(length($extSubjAlt)).$extSubjAlt;
    } else {
      $extSubjAlt = '';
      foreach my $alt (@serverAltNames) {
        $extSubjAlt .= pack('C',$$alt[0]).DERLength(length($$alt[1])).$$alt[1];
      }
    }
    $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
    $extSubjAlt = pack('C',0x04).DERLength(length($extSubjAlt)).$extSubjAlt;
    $extSubjAlt = $subjAltName . $extSubjAlt; # not crit unless empty DN
    $extSubjAlt = pack('C',0x30).DERLength(length($extSubjAlt)).$extSubjAlt;
    $exts .= $extSubjAlt;
  }
  $exts = pack('C',0x30).DERLength(length($exts)).$exts;
  my $serial;
  my $tbsSigAlg = $sigAlg;
  if ($request) {
    $serial = $tbsSigAlg = $subj = $validity = '';
    if ($noext) {
      $exts = '';
    } else {
      $exts = $csrExtReq . pack('C',0x31).DERLength(length($exts)).$exts;
      $exts = pack('C',0x30).DERLength(length($exts)).$exts;
    }
    # possibly add $csrPwCheck attribute at some point here
    $exts = pack('C',0xA0).DERLength(length($exts)).$exts;
  } else {
    $exts = pack('C',0xA3).DERLength(length($exts)).$exts;
    if ($useRandom) {
      $serial = pack('C',0x2).DERLength(length($randval)).$randval;
    }
    else {
      my $idtohash = $version.$sigAlg.$subj.$validity.$name.$opensshpub.$exts;
      $idtohash = pack('C',0x30).DERLength(length($idtohash)).$idtohash;
      my $idhash = sha1($idtohash);
      my $byte0 = unpack('C',substr($idhash,0,1));
      $byte0 &= 0x7F;
      substr($idhash,0,1) = pack('C',$byte0);
      $serial = pack('C',0x2).DERLength(length($idhash)).$idhash;
    }
  }
  my $tbs = $version.$serial.$tbsSigAlg.$subj.$validity.$name.$opensshpub.$exts;
  $tbs = pack('C',0x30).DERLength(length($tbs)).$tbs;
  my $tbsseq = &$dfunc($tbs);
  $tbsseq = pack('C',0x04).DERLength(length($tbsseq)).$tbsseq;
  my $algid = $did . pack('CC',0x05,0x00);
  $algid = pack('C',0x30).DERLength(length($algid)).$algid;
  $tbsseq = $algid . $tbsseq;
  $tbsseq = pack('C',0x30).DERLength(length($tbsseq)).$tbsseq;
  my $sig = RSASign($tbsseq, $keyfile);
  $sig = pack('C',0x03).DERLength(length($sig)+1).pack('C',0x00).$sig;
  my $cert = $tbs . $sigAlg . $sig;
  $cert = pack('C',0x30).DERLength(length($cert)).$cert;
  my $base64 = join("\n", BreakLine(encode_base64($cert, ''), 64))."\n";
  my $output;
  if ($outfile ne '-') {
    open($output, ">", $outfile)
      or die "Cannot open \"$outfile\" for output: $!\n";
  } else {
    $output = *STDOUT;
  }
  my $r = $request ? " REQUEST" : "";
  print $output "-----BEGIN CERTIFICATE$r-----\n",
                $base64,
                "-----END CERTIFICATE$r-----\n",
                $suffix;
  close($output) if $outfile ne '-';
  return 0;
}