Differential D16684 Diff 47100 security/ca_root_nss/files/MAca-bundle.pl.in

Changeset View

Standalone View

security/ca_root_nss/files/MAca-bundle.pl.in

				#!/usr/bin/env perl
	##			##
	## MAca-bundle.pl -- Regenerate ca-root-nss.crt from the Mozilla certdata.txt			## MAca-bundle.pl -- Regenerate ca-root-nss.crt from the Mozilla certdata.txt
	##			##
	## Rewritten in September 2011 by Matthias Andree to heed untrust			## Rewritten in September 2011 by Matthias Andree to heed untrust
	##			##

	## Copyright (c) 2011, 2013 Matthias Andree <mandree@FreeBSD.org>			## Copyright (c) 2011, 2013 Matthias Andree <mandree@FreeBSD.org>
	## All rights reserved.			## All rights reserved.
				rgrimesUnsubmitted Done Inline Actions Please move this line down one, your splitting an existing copyright in the middle. Yet another reason that "The all rights reserved" just needs to die die die rgrimes: Please move this line down one, your splitting an existing copyright in the middle. Yet…
				## Copyright (c) 2018, Allan Jude <allanjude@FreeBSD.org>
	##			##
	## Redistribution and use in source and binary forms, with or without			## Redistribution and use in source and binary forms, with or without
	## modification, are permitted provided that the following conditions are			## modification, are permitted provided that the following conditions are
	## met:			## met:
	##			##
	## * Redistributions of source code must retain the above copyright			## * Redistributions of source code must retain the above copyright
	## notice, this list of conditions and the following disclaimer.			## notice, this list of conditions and the following disclaimer.
	##			##
	Show All 12 Lines
	## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT			## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN			## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	## ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE			## ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	## POSSIBILITY OF SUCH DAMAGE.			## POSSIBILITY OF SUCH DAMAGE.

	use strict;			use strict;
	use Carp;			use Carp;
	use MIME::Base64;			use MIME::Base64;
				use Getopt::Long;
				mandreeUnsubmitted Done Inline Actions I wonder if we should have long options as well. Especially the -o appears to be non-obvious as output directory rather than output file. I understand that -d is taken for debug. mandree: I wonder if we should have long options as well. Especially the -o appears to be non-obvious as…

	my $VERSION = '$FreeBSD$';			my $VERSION = '$FreeBSD$';
				my $inputfh = *STDIN;
				my $debug = 0;
				my $infile;
				my $outputdir;
				my %labels;
				my %certs;
				my %trusts;

	# configuration			$debug++
	print <<EOH;			if defined $ENV{'WITH_DEBUG'}
				and $ENV{'WITH_DEBUG'} !~ m/(?i)^(no\|0\|false\|)$/;

				GetOptions (
				mandreeUnsubmitted Done Inline Actions We need to print a help text if unknown options or arguments are used. mandree: We need to print a help text if unknown options or arguments are used.
				"debug+" => \$debug,
				"infile:s" => \$infile,
				"outputdir:s" => \$outputdir)
				or die("Error in command line arguments\n$0 [-d] [-i input-file] [-o output-dir]\n");

				if ($infile) {
				open($inputfh, "<", $infile) or die "Failed to open $infile";
				}

				sub print_header($$)
				{
				my $dstfile = shift;
				my $label = shift;

				mandreeUnsubmitted Done Inline Actions The needs a prototype added, apparently `($$)` is needed. mandree: The needs a prototype added, apparently `($$)` is needed.
				matUnsubmitted Done Inline Actions From Perl::Critic::Policy::Freenode::Prototypes Function prototypes are primarily a hint to the Perl parser for parsing the function's argument list. They are not a way to validate or count the arguments passed to the function, and will cause confusion if used this way. Just do not use prototypes. mat: From [[ https://metacpan.org/pod/Perl::Critic::Policy::Freenode::Prototypes \| Perl::Critic…
				mandreeUnsubmitted Done Inline Actions Whatever the camel brain aka. Perl engine does with it - they help the reader of the code during maintenance, and should be used for consistency with other parts of the code. mandree: Whatever the camel brain aka. Perl engine does with it - they help the reader of the code…
				if ($outputdir) {
				print $dstfile <<EOFH;
	##			##
				## $label
				##
				mandreeUnsubmitted Done Inline Actions A function should not second-guess options. All options parsing should be in the scope that calls Getopt::Whatever(), i. e. in this case in the global scope. mandree: A function should not second-guess options. All options parsing should be in the scope that…
				allanjudeAuthorUnsubmitted Done Inline Actions In this case we are changing the header in the output file to make sense when each output file contains only one cert, not all 150 of them. allanjude: In this case we are changing the header in the output file to make sense when each output file…
				## This is a single X.509 certificate for a public Certificate
				## Authority (CA). It was automatically extracted from Mozilla's
				## root CA list (the file `certdata.txt' in security/nss).
				##
				## Extracted from nss-%%VERSION_NSS%%
				## with $VERSION
				##
				EOFH
				} else {
				print $dstfile <<EOH;
				##
	## ca-root-nss.crt -- Bundle of CA Root Certificates			## ca-root-nss.crt -- Bundle of CA Root Certificates
	##			##
	## This is a bundle of X.509 certificates of public Certificate			## This is a bundle of X.509 certificates of public Certificate
	## Authorities (CA). These were automatically extracted from Mozilla's			## Authorities (CA). These were automatically extracted from Mozilla's
	## root CA list (the file `certdata.txt').			## root CA list (the file `certdata.txt').
	##			##
	## Extracted from nss-%%VERSION_NSS%%			## Extracted from nss-%%VERSION_NSS%%
	## with $VERSION			## with $VERSION
	##			##
	EOH			EOH
	my $debug = 0;
	$debug++
	if defined $ENV{'WITH_DEBUG'}
	and $ENV{'WITH_DEBUG'} !~ m/(?i)^(no\|0\|false\|)$/;

	my %certs;
	my %trusts;

	sub printcert_plain($$)
	{
	my ($label, $certdata) = @_;
	print "=== $label ===\n" if $label;
	print
	"-----BEGIN CERTIFICATE-----\n",
	MIME::Base64::encode_base64($certdata),
	"-----END CERTIFICATE-----\n\n";
	}			}
				}

	sub printcert_info($$)			sub printcert($$$)
	{			{
	my (undef, $certdata) = @_;			my ($fh, $label, $certdata) = @_;
				mandreeUnsubmitted Done Inline Actions Umm... we break the first argument out as apparent file handle (`$fh`), and then use `OUT`? Looks inconsistent to me in ll. 116, 118, 119 below. mandree: Umm... we break the first argument out as apparent file handle (`$fh`), and then use `OUT`?
				allanjudeAuthorUnsubmitted Done Inline Actions This OUT is a different file descriptor, it is a pipe to openssl where we write the DER encoded data, and get back the text and PEM encoded certificate. allanjude: This OUT is a different file descriptor, it is a pipe to openssl where we write the DER encoded…
				mandreeUnsubmitted Done Inline Actions oh, right, missed that it is local. My apologies. mandree: oh, right, missed that it is local. My apologies.
	return unless $certdata;			return unless $certdata;
	open(OUT, "\|openssl x509 -text -inform DER -fingerprint")			open(OUT, "\|openssl x509 -text -inform DER -fingerprint")
	\|\| die "could not pipe to openssl x509";			or die "could not pipe to openssl x509";
	print OUT $certdata;			print OUT $certdata;
	close(OUT) or die "openssl x509 failed with exit code $?";			close(OUT) or die "openssl x509 failed with exit code $?";
	}			}

	sub printcert($$) {			sub graboct($)
				mandreeUnsubmitted Done Inline Actions It appears that in the previous and this iteration of the code, we do not need this function any more - we could just delete it, and rename [[ #l112 \| `printcert_info($$$)` ]] above to `printcert($$$)`, or am I missing something? mandree: It appears that in the previous and this iteration of the code, we do not need this function…
				mandreeUnsubmitted Done Inline Actions `$infile` should become an argument to this function -- used in l. 131 below. mandree: `$infile` should become an argument to this function -- used in [[ #l131 \| l. 131]] below.
				allanjudeAuthorUnsubmitted Done Inline Actions It was a global variable, I am not sure there is much value in passing it in instead, but done. allanjude: It was a global variable, I am not sure there is much value in passing it in instead, but done.
				mandreeUnsubmitted Done Inline Actions Thanks. As we make the code more complex, making it more maintainable seemed to make sense to me. mandree: Thanks. As we make the code more complex, making it more maintainable seemed to make sense to…
	my ($a, $b) = @_;
	printcert_info($a, $b);
	}

	sub graboct()
	{			{
				my $ifh = shift;
	my $data;			my $data;

	while (<>) {			while (<$ifh>) {
	last if /^END/;			last if /^END/;
	my (undef,@oct) = split /\\/;			my (undef,@oct) = split /\\/;
	my @bin = map(chr(oct), @oct);			my @bin = map(chr(oct), @oct);
	$data .= join('', @bin);			$data .= join('', @bin);
	}			}

	return $data;			return $data;
	}			}


	sub grabcert()			sub grabcert($)
				mandreeUnsubmitted Done Inline Actions `$infile` should become an argument to this function -- used in l. 148 below. mandree: `$infile` should become an argument to this function -- used in [[ #l148 \| l. 148 ]] below.
	{			{
				my $ifh = shift;
	my $certdata;			my $certdata;
	my $cka_label;			my $cka_label;
	my $serial;			my $serial;

	while (<>) {			while (<$ifh>) {
	chomp;			chomp;
	last if ($_ eq '');			last if ($_ eq '');

	if (/^CKA_LABEL UTF8 "([^"]+)"/) {			if (/^CKA_LABEL UTF8 "([^"]+)"/) {
	$cka_label = $1;			$cka_label = $1;
	}			}

	if (/^CKA_VALUE MULTILINE_OCTAL/) {			if (/^CKA_VALUE MULTILINE_OCTAL/) {
	$certdata = graboct();			$certdata = graboct($ifh);
	}			}

	if (/^CKA_SERIAL_NUMBER MULTILINE_OCTAL/) {			if (/^CKA_SERIAL_NUMBER MULTILINE_OCTAL/) {
	$serial = graboct();			$serial = graboct($ifh);
	}			}
	}			}
	return ($serial, $cka_label, $certdata);			return ($serial, $cka_label, $certdata);
	}			}

	sub grabtrust() {			sub grabtrust($) {
				my $ifh = shift;
				mandreeUnsubmitted Done Inline Actions `$infile` should become an argument to this function, used on line 173 below. mandree: `$infile` should become an argument to this function, used on line [[ #l173 \| 173 ]] below.
	my $cka_label;			my $cka_label;
	my $serial;			my $serial;
	my $maytrust = 0;			my $maytrust = 0;
	my $distrust = 0;			my $distrust = 0;

	while (<>) {			while (<$ifh>) {
	chomp;			chomp;
	last if ($_ eq '');			last if ($_ eq '');

	if (/^CKA_LABEL UTF8 "([^"]+)"/) {			if (/^CKA_LABEL UTF8 "([^"]+)"/) {
	$cka_label = $1;			$cka_label = $1;
	}			}

	if (/^CKA_SERIAL_NUMBER MULTILINE_OCTAL/) {			if (/^CKA_SERIAL_NUMBER MULTILINE_OCTAL/) {
	$serial = graboct();			$serial = graboct($ifh);
	}			}

	if (/^CKA_TRUST_(SERVER_AUTH\|EMAIL_PROTECTION\|CODE_SIGNING) CK_TRUST (\S+)$/)			if (/^CKA_TRUST_(SERVER_AUTH\|EMAIL_PROTECTION\|CODE_SIGNING) CK_TRUST (\S+)$/)
	{			{
	if ($2 eq 'CKT_NSS_NOT_TRUSTED') {			if ($2 eq 'CKT_NSS_NOT_TRUSTED') {
	$distrust = 1;			$distrust = 1;
	} elsif ($2 eq 'CKT_NSS_TRUSTED_DELEGATOR') {			} elsif ($2 eq 'CKT_NSS_TRUSTED_DELEGATOR') {
	$maytrust = 1;			$maytrust = 1;
	} elsif ($2 ne 'CKT_NSS_MUST_VERIFY_TRUST') {			} elsif ($2 ne 'CKT_NSS_MUST_VERIFY_TRUST') {
	confess "Unknown trust setting on line $.:\n"			confess "Unknown trust setting on line $.:\n"
	. "$_\n"			. "$_\n"
	. "Script must be updated:";			. "Script must be updated:";
	}			}
	}			}
	}			}

	if (!$maytrust && !$distrust && $debug) {			if (!$maytrust && !$distrust && $debug) {
	print STDERR "line $.: no explicit trust/distrust found for $cka_label\n";			print STDERR "line $.: no explicit trust/distrust found for $cka_label\n";
	}			}

	my $trust = ($maytrust and not $distrust);			my $trust = ($maytrust and not $distrust);
	return ($serial, $cka_label, $trust);			return ($serial, $cka_label, $trust);
	}			}

	while (<>) {			if (!$outputdir) {
				print_header(*STDOUT);
				}

				while (<$inputfh>) {
	if (/^CKA_CLASS CK_OBJECT_CLASS CKO_CERTIFICATE/) {			if (/^CKA_CLASS CK_OBJECT_CLASS CKO_CERTIFICATE/) {
	my ($serial, $label, $certdata) = grabcert();			my ($serial, $label, $certdata) = grabcert($inputfh);
	if (defined $certs{$label."\0".$serial}) {			if (defined $certs{$label."\0".$serial}) {
	warn "Certificate $label duplicated!\n";			warn "Certificate $label duplicated!\n";
	}			}
	$certs{$label."\0".$serial} = $certdata;			$certs{$label."\0".$serial} = $certdata;
				/*
				netchildUnsubmitted Done Inline Actions I suggest to add a comment why this is necessary. Same for line 225. netchild: I suggest to add a comment why this is necessary. Same for line 225.
				allanjudeAuthorUnsubmitted Done Inline Actions I think it is close enough in the code to only need the comment once. allanjude: I think it is close enough in the code to only need the comment once.
				* We store the label in a separate hash because truncating the key
				* with \0 was causing garbage data after the end of the text.
				*/
				$labels{$label."\0".$serial} = $label;
	} elsif (/^CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST/) {			} elsif (/^CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST/) {
	my ($serial, $label, $trust) = grabtrust();			my ($serial, $label, $trust) = grabtrust($inputfh);
	if (defined $trusts{$label."\0".$serial}) {			if (defined $trusts{$label."\0".$serial}) {
	warn "Trust for $label duplicated!\n";			warn "Trust for $label duplicated!\n";
	}			}
	$trusts{$label."\0".$serial} = $trust;			$trusts{$label."\0".$serial} = $trust;
				$labels{$label."\0".$serial} = $label;
	} elsif (/^CVS_ID.Revision: ([^ ]).*/) {			} elsif (/^CVS_ID.Revision: ([^ ]).*/) {
	print "## Source: \"certdata.txt\" CVS revision $1\n##\n\n";			print "## Source: \"certdata.txt\" CVS revision $1\n##\n\n";
	}			}
	}			}

	sub printlabel(@) {			sub label_to_filename(@) {
	my @res = @_;			my @res = @_;
	map { s/\0.*//; s/[^[:print:]]/_/g; $_ = "\"$_\""; } @res;			map { s/\0.*//; s/[^[:alnum:]\-]/_/g; $_ = "$_.pem"; } @res;
	return wantarray ? @res : $res[0];			return wantarray ? @res : $res[0];
	}			}

	# weed out untrusted certificates			# weed out untrusted certificates
	my $untrusted = 0;			my $untrusted = 0;
	foreach my $it (keys %trusts) {			foreach my $it (keys %trusts) {
	if (!$trusts{$it}) {			if (!$trusts{$it}) {
	if (!exists($certs{$it})) {			if (!exists($certs{$it})) {
	warn "Found trust for nonexistent certificate ".printlabel($it)."\n" if $debug;			warn "Found trust for nonexistent certificate $labels{$it}\n" if $debug;
	} else {			} else {
	delete $certs{$it};			delete $certs{$it};
	warn "Skipping untrusted ".printlabel($it)."\n" if $debug;			warn "Skipping untrusted $labels{$it}\n" if $debug;
	$untrusted++;			$untrusted++;
	}			}
	}			}
	}			}

				if (!$outputdir) {
	print "## Untrusted certificates omitted from this bundle: $untrusted\n\n";			print "## Untrusted certificates omitted from this bundle: $untrusted\n\n";
				}
	print STDERR "## Untrusted certificates omitted from this bundle: $untrusted\n";			print STDERR "## Untrusted certificates omitted from this bundle: $untrusted\n";

	my $certcount = 0;			my $certcount = 0;
	foreach my $it (sort {uc($a) cmp uc($b)} keys %certs) {			foreach my $it (sort {uc($a) cmp uc($b)} keys %certs) {
				my $fh = *STDOUT;
				my $filename;
	if (!exists($trusts{$it})) {			if (!exists($trusts{$it})) {
	die "Found certificate without trust block,\naborting";			die "Found certificate without trust block,\naborting";
	}			}
	printcert("", $certs{$it});			if ($outputdir) {
	print "\n\n\n";			$filename = label_to_filename($labels{$it});
				open($fh, ">", "$outputdir/$filename") or die "Failed to open certificate $filename";
				mandreeUnsubmitted Done Inline Actions This lacks error handling (out of disk space, lack of permission, ...). Please add. (I'll concede that the previous version of the code did not check stdout write success either...) mandree: This lacks error handling (out of disk space, lack of permission, ...). Please add. (I'll…
				print_header($fh, $labels{$it});
				}
				printcert($fh, $labels{$it}, $certs{$it});
				if ($outputdir) {
				close($fh) or die "Unable to close: $filename";
				mandreeUnsubmitted Done Inline Actions this is a place where error checking will also be beneficial - it will report write errors that only occur once we have the buffers flushed. ... or die "SOME FANCY ERROR MESSAGE WITH REASON"; mandree: this is a place where error checking will also be beneficial - it will report write errors that…
				allanjudeAuthorUnsubmitted Done Inline Actions I don't think close() can actually fail, but I'll add the error handling anyway allanjude: I don't think close() can actually fail, but I'll add the error handling anyway
				} else {
				mandreeUnsubmitted Done Inline Actions we need to add a `close($fh)` and error checks here. mandree: we need to add a `close($fh)` and error checks here.
				print $fh "\n\n\n";
				}
	$certcount++;			$certcount++;
	print STDERR "Trusting $certcount: ".printlabel($it)."\n" if $debug;			print STDERR "Trusting $certcount: $labels{$it}\n" if $debug;
	}			}

	if ($certcount < 25) {			if ($certcount < 25) {
	die "Certificate count of $certcount is implausibly low.\nAbort";			die "Certificate count of $certcount is implausibly low.\nAbort";
	}			}

				if (!$outputdir) {
	print "## Number of certificates: $certcount\n";			print "## Number of certificates: $certcount\n";
	print STDERR "## Number of certificates: $certcount\n";
	print "## End of file.\n";			print "## End of file.\n";
				mandreeUnsubmitted Done Inline Actions Hmmm... we use this marker inconsistently depending on whether `-o DIR` is used or not - is that intentional? mandree: Hmmm... we use this marker inconsistently depending on whether `-o DIR` is used or not - is…
				allanjudeAuthorUnsubmitted Done Inline Actions Yes, having the count in each file doesn't make sense. Each file in the output will contain exactly 1 certificate. allanjude: Yes, having the count in each file doesn't make sense. Each file in the output will contain…
				}
				print STDERR "## Number of certificates: $certcount\n";