codekingpro/portable-devtools
114k
1#!/usr/bin/env perl2# Copyright 2000-2025 The OpenSSL Project Authors. All Rights Reserved.3#4# Licensed under the Apache License 2.0 (the "License"). You may not use5# this file except in compliance with the License. You can obtain a copy6# in the file LICENSE in the source distribution or at7# https://www.openssl.org/source/license.html8 9#10# Wrapper around the ca to make it easier to use11#12# WARNING: do not edit!13# Generated by Makefile from apps/CA.pl.in14 15use strict;16use warnings;17 18my $verbose = 1;19my @OPENSSL_CMDS = ("req", "ca", "pkcs12", "x509", "verify");20 21my $openssl = $ENV{'OPENSSL'} // "openssl";22$ENV{'OPENSSL'} = $openssl;23my @openssl = split_val($openssl);24 25my $OPENSSL_CONFIG = $ENV{"OPENSSL_CONFIG"} // "";26my @OPENSSL_CONFIG = split_val($OPENSSL_CONFIG);27 28# Command invocations.29my @REQ = (@openssl, "req", @OPENSSL_CONFIG);30my @CA = (@openssl, "ca", @OPENSSL_CONFIG);31my @VERIFY = (@openssl, "verify");32my @X509 = (@openssl, "x509");33my @PKCS12 = (@openssl, "pkcs12");34 35# Default values for various configuration settings.36my $CATOP = "/usr/ssl";37my $CAKEY = "cakey.pem";38my $CAREQ = "careq.pem";39my $CACERT = "cacert.pem";40my $CACRL = "crl.pem";41my @DAYS = qw(-days 365);42my @CADAYS = qw(-days 1095); # 3 years43my @EXTENSIONS = qw(-extensions v3_ca);44my @POLICY = qw(-policy policy_anything);45my $NEWKEY = "newkey.pem";46my $NEWREQ = "newreq.pem";47my $NEWCERT = "newcert.pem";48my $NEWP12 = "newcert.p12";49 50# Commandline parsing51my %EXTRA;52my $WHAT = shift @ARGV // "";53@ARGV = parse_extra(@ARGV);54my $RET = 0;55 56sub split_val {57 return split_val_win32(@_) if ($^O eq 'MSWin32');58 my ($val) = @_;59 my (@ret, @frag);60 61 # Skip leading whitespace62 $val =~ m{\A[ \t]*}ogc;63 64 # Unix shell-compatible split65 #66 # Handles backslash escapes outside quotes and67 # in double-quoted strings. Parameter and68 # command-substitution is silently ignored.69 # Bare newlines outside quotes and (trailing) backslashes are disallowed.70 71 while (1) {72 last if (pos($val) == length($val));73 74 # The first char is never a SPACE or TAB. Possible matches are:75 # 1. Ordinary string fragment76 # 2. Single-quoted string77 # 3. Double-quoted string78 # 4. Backslash escape79 # 5. Bare backlash or newline (rejected)80 #81 if ($val =~ m{\G([^'" \t\n\\]+)}ogc) {82 # Ordinary string83 push @frag, $1;84 } elsif ($val =~ m{\G'([^']*)'}ogc) {85 # Single-quoted string86 push @frag, $1;87 } elsif ($val =~ m{\G"}ogc) {88 # Double-quoted string89 push @frag, "";90 while (1) {91 last if ($val =~ m{\G"}ogc);92 if ($val =~ m{\G([^"\\]+)}ogcs) {93 # literals94 push @frag, $1;95 } elsif ($val =~ m{\G.(["\`\$\\])}ogc) {96 # backslash-escaped special97 push @frag, $1;98 } elsif ($val =~ m{\G.(.)}ogcs) {99 # backslashed non-special100 push @frag, "\\$1" unless $1 eq "\n";101 } else {102 die sprintf("Malformed quoted string: %s\n", $val);103 }104 }105 } elsif ($val =~ m{\G\\(.)}ogc) {106 # Backslash is unconditional escape outside quoted strings107 push @frag, $1 unless $1 eq "\n";108 } else {109 die sprintf("Bare backslash or newline in: '%s'\n", $val);110 }111 # Done if at SPACE, TAB or end, otherwise continue current fragment112 #113 next unless ($val =~ m{\G(?:[ \t]+|\z)}ogcs);114 push @ret, join("", splice(@frag)) if (@frag > 0);115 }116 # Handle final fragment117 push @ret, join("", splice(@frag)) if (@frag > 0);118 return @ret;119}120 121sub split_val_win32 {122 my ($val) = @_;123 my (@ret, @frag);124 125 # Skip leading whitespace126 $val =~ m{\A[ \t]*}ogc;127 128 # Windows-compatible split129 # See: "Parsing C++ command-line arguments" in:130 # https://learn.microsoft.com/en-us/cpp/cpp/main-function-command-line-args?view=msvc-170131 #132 # Backslashes are special only when followed by a double-quote133 # Pairs of double-quotes make a single double-quote.134 # Closing double-quotes may be omitted.135 136 while (1) {137 last if (pos($val) == length($val));138 139 # The first char is never a SPACE or TAB.140 # 1. Ordinary string fragment141 # 2. Double-quoted string142 # 3. Backslashes preceding a double-quote143 # 4. Literal backslashes144 # 5. Bare newline (rejected)145 #146 if ($val =~ m{\G([^" \t\n\\]+)}ogc) {147 # Ordinary string148 push @frag, $1;149 } elsif ($val =~ m{\G"}ogc) {150 # Double-quoted string151 push @frag, "";152 while (1) {153 if ($val =~ m{\G("+)}ogc) {154 # Two double-quotes make one literal double-quote155 my $l = length($1);156 push @frag, q{"} x int($l/2) if ($l > 1);157 next if ($l % 2 == 0);158 last;159 }160 if ($val =~ m{\G([^"\\]+)}ogc) {161 push @frag, $1;162 } elsif ($val =~ m{\G((?>[\\]+))(?=")}ogc) {163 # Backslashes before a double-quote are escapes164 my $l = length($1);165 push @frag, q{\\} x int($l / 2);166 if ($l % 2 == 1) {167 ++pos($val);168 push @frag, q{"};169 }170 } elsif ($val =~ m{\G((?:(?>[\\]+)[^"\\]+)+)}ogc) {171 # Backslashes not before a double-quote are not special172 push @frag, $1;173 } else {174 # Tolerate missing closing double-quote175 last;176 }177 }178 } elsif ($val =~ m{\G((?>[\\]+))(?=")}ogc) {179 my $l = length($1);180 push @frag, q{\\} x int($l / 2);181 if ($l % 2 == 1) {182 ++pos($val);183 push @frag, q{"};184 }185 } elsif ($val =~ m{\G([\\]+)}ogc) {186 # Backslashes not before a double-quote are not special187 push @frag, $1;188 } else {189 die sprintf("Bare newline in: '%s'\n", $val);190 }191 # Done if at SPACE, TAB or end, otherwise continue current fragment192 #193 next unless ($val =~ m{\G(?:[ \t]+|\z)}ogcs);194 push @ret, join("", splice(@frag)) if (@frag > 0);195 }196 # Handle final fragment197 push @ret, join("", splice(@frag)) if (@frag);198 return @ret;199}200 201# Split out "-extra-CMD value", and return new |@ARGV|. Fill in202# |EXTRA{CMD}| with list of values.203sub parse_extra204{205 my @args;206 foreach ( @OPENSSL_CMDS ) {207 $EXTRA{$_} = [];208 }209 while (@_) {210 my $arg = shift(@_);211 if ( $arg !~ m{^-extra-(\w+)$} ) {212 push @args, split_val($arg);213 next;214 }215 $arg = $1;216 die "Unknown \"-extra-${arg}\" option, exiting\n"217 unless grep { $arg eq $_ } @OPENSSL_CMDS;218 die "Missing \"-extra-${arg}\" option value, exiting\n"219 unless (@_ > 0);220 push @{$EXTRA{$arg}}, split_val(shift(@_));221 }222 return @args;223}224 225 226# See if reason for a CRL entry is valid; exit if not.227sub crl_reason_ok228{229 my $r = shift;230 231 if ($r eq 'unspecified' || $r eq 'keyCompromise'232 || $r eq 'CACompromise' || $r eq 'affiliationChanged'233 || $r eq 'superseded' || $r eq 'cessationOfOperation'234 || $r eq 'certificateHold' || $r eq 'removeFromCRL') {235 return 1;236 }237 print STDERR "Invalid CRL reason; must be one of:\n";238 print STDERR " unspecified, keyCompromise, CACompromise,\n";239 print STDERR " affiliationChanged, superseded, cessationOfOperation\n";240 print STDERR " certificateHold, removeFromCRL";241 exit 1;242}243 244# Copy a PEM-format file; return like exit status (zero means ok)245sub copy_pemfile246{247 my ($infile, $outfile, $bound) = @_;248 my $found = 0;249 250 open IN, $infile || die "Cannot open $infile, $!";251 open OUT, ">$outfile" || die "Cannot write to $outfile, $!";252 while (<IN>) {253 $found = 1 if /^-----BEGIN.*$bound/;254 print OUT $_ if $found;255 $found = 2, last if /^-----END.*$bound/;256 }257 close IN;258 close OUT;259 return $found == 2 ? 0 : 1;260}261 262# Wrapper around system; useful for debugging. Returns just the exit status263sub run264{265 my ($cmd, @args) = @_;266 print "====\n$cmd @args\n" if $verbose;267 my $status = system {$cmd} $cmd, @args;268 print "==> $status\n====\n" if $verbose;269 return $status >> 8;270}271 272 273if ( $WHAT =~ /^(-\?|-h|-help)$/ ) {274 print STDERR <<EOF;275Usage:276 CA.pl -newcert | -newreq | -newreq-nodes | -xsign | -sign | -signCA | -signcert | -crl | -newca [-extra-cmd parameter]277 CA.pl -pkcs12 [certname]278 CA.pl -verify certfile ...279 CA.pl -revoke certfile [reason]280EOF281 exit 0;282}283 284if ($WHAT eq '-newcert' ) {285 # create a certificate286 $RET = run(@REQ, qw(-new -x509 -keyout), $NEWKEY, "-out", $NEWCERT, @DAYS, @{$EXTRA{req}});287 print "Cert is in $NEWCERT, private key is in $NEWKEY\n" if $RET == 0;288} elsif ($WHAT eq '-precert' ) {289 # create a pre-certificate290 $RET = run(@REQ, qw(-x509 -precert -keyout), $NEWKEY, "-out", $NEWCERT, @DAYS, @{$EXTRA{req}});291 print "Pre-cert is in $NEWCERT, private key is in $NEWKEY\n" if $RET == 0;292} elsif ($WHAT =~ /^\-newreq(\-nodes)?$/ ) {293 # create a certificate request294 $RET = run(@REQ, "-new", (defined $1 ? ($1,) : ()), "-keyout", $NEWKEY, "-out", $NEWREQ, @{$EXTRA{req}});295 print "Request is in $NEWREQ, private key is in $NEWKEY\n" if $RET == 0;296} elsif ($WHAT eq '-newca' ) {297 # create the directory hierarchy298 my @dirs = ( "${CATOP}", "${CATOP}/certs", "${CATOP}/crl",299 "${CATOP}/newcerts", "${CATOP}/private" );300 die "${CATOP}/index.txt exists.\nRemove old sub-tree to proceed,"301 if -f "${CATOP}/index.txt";302 die "${CATOP}/serial exists.\nRemove old sub-tree to proceed,"303 if -f "${CATOP}/serial";304 foreach my $d ( @dirs ) {305 if ( -d $d ) {306 warn "Directory $d exists" if -d $d;307 } else {308 mkdir $d or die "Can't mkdir $d, $!";309 }310 }311 312 open OUT, ">${CATOP}/index.txt";313 close OUT;314 open OUT, ">${CATOP}/crlnumber";315 print OUT "01\n";316 close OUT;317 # ask user for existing CA certificate318 print "CA certificate filename (or enter to create)\n";319 my $FILE;320 $FILE = "" unless defined($FILE = <STDIN>);321 $FILE =~ s{\R$}{};322 if ($FILE ne "") {323 copy_pemfile($FILE,"${CATOP}/private/$CAKEY", "PRIVATE");324 copy_pemfile($FILE,"${CATOP}/$CACERT", "CERTIFICATE");325 } else {326 print "Making CA certificate ...\n";327 $RET = run(@REQ, qw(-new -keyout), "${CATOP}/private/$CAKEY",328 "-out", "${CATOP}/$CAREQ", @{$EXTRA{req}});329 $RET = run(@CA, qw(-create_serial -out), "${CATOP}/$CACERT", @CADAYS,330 qw(-batch -keyfile), "${CATOP}/private/$CAKEY", "-selfsign",331 @EXTENSIONS, "-infiles", "${CATOP}/$CAREQ", @{$EXTRA{ca}})332 if $RET == 0;333 print "CA certificate is in ${CATOP}/$CACERT\n" if $RET == 0;334 }335} elsif ($WHAT eq '-pkcs12' ) {336 my $cname = $ARGV[0];337 $cname = "My Certificate" unless defined $cname;338 $RET = run(@PKCS12, "-in", $NEWCERT, "-inkey", $NEWKEY,339 "-certfile", "${CATOP}/$CACERT", "-out", $NEWP12,340 qw(-export -name), $cname, @{$EXTRA{pkcs12}});341 print "PKCS#12 file is in $NEWP12\n" if $RET == 0;342} elsif ($WHAT eq '-xsign' ) {343 $RET = run(@CA, @POLICY, "-infiles", $NEWREQ, @{$EXTRA{ca}});344} elsif ($WHAT eq '-sign' ) {345 $RET = run(@CA, @POLICY, "-out", $NEWCERT,346 "-infiles", $NEWREQ, @{$EXTRA{ca}});347 print "Signed certificate is in $NEWCERT\n" if $RET == 0;348} elsif ($WHAT eq '-signCA' ) {349 $RET = run(@CA, @POLICY, "-out", $NEWCERT, @EXTENSIONS,350 "-infiles", $NEWREQ, @{$EXTRA{ca}});351 print "Signed CA certificate is in $NEWCERT\n" if $RET == 0;352} elsif ($WHAT eq '-signcert' ) {353 $RET = run(@X509, qw(-x509toreq -in), $NEWREQ, "-signkey", $NEWREQ,354 qw(-out tmp.pem), @{$EXTRA{x509}});355 $RET = run(@CA, @POLICY, "-out", $NEWCERT,356 qw(-infiles tmp.pem), @{$EXTRA{ca}}) if $RET == 0;357 print "Signed certificate is in $NEWCERT\n" if $RET == 0;358} elsif ($WHAT eq '-verify' ) {359 my @files = @ARGV ? @ARGV : ( $NEWCERT );360 foreach my $file (@files) {361 my $status = run(@VERIFY, "-CAfile", "${CATOP}/$CACERT", $file, @{$EXTRA{verify}});362 $RET = $status if $status != 0;363 }364} elsif ($WHAT eq '-crl' ) {365 $RET = run(@CA, qw(-gencrl -out), "${CATOP}/crl/$CACRL", @{$EXTRA{ca}});366 print "Generated CRL is in ${CATOP}/crl/$CACRL\n" if $RET == 0;367} elsif ($WHAT eq '-revoke' ) {368 my $cname = $ARGV[0];369 if (!defined $cname) {370 print "Certificate filename is required; reason optional.\n";371 exit 1;372 }373 my @reason;374 @reason = ("-crl_reason", $ARGV[1])375 if defined $ARGV[1] && crl_reason_ok($ARGV[1]);376 $RET = run(@CA, "-revoke", $cname, @reason, @{$EXTRA{ca}});377} else {378 print STDERR "Unknown arg \"$WHAT\"\n";379 print STDERR "Use -help for help.\n";380 exit 1;381}382 383exit $RET;384