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