1#!/usr/local/bin/perl 2# Copyright 2000-2025 The OpenSSL Project Authors. All Rights Reserved. 3# 4# Licensed under the Apache License 2.0 (the "License"). You may not use 5# this file except in compliance with the License. You can obtain a copy 6# in the file LICENSE in the source distribution or at 7# https://www.openssl.org/source/license.html 8 9# 10# Wrapper around the ca to make it easier to use 11# 12# WARNING: do not edit! 13# Generated by Makefile from apps/CA.pl.in 14 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 = "./demoCA"; 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 years 43my @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 parsing 51my %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 whitespace 62 $val =~ m{\A[ \t]*}ogc; 63 64 # Unix shell-compatible split 65 # 66 # Handles backslash escapes outside quotes and 67 # in double-quoted strings. Parameter and 68 # 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 fragment 76 # 2. Single-quoted string 77 # 3. Double-quoted string 78 # 4. Backslash escape 79 # 5. Bare backlash or newline (rejected) 80 # 81 if ($val =~ m{\G([^'" \t\n\\]+)}ogc) { 82 # Ordinary string 83 push @frag, $1; 84 } elsif ($val =~ m{\G'([^']*)'}ogc) { 85 # Single-quoted string 86 push @frag, $1; 87 } elsif ($val =~ m{\G"}ogc) { 88 # Double-quoted string 89 push @frag, ""; 90 while (1) { 91 last if ($val =~ m{\G"}ogc); 92 if ($val =~ m{\G([^"\\]+)}ogcs) { 93 # literals 94 push @frag, $1; 95 } elsif ($val =~ m{\G.(["\`\$\\])}ogc) { 96 # backslash-escaped special 97 push @frag, $1; 98 } elsif ($val =~ m{\G.(.)}ogcs) { 99 # backslashed non-special 100 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 strings 107 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 fragment 112 # 113 next unless ($val =~ m{\G(?:[ \t]+|\z)}ogcs); 114 push @ret, join("", splice(@frag)) if (@frag > 0); 115 } 116 # Handle final fragment 117 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 whitespace 126 $val =~ m{\A[ \t]*}ogc; 127 128 # Windows-compatible split 129 # See: "Parsing C++ command-line arguments" in: 130 # https://learn.microsoft.com/en-us/cpp/cpp/main-function-command-line-args?view=msvc-170 131 # 132 # Backslashes are special only when followed by a double-quote 133 # 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 fragment 141 # 2. Double-quoted string 142 # 3. Backslashes preceding a double-quote 143 # 4. Literal backslashes 144 # 5. Bare newline (rejected) 145 # 146 if ($val =~ m{\G([^" \t\n\\]+)}ogc) { 147 # Ordinary string 148 push @frag, $1; 149 } elsif ($val =~ m{\G"}ogc) { 150 # Double-quoted string 151 push @frag, ""; 152 while (1) { 153 if ($val =~ m{\G("+)}ogc) { 154 # Two double-quotes make one literal double-quote 155 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 escapes 164 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 special 172 push @frag, $1; 173 } else { 174 # Tolerate missing closing double-quote 175 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 special 187 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 fragment 192 # 193 next unless ($val =~ m{\G(?:[ \t]+|\z)}ogcs); 194 push @ret, join("", splice(@frag)) if (@frag > 0); 195 } 196 # Handle final fragment 197 push @ret, join("", splice(@frag)) if (@frag); 198 return @ret; 199} 200 201# Split out "-extra-CMD value", and return new |@ARGV|. Fill in 202# |EXTRA{CMD}| with list of values. 203sub parse_extra 204{ 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_ok 228{ 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_pemfile 246{ 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 status 263sub run 264{ 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] 280EOF 281 exit 0; 282} 283 284if ($WHAT eq '-newcert' ) { 285 # create a certificate 286 $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-certificate 290 $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 request 294 $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 hierarchy 298 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 certificate 318 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