xf.li | 6c8fc1e | 2023-08-12 00:11:09 -0700 | [diff] [blame] | 1 | #!/usr/bin/env perl |
| 2 | # *************************************************************************** |
| 3 | # * _ _ ____ _ |
| 4 | # * Project ___| | | | _ \| | |
| 5 | # * / __| | | | |_) | | |
| 6 | # * | (__| |_| | _ <| |___ |
| 7 | # * \___|\___/|_| \_\_____| |
| 8 | # * |
| 9 | # * Copyright (C) 1998 - 2022, Daniel Stenberg, <daniel@haxx.se>, et al. |
| 10 | # * |
| 11 | # * This software is licensed as described in the file COPYING, which |
| 12 | # * you should have received as part of this distribution. The terms |
| 13 | # * are also available at https://curl.se/docs/copyright.html. |
| 14 | # * |
| 15 | # * You may opt to use, copy, modify, merge, publish, distribute and/or sell |
| 16 | # * copies of the Software, and permit persons to whom the Software is |
| 17 | # * furnished to do so, under the terms of the COPYING file. |
| 18 | # * |
| 19 | # * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY |
| 20 | # * KIND, either express or implied. |
| 21 | # * |
| 22 | # * SPDX-License-Identifier: curl |
| 23 | # * |
| 24 | # *************************************************************************** |
| 25 | # This Perl script creates a fresh ca-bundle.crt file for use with libcurl. |
| 26 | # It downloads certdata.txt from Mozilla's source tree (see URL below), |
| 27 | # then parses certdata.txt and extracts CA Root Certificates into PEM format. |
| 28 | # These are then processed with the OpenSSL commandline tool to produce the |
| 29 | # final ca-bundle.crt file. |
| 30 | # The script is based on the parse-certs script written by Roland Krikava. |
| 31 | # This Perl script works on almost any platform since its only external |
| 32 | # dependency is the OpenSSL commandline tool for optional text listing. |
| 33 | # Hacked by Guenter Knauf. |
| 34 | # |
| 35 | use Encode; |
| 36 | use Getopt::Std; |
| 37 | use MIME::Base64; |
| 38 | use strict; |
| 39 | use warnings; |
| 40 | use vars qw($opt_b $opt_d $opt_f $opt_h $opt_i $opt_k $opt_l $opt_m $opt_n $opt_p $opt_q $opt_s $opt_t $opt_u $opt_v $opt_w); |
| 41 | use List::Util; |
| 42 | use Text::Wrap; |
| 43 | use Time::Local; |
| 44 | my $MOD_SHA = "Digest::SHA"; |
| 45 | eval "require $MOD_SHA"; |
| 46 | if ($@) { |
| 47 | $MOD_SHA = "Digest::SHA::PurePerl"; |
| 48 | eval "require $MOD_SHA"; |
| 49 | } |
| 50 | eval "require LWP::UserAgent"; |
| 51 | |
| 52 | my %urls = ( |
| 53 | 'nss' => |
| 54 | 'https://hg.mozilla.org/projects/nss/raw-file/default/lib/ckfw/builtins/certdata.txt', |
| 55 | 'central' => |
| 56 | 'https://hg.mozilla.org/mozilla-central/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', |
| 57 | 'beta' => |
| 58 | 'https://hg.mozilla.org/releases/mozilla-beta/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', |
| 59 | 'release' => |
| 60 | 'https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', |
| 61 | ); |
| 62 | |
| 63 | $opt_d = 'release'; |
| 64 | |
| 65 | # If the OpenSSL commandline is not in search path you can configure it here! |
| 66 | my $openssl = 'openssl'; |
| 67 | |
| 68 | my $version = '1.29'; |
| 69 | |
| 70 | $opt_w = 76; # default base64 encoded lines length |
| 71 | |
| 72 | # default cert types to include in the output (default is to include CAs which |
| 73 | # may issue SSL server certs) |
| 74 | my $default_mozilla_trust_purposes = "SERVER_AUTH"; |
| 75 | my $default_mozilla_trust_levels = "TRUSTED_DELEGATOR"; |
| 76 | $opt_p = $default_mozilla_trust_purposes . ":" . $default_mozilla_trust_levels; |
| 77 | |
| 78 | my @valid_mozilla_trust_purposes = ( |
| 79 | "DIGITAL_SIGNATURE", |
| 80 | "NON_REPUDIATION", |
| 81 | "KEY_ENCIPHERMENT", |
| 82 | "DATA_ENCIPHERMENT", |
| 83 | "KEY_AGREEMENT", |
| 84 | "KEY_CERT_SIGN", |
| 85 | "CRL_SIGN", |
| 86 | "SERVER_AUTH", |
| 87 | "CLIENT_AUTH", |
| 88 | "CODE_SIGNING", |
| 89 | "EMAIL_PROTECTION", |
| 90 | "IPSEC_END_SYSTEM", |
| 91 | "IPSEC_TUNNEL", |
| 92 | "IPSEC_USER", |
| 93 | "TIME_STAMPING", |
| 94 | "STEP_UP_APPROVED" |
| 95 | ); |
| 96 | |
| 97 | my @valid_mozilla_trust_levels = ( |
| 98 | "TRUSTED_DELEGATOR", # CAs |
| 99 | "NOT_TRUSTED", # Don't trust these certs. |
| 100 | "MUST_VERIFY_TRUST", # This explicitly tells us that it ISN'T a CA but is |
| 101 | # otherwise ok. In other words, this should tell the |
| 102 | # app to ignore any other sources that claim this is |
| 103 | # a CA. |
| 104 | "TRUSTED" # This cert is trusted, but only for itself and not |
| 105 | # for delegates (i.e. it is not a CA). |
| 106 | ); |
| 107 | |
| 108 | my $default_signature_algorithms = $opt_s = "MD5"; |
| 109 | |
| 110 | my @valid_signature_algorithms = ( |
| 111 | "MD5", |
| 112 | "SHA1", |
| 113 | "SHA256", |
| 114 | "SHA384", |
| 115 | "SHA512" |
| 116 | ); |
| 117 | |
| 118 | $0 =~ s@.*(/|\\)@@; |
| 119 | $Getopt::Std::STANDARD_HELP_VERSION = 1; |
| 120 | getopts('bd:fhiklmnp:qs:tuvw:'); |
| 121 | |
| 122 | if(!defined($opt_d)) { |
| 123 | # to make plain "-d" use not cause warnings, and actually still work |
| 124 | $opt_d = 'release'; |
| 125 | } |
| 126 | |
| 127 | # Use predefined URL or else custom URL specified on command line. |
| 128 | my $url; |
| 129 | if(defined($urls{$opt_d})) { |
| 130 | $url = $urls{$opt_d}; |
| 131 | if(!$opt_k && $url !~ /^https:\/\//i) { |
| 132 | die "The URL for '$opt_d' is not HTTPS. Use -k to override (insecure).\n"; |
| 133 | } |
| 134 | } |
| 135 | else { |
| 136 | $url = $opt_d; |
| 137 | } |
| 138 | |
| 139 | my $curl = `curl -V`; |
| 140 | |
| 141 | if ($opt_i) { |
| 142 | print ("=" x 78 . "\n"); |
| 143 | print "Script Version : $version\n"; |
| 144 | print "Perl Version : $]\n"; |
| 145 | print "Operating System Name : $^O\n"; |
| 146 | print "Getopt::Std.pm Version : ${Getopt::Std::VERSION}\n"; |
| 147 | print "Encode::Encoding.pm Version : ${Encode::Encoding::VERSION}\n"; |
| 148 | print "MIME::Base64.pm Version : ${MIME::Base64::VERSION}\n"; |
| 149 | print "LWP::UserAgent.pm Version : ${LWP::UserAgent::VERSION}\n" if($LWP::UserAgent::VERSION); |
| 150 | print "LWP.pm Version : ${LWP::VERSION}\n" if($LWP::VERSION); |
| 151 | print "Digest::SHA.pm Version : ${Digest::SHA::VERSION}\n" if ($Digest::SHA::VERSION); |
| 152 | print "Digest::SHA::PurePerl.pm Version : ${Digest::SHA::PurePerl::VERSION}\n" if ($Digest::SHA::PurePerl::VERSION); |
| 153 | print ("=" x 78 . "\n"); |
| 154 | } |
| 155 | |
| 156 | sub warning_message() { |
| 157 | if ( $opt_d =~ m/^risk$/i ) { # Long Form Warning and Exit |
| 158 | print "Warning: Use of this script may pose some risk:\n"; |
| 159 | print "\n"; |
| 160 | print " 1) If you use HTTP URLs they are subject to a man in the middle attack\n"; |
| 161 | print " 2) Default to 'release', but more recent updates may be found in other trees\n"; |
| 162 | print " 3) certdata.txt file format may change, lag time to update this script\n"; |
| 163 | print " 4) Generally unwise to blindly trust CAs without manual review & verification\n"; |
| 164 | print " 5) Mozilla apps use additional security checks aren't represented in certdata\n"; |
| 165 | print " 6) Use of this script will make a security engineer grind his teeth and\n"; |
| 166 | print " swear at you. ;)\n"; |
| 167 | exit; |
| 168 | } else { # Short Form Warning |
| 169 | print "Warning: Use of this script may pose some risk, -d risk for more details.\n"; |
| 170 | } |
| 171 | } |
| 172 | |
| 173 | sub HELP_MESSAGE() { |
| 174 | print "Usage:\t${0} [-b] [-d<certdata>] [-f] [-i] [-k] [-l] [-n] [-p<purposes:levels>] [-q] [-s<algorithms>] [-t] [-u] [-v] [-w<l>] [<outputfile>]\n"; |
| 175 | print "\t-b\tbackup an existing version of ca-bundle.crt\n"; |
| 176 | print "\t-d\tspecify Mozilla tree to pull certdata.txt or custom URL\n"; |
| 177 | print "\t\t Valid names are:\n"; |
| 178 | print "\t\t ", join( ", ", map { ( $_ =~ m/$opt_d/ ) ? "$_ (default)" : "$_" } sort keys %urls ), "\n"; |
| 179 | print "\t-f\tforce rebuild even if certdata.txt is current\n"; |
| 180 | print "\t-i\tprint version info about used modules\n"; |
| 181 | print "\t-k\tallow URLs other than HTTPS, enable HTTP fallback (insecure)\n"; |
| 182 | print "\t-l\tprint license info about certdata.txt\n"; |
| 183 | print "\t-m\tinclude meta data in output\n"; |
| 184 | print "\t-n\tno download of certdata.txt (to use existing)\n"; |
| 185 | print wrap("\t","\t\t", "-p\tlist of Mozilla trust purposes and levels for certificates to include in output. Takes the form of a comma separated list of purposes, a colon, and a comma separated list of levels. (default: $default_mozilla_trust_purposes:$default_mozilla_trust_levels)"), "\n"; |
| 186 | print "\t\t Valid purposes are:\n"; |
| 187 | print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_purposes ) ), "\n"; |
| 188 | print "\t\t Valid levels are:\n"; |
| 189 | print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_levels ) ), "\n"; |
| 190 | print "\t-q\tbe really quiet (no progress output at all)\n"; |
| 191 | print wrap("\t","\t\t", "-s\tcomma separated list of certificate signatures/hashes to output in plain text mode. (default: $default_signature_algorithms)\n"); |
| 192 | print "\t\t Valid signature algorithms are:\n"; |
| 193 | print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_signature_algorithms ) ), "\n"; |
| 194 | print "\t-t\tinclude plain text listing of certificates\n"; |
| 195 | print "\t-u\tunlink (remove) certdata.txt after processing\n"; |
| 196 | print "\t-v\tbe verbose and print out processed CAs\n"; |
| 197 | print "\t-w <l>\twrap base64 output lines after <l> chars (default: ${opt_w})\n"; |
| 198 | exit; |
| 199 | } |
| 200 | |
| 201 | sub VERSION_MESSAGE() { |
| 202 | print "${0} version ${version} running Perl ${]} on ${^O}\n"; |
| 203 | } |
| 204 | |
| 205 | warning_message() unless ($opt_q || $url =~ m/^(ht|f)tps:/i ); |
| 206 | HELP_MESSAGE() if ($opt_h); |
| 207 | |
| 208 | sub report($@) { |
| 209 | my $output = shift; |
| 210 | |
| 211 | print STDERR $output . "\n" unless $opt_q; |
| 212 | } |
| 213 | |
| 214 | sub is_in_list($@) { |
| 215 | my $target = shift; |
| 216 | |
| 217 | return defined(List::Util::first { $target eq $_ } @_); |
| 218 | } |
| 219 | |
| 220 | # Parses $param_string as a case insensitive comma separated list with optional |
| 221 | # whitespace validates that only allowed parameters are supplied |
| 222 | sub parse_csv_param($$@) { |
| 223 | my $description = shift; |
| 224 | my $param_string = shift; |
| 225 | my @valid_values = @_; |
| 226 | |
| 227 | my @values = map { |
| 228 | s/^\s+//; # strip leading spaces |
| 229 | s/\s+$//; # strip trailing spaces |
| 230 | uc $_ # return the modified string as upper case |
| 231 | } split( ',', $param_string ); |
| 232 | |
| 233 | # Find all values which are not in the list of valid values or "ALL" |
| 234 | my @invalid = grep { !is_in_list($_,"ALL",@valid_values) } @values; |
| 235 | |
| 236 | if ( scalar(@invalid) > 0 ) { |
| 237 | # Tell the user which parameters were invalid and print the standard help |
| 238 | # message which will exit |
| 239 | print "Error: Invalid ", $description, scalar(@invalid) == 1 ? ": " : "s: ", join( ", ", map { "\"$_\"" } @invalid ), "\n"; |
| 240 | HELP_MESSAGE(); |
| 241 | } |
| 242 | |
| 243 | @values = @valid_values if ( is_in_list("ALL",@values) ); |
| 244 | |
| 245 | return @values; |
| 246 | } |
| 247 | |
| 248 | sub sha256 { |
| 249 | my $result; |
| 250 | if ($Digest::SHA::VERSION || $Digest::SHA::PurePerl::VERSION) { |
| 251 | open(FILE, $_[0]) or die "Can't open '$_[0]': $!"; |
| 252 | binmode(FILE); |
| 253 | $result = $MOD_SHA->new(256)->addfile(*FILE)->hexdigest; |
| 254 | close(FILE); |
| 255 | } else { |
| 256 | # Use OpenSSL command if Perl Digest::SHA modules not available |
| 257 | $result = `"$openssl" dgst -r -sha256 "$_[0]"`; |
| 258 | $result =~ s/^([0-9a-f]{64}) .+/$1/is; |
| 259 | } |
| 260 | return $result; |
| 261 | } |
| 262 | |
| 263 | |
| 264 | sub oldhash { |
| 265 | my $hash = ""; |
| 266 | open(C, "<$_[0]") || return 0; |
| 267 | while(<C>) { |
| 268 | chomp; |
| 269 | if($_ =~ /^\#\# SHA256: (.*)/) { |
| 270 | $hash = $1; |
| 271 | last; |
| 272 | } |
| 273 | } |
| 274 | close(C); |
| 275 | return $hash; |
| 276 | } |
| 277 | |
| 278 | if ( $opt_p !~ m/:/ ) { |
| 279 | print "Error: Mozilla trust identifier list must include both purposes and levels\n"; |
| 280 | HELP_MESSAGE(); |
| 281 | } |
| 282 | |
| 283 | (my $included_mozilla_trust_purposes_string, my $included_mozilla_trust_levels_string) = split( ':', $opt_p ); |
| 284 | my @included_mozilla_trust_purposes = parse_csv_param( "trust purpose", $included_mozilla_trust_purposes_string, @valid_mozilla_trust_purposes ); |
| 285 | my @included_mozilla_trust_levels = parse_csv_param( "trust level", $included_mozilla_trust_levels_string, @valid_mozilla_trust_levels ); |
| 286 | |
| 287 | my @included_signature_algorithms = parse_csv_param( "signature algorithm", $opt_s, @valid_signature_algorithms ); |
| 288 | |
| 289 | sub should_output_cert(%) { |
| 290 | my %trust_purposes_by_level = @_; |
| 291 | |
| 292 | foreach my $level (@included_mozilla_trust_levels) { |
| 293 | # for each level we want to output, see if any of our desired purposes are |
| 294 | # included |
| 295 | return 1 if ( defined( List::Util::first { is_in_list( $_, @included_mozilla_trust_purposes ) } @{$trust_purposes_by_level{$level}} ) ); |
| 296 | } |
| 297 | |
| 298 | return 0; |
| 299 | } |
| 300 | |
| 301 | my $crt = $ARGV[0] || 'ca-bundle.crt'; |
| 302 | (my $txt = $url) =~ s@(.*/|\?.*)@@g; |
| 303 | |
| 304 | my $stdout = $crt eq '-'; |
| 305 | my $resp; |
| 306 | my $fetched; |
| 307 | |
| 308 | my $oldhash = oldhash($crt); |
| 309 | |
| 310 | report "SHA256 of old file: $oldhash"; |
| 311 | |
| 312 | if(!$opt_n) { |
| 313 | report "Downloading $txt ..."; |
| 314 | |
| 315 | # If we have an HTTPS URL then use curl |
| 316 | if($url =~ /^https:\/\//i) { |
| 317 | if($curl) { |
| 318 | if($curl =~ /^Protocols:.* https( |$)/m) { |
| 319 | report "Get certdata with curl!"; |
| 320 | my $proto = !$opt_k ? "--proto =https" : ""; |
| 321 | my $quiet = $opt_q ? "-s" : ""; |
| 322 | my @out = `curl -w %{response_code} $proto $quiet -o "$txt" "$url"`; |
| 323 | if(!$? && @out && $out[0] == 200) { |
| 324 | $fetched = 1; |
| 325 | report "Downloaded $txt"; |
| 326 | } |
| 327 | else { |
| 328 | report "Failed downloading via HTTPS with curl"; |
| 329 | if(-e $txt && !unlink($txt)) { |
| 330 | report "Failed to remove '$txt': $!"; |
| 331 | } |
| 332 | } |
| 333 | } |
| 334 | else { |
| 335 | report "curl lacks https support"; |
| 336 | } |
| 337 | } |
| 338 | else { |
| 339 | report "curl not found"; |
| 340 | } |
| 341 | } |
| 342 | |
| 343 | # If nothing was fetched then use LWP |
| 344 | if(!$fetched) { |
| 345 | if($url =~ /^https:\/\//i) { |
| 346 | report "Falling back to HTTP"; |
| 347 | $url =~ s/^https:\/\//http:\/\//i; |
| 348 | } |
| 349 | if(!$opt_k) { |
| 350 | report "URLs other than HTTPS are disabled by default, to enable use -k"; |
| 351 | exit 1; |
| 352 | } |
| 353 | report "Get certdata with LWP!"; |
| 354 | if(!defined(${LWP::UserAgent::VERSION})) { |
| 355 | report "LWP is not available (LWP::UserAgent not found)"; |
| 356 | exit 1; |
| 357 | } |
| 358 | my $ua = new LWP::UserAgent(agent => "$0/$version"); |
| 359 | $ua->env_proxy(); |
| 360 | $resp = $ua->mirror($url, $txt); |
| 361 | if($resp && $resp->code eq '304') { |
| 362 | report "Not modified"; |
| 363 | exit 0 if -e $crt && !$opt_f; |
| 364 | } |
| 365 | else { |
| 366 | $fetched = 1; |
| 367 | report "Downloaded $txt"; |
| 368 | } |
| 369 | if(!$resp || $resp->code !~ /^(?:200|304)$/) { |
| 370 | report "Unable to download latest data: " |
| 371 | . ($resp? $resp->code . ' - ' . $resp->message : "LWP failed"); |
| 372 | exit 1 if -e $crt || ! -r $txt; |
| 373 | } |
| 374 | } |
| 375 | } |
| 376 | |
| 377 | my $filedate = $resp ? $resp->last_modified : (stat($txt))[9]; |
| 378 | my $datesrc = "as of"; |
| 379 | if(!$filedate) { |
| 380 | # mxr.mozilla.org gave us a time, hg.mozilla.org does not! |
| 381 | $filedate = time(); |
| 382 | $datesrc="downloaded on"; |
| 383 | } |
| 384 | |
| 385 | # get the hash from the download file |
| 386 | my $newhash= sha256($txt); |
| 387 | |
| 388 | if(!$opt_f && $oldhash eq $newhash) { |
| 389 | report "Downloaded file identical to previous run\'s source file. Exiting"; |
| 390 | if($opt_u && -e $txt && !unlink($txt)) { |
| 391 | report "Failed to remove $txt: $!\n"; |
| 392 | } |
| 393 | exit; |
| 394 | } |
| 395 | |
| 396 | report "SHA256 of new file: $newhash"; |
| 397 | |
| 398 | my $currentdate = scalar gmtime($filedate); |
| 399 | |
| 400 | my $format = $opt_t ? "plain text and " : ""; |
| 401 | if( $stdout ) { |
| 402 | open(CRT, '> -') or die "Couldn't open STDOUT: $!\n"; |
| 403 | } else { |
| 404 | open(CRT,">$crt.~") or die "Couldn't open $crt.~: $!\n"; |
| 405 | } |
| 406 | print CRT <<EOT; |
| 407 | ## |
| 408 | ## Bundle of CA Root Certificates |
| 409 | ## |
| 410 | ## Certificate data from Mozilla ${datesrc}: ${currentdate} GMT |
| 411 | ## |
| 412 | ## This is a bundle of X.509 certificates of public Certificate Authorities |
| 413 | ## (CA). These were automatically extracted from Mozilla's root certificates |
| 414 | ## file (certdata.txt). This file can be found in the mozilla source tree: |
| 415 | ## ${url} |
| 416 | ## |
| 417 | ## It contains the certificates in ${format}PEM format and therefore |
| 418 | ## can be directly used with curl / libcurl / php_curl, or with |
| 419 | ## an Apache+mod_ssl webserver for SSL client authentication. |
| 420 | ## Just configure this file as the SSLCACertificateFile. |
| 421 | ## |
| 422 | ## Conversion done with mk-ca-bundle.pl version $version. |
| 423 | ## SHA256: $newhash |
| 424 | ## |
| 425 | |
| 426 | EOT |
| 427 | |
| 428 | report "Processing '$txt' ..."; |
| 429 | my $caname; |
| 430 | my $certnum = 0; |
| 431 | my $skipnum = 0; |
| 432 | my $start_of_cert = 0; |
| 433 | my $main_block = 0; |
| 434 | my $main_block_name; |
| 435 | my $trust_block = 0; |
| 436 | my $trust_block_name; |
| 437 | my @precert; |
| 438 | my $cka_value; |
| 439 | my $valid = 0; |
| 440 | |
| 441 | open(TXT,"$txt") or die "Couldn't open $txt: $!\n"; |
| 442 | while (<TXT>) { |
| 443 | if (/\*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*/) { |
| 444 | print CRT; |
| 445 | print if ($opt_l); |
| 446 | while (<TXT>) { |
| 447 | print CRT; |
| 448 | print if ($opt_l); |
| 449 | last if (/\*\*\*\*\* END LICENSE BLOCK \*\*\*\*\*/); |
| 450 | } |
| 451 | next; |
| 452 | } |
| 453 | # The input file format consists of blocks of Mozilla objects. |
| 454 | # The blocks are separated by blank lines but may be related. |
| 455 | elsif(/^\s*$/) { |
| 456 | $main_block = 0; |
| 457 | $trust_block = 0; |
| 458 | next; |
| 459 | } |
| 460 | # Each certificate has a main block. |
| 461 | elsif(/^# Certificate "(.*)"/) { |
| 462 | (!$main_block && !$trust_block) or die "Unexpected certificate block"; |
| 463 | $main_block = 1; |
| 464 | $main_block_name = $1; |
| 465 | # Reset all other certificate variables. |
| 466 | $trust_block = 0; |
| 467 | $trust_block_name = ""; |
| 468 | $valid = 0; |
| 469 | $start_of_cert = 0; |
| 470 | $caname = ""; |
| 471 | $cka_value = ""; |
| 472 | undef @precert; |
| 473 | next; |
| 474 | } |
| 475 | # Each certificate's main block is followed by a trust block. |
| 476 | elsif(/^# Trust for (?:Certificate )?"(.*)"/) { |
| 477 | (!$main_block && !$trust_block) or die "Unexpected trust block"; |
| 478 | $trust_block = 1; |
| 479 | $trust_block_name = $1; |
| 480 | if($main_block_name ne $trust_block_name) { |
| 481 | die "cert name \"$main_block_name\" != trust name \"$trust_block_name\""; |
| 482 | } |
| 483 | next; |
| 484 | } |
| 485 | # Ignore other blocks. |
| 486 | # |
| 487 | # There is a documentation comment block, a BEGINDATA block, and a bunch of |
| 488 | # blocks starting with "# Explicitly Distrust <certname>". |
| 489 | # |
| 490 | # The latter is for certificates that have already been removed and are not |
| 491 | # included. Not all explicitly distrusted certificates are ignored at this |
| 492 | # point, just those without an actual certificate. |
| 493 | elsif(!$main_block && !$trust_block) { |
| 494 | next; |
| 495 | } |
| 496 | elsif(/^#/) { |
| 497 | # The commented lines in a main block are plaintext metadata that describes |
| 498 | # the certificate. Issuer, Subject, Fingerprint, etc. |
| 499 | if($main_block) { |
| 500 | push @precert, $_ if not /^#$/; |
| 501 | if(/^# Not Valid After : (.*)/) { |
| 502 | my $stamp = $1; |
| 503 | use Time::Piece; |
| 504 | # Not Valid After : Thu Sep 30 14:01:15 2021 |
| 505 | my $t = Time::Piece->strptime($stamp, "%a %b %d %H:%M:%S %Y"); |
| 506 | my $delta = ($t->epoch - time()); # negative means no longer valid |
| 507 | if($delta < 0) { |
| 508 | $skipnum++; |
| 509 | report "Skipping: $main_block_name is not valid anymore" if ($opt_v); |
| 510 | $valid = 0; |
| 511 | } |
| 512 | else { |
| 513 | $valid = 1; |
| 514 | } |
| 515 | } |
| 516 | } |
| 517 | next; |
| 518 | } |
| 519 | elsif(!$valid) { |
| 520 | next; |
| 521 | } |
| 522 | |
| 523 | chomp; |
| 524 | |
| 525 | if($main_block) { |
| 526 | if(/^CKA_CLASS CK_OBJECT_CLASS CKO_CERTIFICATE/) { |
| 527 | !$start_of_cert or die "Duplicate CKO_CERTIFICATE object"; |
| 528 | $start_of_cert = 1; |
| 529 | next; |
| 530 | } |
| 531 | elsif(!$start_of_cert) { |
| 532 | next; |
| 533 | } |
| 534 | elsif(/^CKA_LABEL UTF8 \"(.*)\"/) { |
| 535 | ($caname eq "") or die "Duplicate CKA_LABEL attribute"; |
| 536 | $caname = $1; |
| 537 | if($caname ne $main_block_name) { |
| 538 | die "caname \"$caname\" != cert name \"$main_block_name\""; |
| 539 | } |
| 540 | next; |
| 541 | } |
| 542 | elsif(/^CKA_VALUE MULTILINE_OCTAL/) { |
| 543 | ($cka_value eq "") or die "Duplicate CKA_VALUE attribute"; |
| 544 | while (<TXT>) { |
| 545 | last if (/^END/); |
| 546 | chomp; |
| 547 | my @octets = split(/\\/); |
| 548 | shift @octets; |
| 549 | for (@octets) { |
| 550 | $cka_value .= chr(oct); |
| 551 | } |
| 552 | } |
| 553 | next; |
| 554 | } |
| 555 | elsif (/^CKA_NSS_SERVER_DISTRUST_AFTER (CK_BBOOL CK_FALSE|MULTILINE_OCTAL)/) { |
| 556 | # Example: |
| 557 | # CKA_NSS_SERVER_DISTRUST_AFTER MULTILINE_OCTAL |
| 558 | # \062\060\060\066\061\067\060\060\060\060\060\060\132 |
| 559 | # END |
| 560 | if($1 eq "MULTILINE_OCTAL") { |
| 561 | my @timestamp; |
| 562 | while (<TXT>) { |
| 563 | last if (/^END/); |
| 564 | chomp; |
| 565 | my @octets = split(/\\/); |
| 566 | shift @octets; |
| 567 | for (@octets) { |
| 568 | push @timestamp, chr(oct); |
| 569 | } |
| 570 | } |
| 571 | scalar(@timestamp) == 13 or die "Failed parsing timestamp"; |
| 572 | # A trailing Z in the timestamp signifies UTC |
| 573 | if($timestamp[12] ne "Z") { |
| 574 | report "distrust date stamp is not using UTC"; |
| 575 | } |
| 576 | # Example date: 200617000000Z |
| 577 | # Means 2020-06-17 00:00:00 UTC |
| 578 | my $distrustat = |
| 579 | timegm($timestamp[10] . $timestamp[11], # second |
| 580 | $timestamp[8] . $timestamp[9], # minute |
| 581 | $timestamp[6] . $timestamp[7], # hour |
| 582 | $timestamp[4] . $timestamp[5], # day |
| 583 | ($timestamp[2] . $timestamp[3]) - 1, # month |
| 584 | "20" . $timestamp[0] . $timestamp[1]); # year |
| 585 | if(time >= $distrustat) { |
| 586 | # not trusted anymore |
| 587 | $skipnum++; |
| 588 | report "Skipping: $main_block_name is not trusted anymore" if ($opt_v); |
| 589 | $valid = 0; |
| 590 | } |
| 591 | else { |
| 592 | # still trusted |
| 593 | } |
| 594 | } |
| 595 | next; |
| 596 | } |
| 597 | else { |
| 598 | next; |
| 599 | } |
| 600 | } |
| 601 | |
| 602 | if(!$trust_block || !$start_of_cert || $caname eq "" || $cka_value eq "") { |
| 603 | die "Certificate extraction failed"; |
| 604 | } |
| 605 | |
| 606 | my %trust_purposes_by_level; |
| 607 | |
| 608 | if(/^CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST/) { |
| 609 | # now scan the trust part to determine how we should trust this cert |
| 610 | while (<TXT>) { |
| 611 | if(/^\s*$/) { |
| 612 | $trust_block = 0; |
| 613 | last; |
| 614 | } |
| 615 | if (/^CKA_TRUST_([A-Z_]+)\s+CK_TRUST\s+CKT_NSS_([A-Z_]+)\s*$/) { |
| 616 | if ( !is_in_list($1,@valid_mozilla_trust_purposes) ) { |
| 617 | report "Warning: Unrecognized trust purpose for cert: $caname. Trust purpose: $1. Trust Level: $2"; |
| 618 | } elsif ( !is_in_list($2,@valid_mozilla_trust_levels) ) { |
| 619 | report "Warning: Unrecognized trust level for cert: $caname. Trust purpose: $1. Trust Level: $2"; |
| 620 | } else { |
| 621 | push @{$trust_purposes_by_level{$2}}, $1; |
| 622 | } |
| 623 | } |
| 624 | } |
| 625 | |
| 626 | # Sanity check that an explicitly distrusted certificate only has trust |
| 627 | # purposes with a trust level of NOT_TRUSTED. |
| 628 | # |
| 629 | # Certificate objects that are explicitly distrusted are in a certificate |
| 630 | # block that starts # Certificate "Explicitly Distrust(ed) <certname>", |
| 631 | # where "Explicitly Distrust(ed) " was prepended to the original cert name. |
| 632 | if($caname =~ /distrust/i || |
| 633 | $main_block_name =~ /distrust/i || |
| 634 | $trust_block_name =~ /distrust/i) { |
| 635 | my @levels = keys %trust_purposes_by_level; |
| 636 | if(scalar(@levels) != 1 || $levels[0] ne "NOT_TRUSTED") { |
| 637 | die "\"$caname\" must have all trust purposes at level NOT_TRUSTED."; |
| 638 | } |
| 639 | } |
| 640 | |
| 641 | if ( !should_output_cert(%trust_purposes_by_level) ) { |
| 642 | $skipnum ++; |
| 643 | report "Skipping: $caname lacks acceptable trust level" if ($opt_v); |
| 644 | } else { |
| 645 | my $encoded = MIME::Base64::encode_base64($cka_value, ''); |
| 646 | $encoded =~ s/(.{1,${opt_w}})/$1\n/g; |
| 647 | my $pem = "-----BEGIN CERTIFICATE-----\n" |
| 648 | . $encoded |
| 649 | . "-----END CERTIFICATE-----\n"; |
| 650 | print CRT "\n$caname\n"; |
| 651 | my $maxStringLength = length(decode('UTF-8', $caname, Encode::FB_CROAK | Encode::LEAVE_SRC)); |
| 652 | print CRT ("=" x $maxStringLength . "\n"); |
| 653 | if ($opt_t) { |
| 654 | foreach my $key (sort keys %trust_purposes_by_level) { |
| 655 | my $string = $key . ": " . join(", ", @{$trust_purposes_by_level{$key}}); |
| 656 | print CRT $string . "\n"; |
| 657 | } |
| 658 | } |
| 659 | if($opt_m) { |
| 660 | print CRT for @precert; |
| 661 | } |
| 662 | if (!$opt_t) { |
| 663 | print CRT $pem; |
| 664 | } else { |
| 665 | my $pipe = ""; |
| 666 | foreach my $hash (@included_signature_algorithms) { |
| 667 | $pipe = "|$openssl x509 -" . $hash . " -fingerprint -noout -inform PEM"; |
| 668 | if (!$stdout) { |
| 669 | $pipe .= " >> $crt.~"; |
| 670 | close(CRT) or die "Couldn't close $crt.~: $!"; |
| 671 | } |
| 672 | open(TMP, $pipe) or die "Couldn't open openssl pipe: $!"; |
| 673 | print TMP $pem; |
| 674 | close(TMP) or die "Couldn't close openssl pipe: $!"; |
| 675 | if (!$stdout) { |
| 676 | open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!"; |
| 677 | } |
| 678 | } |
| 679 | $pipe = "|$openssl x509 -text -inform PEM"; |
| 680 | if (!$stdout) { |
| 681 | $pipe .= " >> $crt.~"; |
| 682 | close(CRT) or die "Couldn't close $crt.~: $!"; |
| 683 | } |
| 684 | open(TMP, $pipe) or die "Couldn't open openssl pipe: $!"; |
| 685 | print TMP $pem; |
| 686 | close(TMP) or die "Couldn't close openssl pipe: $!"; |
| 687 | if (!$stdout) { |
| 688 | open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!"; |
| 689 | } |
| 690 | } |
| 691 | report "Processed: $caname" if ($opt_v); |
| 692 | $certnum ++; |
| 693 | } |
| 694 | } |
| 695 | } |
| 696 | close(TXT) or die "Couldn't close $txt: $!\n"; |
| 697 | close(CRT) or die "Couldn't close $crt.~: $!\n"; |
| 698 | unless( $stdout ) { |
| 699 | if ($opt_b && -e $crt) { |
| 700 | my $bk = 1; |
| 701 | while (-e "$crt.~${bk}~") { |
| 702 | $bk++; |
| 703 | } |
| 704 | rename $crt, "$crt.~${bk}~" or die "Failed to create backup $crt.~$bk}~: $!\n"; |
| 705 | } elsif( -e $crt ) { |
| 706 | unlink( $crt ) or die "Failed to remove $crt: $!\n"; |
| 707 | } |
| 708 | rename "$crt.~", $crt or die "Failed to rename $crt.~ to $crt: $!\n"; |
| 709 | } |
| 710 | if($opt_u && -e $txt && !unlink($txt)) { |
| 711 | report "Failed to remove $txt: $!\n"; |
| 712 | } |
| 713 | report "Done ($certnum CA certs processed, $skipnum skipped)."; |