view release on metacpan or  search on metacpan

script/mk-ca-bundle.pl  view on Meta::CPAN

  "TRUSTED"               # This cert is trusted, but only for itself and not for delegates (i.e. it is not a CA).
);

my $default_signature_algorithms = $opt_s = "MD5";

my @valid_signature_algorithms = (
  "MD5",
  "SHA1",
  "SHA256",
  "SHA384",
  "SHA512"
);

$0 =~ s@.*(/|\\)@@;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts('bd:fhilnp:qs:tuvw:');

if(!defined($opt_d)) {
    # to make plain "-d" use not cause warnings, and actually still work
    $opt_d = 'release';
}

# Use predefined URL or else custom URL specified on command line.
my $url = ( defined( $urls{$opt_d} ) ) ? $urls{$opt_d} : $opt_d;

my $curl = `curl -V`;

if ($opt_i) {
  print ("=" x 78 . "\n");
  print "Script Version                   : $version\n";
  print "Perl Version                     : $]\n";
  print "Operating System Name            : $^O\n";
  print "Getopt::Std.pm Version           : ${Getopt::Std::VERSION}\n";
  print "MIME::Base64.pm Version          : ${MIME::Base64::VERSION}\n";
  print "LWP::UserAgent.pm Version        : ${LWP::UserAgent::VERSION}\n";
  print "LWP.pm Version                   : ${LWP::VERSION}\n";
  print "Digest::SHA.pm Version           : ${Digest::SHA::VERSION}\n" if ($Digest::SHA::VERSION);
  print "Digest::SHA::PurePerl.pm Version : ${Digest::SHA::PurePerl::VERSION}\n" if ($Digest::SHA::PurePerl::VERSION);
  print ("=" x 78 . "\n");
}

sub warning_message() {
  if ( $opt_d =~ m/^risk$/i ) { # Long Form Warning and Exit
    print "Warning: Use of this script may pose some risk:\n";
    print "\n";
    print "  1) Using http is subject to man in the middle attack of certdata content\n";
    print "  2) Default to 'release', but more recent updates may be found in other trees\n";
    print "  3) certdata.txt file format may change, lag time to update this script\n";
    print "  4) Generally unwise to blindly trust CAs without manual review & verification\n";
    print "  5) Mozilla apps use additional security checks aren't represented in certdata\n";
    print "  6) Use of this script will make a security engineer grind his teeth and\n";
    print "     swear at you.  ;)\n";
    exit;
  } else { # Short Form Warning
    print "Warning: Use of this script may pose some risk, -d risk for more details.\n";
  }
}

sub HELP_MESSAGE() {
  print "Usage:\t${0} [-b] [-d<certdata>] [-f] [-i] [-l] [-n] [-p<purposes:levels>] [-q] [-s<algorithms>] [-t] [-u] [-v] [-w<l>] [<outputfile>]\n";
  print "\t-b\tbackup an existing version of ca-bundle.crt\n";
  print "\t-d\tspecify Mozilla tree to pull certdata.txt or custom URL\n";
  print "\t\t  Valid names are:\n";
  print "\t\t    ", join( ", ", map { ( $_ =~ m/$opt_d/ ) ? "$_ (default)" : "$_" } sort keys %urls ), "\n";
  print "\t-f\tforce rebuild even if certdata.txt is current\n";
  print "\t-i\tprint version info about used modules\n";
  print "\t-l\tprint license info about certdata.txt\n";
  print "\t-n\tno download of certdata.txt (to use existing)\n";
  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_purp...
  print "\t\t  Valid purposes are:\n";
  print wrap("\t\t    ","\t\t    ", join( ", ", "ALL", @valid_mozilla_trust_purposes ) ), "\n";
  print "\t\t  Valid levels are:\n";
  print wrap("\t\t    ","\t\t    ", join( ", ", "ALL", @valid_mozilla_trust_levels ) ), "\n";
  print "\t-q\tbe really quiet (no progress output at all)\n";
  print wrap("\t","\t\t", "-s\tcomma separated list of certificate signatures/hashes to output in plain text mode. (default: $default_signature_algorithms)\n");
  print "\t\t  Valid signature algorithms are:\n";
  print wrap("\t\t    ","\t\t    ", join( ", ", "ALL", @valid_signature_algorithms ) ), "\n";
  print "\t-t\tinclude plain text listing of certificates\n";
  print "\t-u\tunlink (remove) certdata.txt after processing\n";
  print "\t-v\tbe verbose and print out processed CAs\n";
  print "\t-w <l>\twrap base64 output lines after <l> chars (default: ${opt_w})\n";
  exit;
}

sub VERSION_MESSAGE() {
  print "${0} version ${version} running Perl ${]} on ${^O}\n";
}

warning_message() unless ($opt_q || $url =~ m/^(ht|f)tps:/i );
HELP_MESSAGE() if ($opt_h);

sub report($@) {
  my $output = shift;

  print STDERR $output . "\n" unless $opt_q;
}

sub is_in_list($@) {
  my $target = shift;

  return defined(List::Util::first { $target eq $_ } @_);
}

# Parses $param_string as a case insensitive comma separated list with optional whitespace
# validates that only allowed parameters are supplied
sub parse_csv_param($$@) {
  my $description = shift;
  my $param_string = shift;
  my @valid_values = @_;

  my @values = map {
    s/^\s+//;  # strip leading spaces
    s/\s+$//;  # strip trailing spaces
    uc $_      # return the modified string as upper case
  } split( ',', $param_string );

  # Find all values which are not in the list of valid values or "ALL"
  my @invalid = grep { !is_in_list($_,"ALL",@valid_values) } @values;

  if ( scalar(@invalid) > 0 ) {
    # Tell the user which parameters were invalid and print the standard help message which will exit

script/mk-ca-bundle.pl  view on Meta::CPAN

    } else {
      my $encoded = MIME::Base64::encode_base64($data, '');
      $encoded =~ s/(.{1,${opt_w}})/$1\n/g;
      my $pem = "-----BEGIN CERTIFICATE-----\n"
              . $encoded
              . "-----END CERTIFICATE-----\n";
      print CRT "\n$caname\n";

      my $maxStringLength = length($caname);
      if ($opt_t) {
        foreach my $key (keys %trust_purposes_by_level) {
           my $string = $key . ": " . join(", ", @{$trust_purposes_by_level{$key}});
           $maxStringLength = List::Util::max( length($string), $maxStringLength );
           print CRT $string . "\n";
        }
      }
      print CRT ("=" x $maxStringLength . "\n");
      if (!$opt_t) {
        print CRT $pem;
      } else {
        my $pipe = "";
        foreach my $hash (@included_signature_algorithms) {
          $pipe = "|$openssl x509 -" . $hash . " -fingerprint -noout -inform PEM";
          if (!$stdout) {
            $pipe .= " >> $crt.~";
            close(CRT) or die "Couldn't close $crt.~: $!";
          }
          open(TMP, $pipe) or die "Couldn't open openssl pipe: $!";
          print TMP $pem;
          close(TMP) or die "Couldn't close openssl pipe: $!";
          if (!$stdout) {
            open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!";
          }
        }
        $pipe = "|$openssl x509 -text -inform PEM";
        if (!$stdout) {
          $pipe .= " >> $crt.~";
          close(CRT) or die "Couldn't close $crt.~: $!";
        }
        open(TMP, $pipe) or die "Couldn't open openssl pipe: $!";
        print TMP $pem;
        close(TMP) or die "Couldn't close openssl pipe: $!";
        if (!$stdout) {
          open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!";
        }
      }
      report "Parsing: $caname" if ($opt_v);
      $certnum ++;
      $start_of_cert = 0;
    }
  }
}
close(TXT) or die "Couldn't close $txt: $!\n";
close(CRT) or die "Couldn't close $crt.~: $!\n";
unless( $stdout ) {
    if ($opt_b && -e $crt) {
        my $bk = 1;
        while (-e "$crt.~${bk}~") {
            $bk++;
        }
        rename $crt, "$crt.~${bk}~" or die "Failed to create backup $crt.~$bk}~: $!\n";
    } elsif( -e $crt ) {
        unlink( $crt ) or die "Failed to remove $crt: $!\n";
    }
    rename "$crt.~", $crt or die "Failed to rename $crt.~ to $crt: $!\n";
}
unlink $txt if ($opt_u);
report "Done ($certnum CA certs processed, $skipnum skipped).";