#! /usr/bin/perl -w
#
# @(#)$Id$
# build version 3.0.23, release 1
#
# Copyright 2010-2021 David Groep, Nationaal instituut voor
# subatomaire fysica NIKHEF
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
#
package main;
use strict;
use Getopt::Long qw(:config no_ignore_case bundling);
use POSIX;
eval { require LWP or die; }; $@ and die "Please install libwww-perl (LWP)\n";
my $sccsid = '@(#)fetch-crl3 version 3.0.23';
# import modules that are needed but still external
# (the installed version may have these packages embedded in-line)
#
require ConfigTiny and import ConfigTiny unless defined &ConfigTiny::new;
require TrustAnchor and import TrustAnchor unless defined &TrustAnchor::new;
require CRLWriter and import CRLWriter unless defined &CRLWriter::new;
require FCLog and import FCLog unless defined &FCLog::new;
require OSSL and import OSSL unless defined &OSSL::new;
require CRL and import CRL unless defined &CRL::new;
my $use_DataDumper = eval { require Data::Dumper; };
my $use_IOSelect = eval { require IO::Select; };
use vars qw/ $log $cnf /;
# ###########################################################################
#
#
($cnf,$log) = &init_configuration();
# use Net::INET6Glue if so requested (is not a default module)
if ( $cnf->{_}->{inet6glue} ) {
eval { require Net::INET6Glue::INET_is_INET6 or die; };
$@ and die "Please install Net::INET6Glue before enabling inet6glue config\n";
}
# verify local installation sanity for loaded modules
$::log->getverbose > 6 and ! $use_DataDumper and
$::log->err("Cannot set verbosity higher than 6 without Data::Dumper") and
exit(1);
$::cnf->{_}->{parallelism} and ! $use_IOSelect and
$::log->err("Cannot use parallel retrieval without IO::Select") and
exit(1);
$use_DataDumper and $::log->verb(7,Data::Dumper::Dumper($cnf));
# set safe path if so requested
$cnf->{_}->{path} and $ENV{"PATH"} = $cnf->{_}->{path} and
$::log->verb(5,"Set PATH to",$ENV{"PATH"});
# set rcmode if present in config
defined $cnf->{_}->{rcmode} and do {
$::log->verb(4,"Setting exit status mode to ".$cnf->{_}->{rcmode});
$::log->setrcmode($cnf->{_}->{rcmode}) or exit($log->exitstatus);
$::log->verb(2,"Exit status mode is set to ".$cnf->{_}->{rcmode});
};
# wait up to randomwait seconds to spread download load
$cnf->{_}->{randomwait} and do {
my $wtime = int(rand($cnf->{_}->{randomwait}));
$::log->verb(2,"Sleeping $wtime seconds before continuing");
sleep($wtime);
};
# the list of trust anchors to process comes from the command line and
# all files in the infodir that are metadata or crl urls
# in the next phase, the suffix will be stripped and the info file
# when present preferred over the crlurl
#
my @metafiles = @ARGV;
$::cnf->{_}->{"infodir"} and do {
foreach my $fn (
map { glob ( $::cnf->{_}->{"infodir"} . "/$_" ); } "*.info", "*.crl_url"
) {
next if $::cnf->{_}->{nosymlinks} and -l $fn;
$fn =~ /.*\/([^\/]+)(\.crl_url|\.info)$/;
push @metafiles, $1 unless grep /^$1$/,@metafiles or not defined $1;
}
};
@metafiles or
$log->warn("No trust anchors to process") and exit($log->exitstatus);
if ( $::cnf->{_}->{parallelism} ) {
¶llel_metafiles($::cnf->{_}->{parallelism}, @metafiles);
} else {
&process_metafiles( @metafiles );
}
# run any post-processing
if ( $::cnf->{_}->{"postexec"} ) {
my @args = ( $::cnf->{_}->{"postexec"},
"v1", "global",
$::cnf->{_}->{"infodir"}, $::cnf->{_}->{"cadir"}, $::cnf->{_}->{"output"} );
$::log->verb(2,"Executing global postscript @args");
my $postrc = system(@args);
if ( $postrc == -1 ) {
$::log->err("Cannot execute global postexec program: $!");
} elsif ( $postrc > 0 ) {
$::log->err("Global postexec program returned error code ".($? >> 8));
}
}
$log->flush;
exit($log->exitstatus);
# ###########################################################################
#
#
sub init_configuration() {
my ($cnf,$log);
my ($configfile,$agingtolerance,$infodir,$statedir,$cadir,$httptimeout);
my ($output);
my @formats;
my $verbosity;
my $quiet=0;
my $help=0;
my $showversion=0;
my $debuglevel;
my $parallelism=0;
my $randomwait;
my $nosymlinks;
my $cfgdir;
my $inet6glue=0;
my %directives;
$log = FCLog->new("qualified");
&GetOptions(
"c|config=s" => \$configfile,
"l|infodir=s" => \$infodir,
"cadir=s" => \$cadir,
"s|statedir=s" => \$statedir,
"cfgdir=s" => \$cfgdir,
"T|httptimeout=i" => \$httptimeout,
"o|output=s" => \$output,
"format=s@" => \@formats,
"define=s" => \%directives,
"v|verbose+" => \$verbosity,
"h|help+" => \$help,
"V|version+" => \$showversion,
"q|quiet+" => \$quiet,
"d|debug+" => \$debuglevel,
"p|parallelism=i" => \$parallelism,
"nosymlinks+" => \$nosymlinks,
"a|agingtolerance=i" => \$agingtolerance,
"r|randomwait=i" => \$randomwait,
"inet6glue+" => \$inet6glue,
) or &help and exit(1);
$help and &help and exit(0);
$showversion and &showversion and exit(0);
$configfile ||= ( -e "/etc/fetch-crl.conf" and "/etc/fetch-crl.conf" );
$configfile ||= ( -e "/etc/fetch-crl.cnf" and "/etc/fetch-crl.cnf" );
$cnf = ConfigTiny->new();
$configfile and
$cnf->read($configfile) || die "Invalid config file $configfile:\n " .
$cnf->errstr . "\n";
( defined $cnf->{_}->{cfgdir} and $cfgdir = $cnf->{_}->{cfgdir} )
unless defined $cfgdir;
$cfgdir ||= "/etc/fetch-crl.d";
if ( defined $cfgdir and -d $cfgdir and opendir(my $dh,$cfgdir) ) {
while ( my $fn = readdir $dh ) {
-f "$cfgdir/$fn" and -r "$cfgdir/$fn" and $cnf->read("$cfgdir/$fn");
}
close $dh;
}
# add defined from the command line to the configuration, to the
# main section _ thereof unless there is a colon in the key
foreach my $k ( keys %directives ) {
my $section ="_";
my $dvalue = $directives{$k};
if ( $k =~ m/(\w+):(.*)/ ) {
$section = $1;
$k=$2;
}
$cnf->{$section}->{$k} = $dvalue;
}
# command-line option overrides
$cnf->{_}->{agingtolerance} = $agingtolerance if defined $agingtolerance;
$cnf->{_}->{infodir} = $infodir if defined $infodir;
$cnf->{_}->{cadir} = $cadir if defined $cadir;
$cnf->{_}->{statedir} = $statedir if defined $statedir;
$cnf->{_}->{httptimeout} = $httptimeout if defined $httptimeout;
$cnf->{_}->{verbosity} = $verbosity if defined $verbosity;
$cnf->{_}->{debuglevel} = $debuglevel if defined $debuglevel;
$cnf->{_}->{output} = $output if defined $output;
$cnf->{_}->{formats} = join "\001",@formats if @formats;
$cnf->{_}->{parallelism} = $parallelism if $parallelism;
$cnf->{_}->{randomwait} = $randomwait if defined $randomwait;
$cnf->{_}->{nosymlinks} = $nosymlinks if defined $nosymlinks;
$cnf->{_}->{inet6glue} = $inet6glue if $inet6glue;
# deal with interaction of verbosity in logfile and quiet option
# since a noquiet config option can cancel it
if ( not defined $cnf->{_}->{noquiet} ) {
if ( $quiet == 1) { $cnf->{_}->{verbosity} = -1; }
} else {
if ( $quiet >= 2) { $cnf->{_}->{verbosity} = -1; }
}
# key default values
defined $cnf->{_}->{version} or $cnf->{_}->{version} = "3+";
defined $cnf->{_}->{packager} or $cnf->{_}->{packager} = "EUGridPMA";
defined $cnf->{_}->{openssl} or $cnf->{_}->{openssl} = "openssl";
defined $cnf->{_}->{agingtolerance} or $cnf->{_}->{agingtolerance} ||= 24;
defined $cnf->{_}->{infodir} or $cnf->{_}->{infodir} = '/etc/grid-security/certificates';
defined $cnf->{_}->{output} or $cnf->{_}->{output} = $cnf->{_}->{infodir};
defined $cnf->{_}->{cadir} or $cnf->{_}->{cadir} = $cnf->{_}->{infodir};
defined $cnf->{_}->{statedir} or $cnf->{_}->{statedir} = "/var/cache/fetch-crl" if -d "/var/cache/fetch-crl" and -w "/var/cache/fetch-crl";
defined $cnf->{_}->{formats} or $cnf->{_}->{formats} = "openssl";
defined $cnf->{_}->{opensslmode} or $cnf->{_}->{opensslmode} = "dual";
defined $cnf->{_}->{httptimeout} or $cnf->{_}->{httptimeout} = 120;
defined $cnf->{_}->{expirestolerance} or $cnf->{_}->{expirestolerance} = (7*60*60); # at least 7 hrs should nextUpdate be beyond the cache FreshUntil
defined $cnf->{_}->{maxcachetime} or $cnf->{_}->{maxcachetime} = (4*24*60*60); # arbitrarily set it at 4 days
defined $cnf->{_}->{nametemplate_der} or
$cnf->{_}->{nametemplate_der} = "\@ANCHORNAME\@.\@R\@.crl";
defined $cnf->{_}->{nametemplate_pem} or
$cnf->{_}->{nametemplate_pem} = "\@ANCHORNAME\@.\@R\@.crl.pem";
defined $cnf->{_}->{catemplate} or
$cnf->{_}->{catemplate} = "\@ALIAS\@.pem\001".
"\@ALIAS\@.\@R\@\001\@ANCHORNAME\@.\@R\@";
$cnf->{_}->{nonssverify} ||= 0;
$cnf->{_}->{nocache} ||= 0;
$cnf->{_}->{nosymlinks} ||= 0;
$cnf->{_}->{verbosity} ||= 0;
$cnf->{_}->{debuglevel} ||= 0;
$cnf->{_}->{inet6glue} ||= 0;
$cnf->{_}->{stateless} and delete $cnf->{_}->{statedir};
# expand array keys in config
defined $cnf->{_}->{formats} and
@{$cnf->{_}->{formats_}} = split(/[\001;,\s]+/,$cnf->{_}->{formats});
# sanity check on configuration
$cnf->{_}->{statedir} and ! -d $cnf->{_}->{statedir} and
die "Invalid state directory " . $cnf->{_}->{statedir} . "\n";
$cnf->{_}->{infodir} and ! -d $cnf->{_}->{infodir} and
die "Invalid meta-data directory ".$cnf->{_}->{infodir}."\n";
# initialize logging
$log->flush;
$cnf->{_}->{logmode} and $log->destremove("qualified") and do {
foreach ( split(/[,\001]+/,$cnf->{_}->{logmode}) ) {
if ( /^syslog$/ ) { $log->destadd($_,$cnf->{_}->{syslogfacility}); }
elsif ( /^(direct|qualified|cache)$/ ) { $log->destadd($_); }
else { die "Invalid log destination $_, exiting.\n"; }
}
};
$log->setverbose($cnf->{_}->{verbosity});
$log->setdebug($cnf->{_}->{debuglevel});
return ($cnf,$log);
}
# ###########################################################################
#
#
sub showversion() {
(my $name = $0) =~ s/.*\///;
print "$name version 3.0.23\n";
return 1;
}
sub help() {
(my $name = $0) =~ s/.*\///;
print <<EOHELP;
The fetch-crl utility will retrieve certificate revocation lists (CRLs) for
a set of installed trust anchors, based on crl_url files or IGTF-style info
files. It will install these for use with OpenSSL, NSS or third-party tools.
Usage: $name [-c|--config configfile] [-l|--infodir path]
[--cadir path] [-s|--statedir path] [-o|--output path] [--format \@formats]
[-T|--httptimeout seconds] [-p|--parallelism n] [--nosymlinks]
[-a|--agingtolerance hours] [-r|--randomwait seconds]
[-v|--verbose] [-h|--help] [-q|--quiet] [-d|--debug level]
Options:
-c | --config path
Read configuration data from path, default: /etc/fetch-crl.conf
-l | --infodir path
Location of the trust anchor meta-data files (crl_url or info),
default: /etc/grid-security/certificates
--cadir path
Location of the trust anchors (default to infodir)
-s | --statedir path
Location of the historic state data (for caching and delayed-warning)
-T | --httptimeout sec
Maximum time in seconds to wait for retrieval or a single URL
-o | --output path
Location of the CRLs written (global default, defaults to infodir
--format \@formats
Format(s) in which the CRLs will be written (openssl, pem, der, nss)
--nosymlinks
Do not include meta-data files that are symlinks
-v | --verbose
Become more talkative
-q | --quiet
Become really quiet (overrides verbosity)
-p | --parallelism n
Run up to n parallel trust anchor retrieval processes
-a | --agingtolerance hours
Be quiet for up to hours hours before raising an error. Until
the tolerance has passed, only warnings are raised
-r | --randomwait seconds
Introduce a random delay of up to seconds seconds before starting
any retrieval processes
-h | --help
This help text
Version: 3.0.23
EOHELP
return 1;
}
# ###########################################################################
#
#
sub process_metafiles(@) {
my @metafiles = @_;
foreach my $f ( @metafiles ) {
my $ta = TrustAnchor->new();
$cnf->{_}->{"infodir"} and $ta->setInfodir($cnf->{_}->{"infodir"});
$ta->loadAnchor($f) or next;
$ta->saveLogMode() and $ta->setLogMode();
$ta->loadState() or next;
# using the HASH in the CA filename templates requires the CRL
# is retrieved first to determinte the hash
if ( $cnf->{_}->{"catemplate"} =~ /\@HASH\@/ ) {
$ta->retrieve or next;
$ta->loadCAfiles() or next;
} else {
$ta->loadCAfiles() or next;
$ta->retrieve or next;
}
$ta->verifyAndConvertCRLs or next;
my $writer = CRLWriter->new($ta);
$writer->writeall() or next;
$ta->saveState() or next;
if ( $::cnf->{$ta->{"alias"}}->{"postexec"} ) {
my @args = ( $::cnf->{$ta->{"alias"}}->{"postexec"},
"v1", "ta",
$ta->{"alias"}, $ta->{"filename"}, $::cnf->{_}->{"cadir"}, $::cnf->{_}->{"output"} );
$::log->verb(2,"Executing postscript for ".$ta->{"alias"}.": @args");
my $postrc = system(@args);
if ( $postrc == -1 ) {
$::log->err("Cannot execute postexec program for".$ta->{"alias"}.": $!");
} elsif ( $postrc > 0 ) {
$::log->err("postexec program for ".$ta->{"alias"}." returned error code ".($? >> 8));
}
}
$ta->restoreLogMode();
}
return 1;
}
sub parallel_metafiles($@) {
my $parallelism = shift;
my @metafiles = @_;
my %pids = (); # file handle by processID
my %metafile_by_fh = (); # reverse map
my $readset = new IO::Select();
my %logoutput = ();
$| = 1;
$::log->verb(2,"starting up to $parallelism worker processes");
while ( @metafiles or scalar keys %pids ) {
# loop until we have started all possible retrievals AND have
# collected all possible output
( @metafiles and (scalar keys %pids < $parallelism) ) and do {
# we have metafiles left, and have spare process slots
my $metafile = shift @metafiles;
$logoutput{$metafile} = "";
my $cout;
my $cpid = open $cout, "-|";
defined $cpid and defined $cout or
$::log->err("Cannot fork ($metafile): $!") and next;
$::log->verb(5,"LOOP: starting process $cpid for $metafile");
if ( $cpid == 0 ) { # I'm the child that should care for $metafile
$0 = "fetch-crl worker $metafile";
$::log->cleanse();
$::log->destadd("qualified");
&process_metafiles($metafile);
$::log->flush;
exit($::log->exitstatus);
} else { # parent
$pids{$cpid} = $cout;
$readset->add($cout);
$metafile_by_fh{$cout} = $metafile;
}
};
# do a select loop over the outstanding requests to collect messages
# if we are in the process of starting more processes, we just
# briefly poll out pending output so as not to have blocking
# children, but if we have started as many children as we ought to
# we put in a longer timeout -- any output on a handle will
# get us out of the select and into flushing mode again
my $timeout = (@metafiles && (scalar keys %pids < $parallelism) ? 0.1:1);
$::log->verb(6,"PLOOP: select with timeout $timeout");
my ( $rh_set ) = IO::Select->select($readset, undef, undef, $timeout);
foreach my $fh ( @$rh_set ) {
my $metafile = $metafile_by_fh{$fh};
# we know there is at least one byte to read, but also that
# any client sends complete
while (1) {
my $char;
my $length = sysread $fh, $char, 1;
if ( $length ) {
$logoutput{$metafile} .= $char;
$char eq "\n" and last;
} else {
#expected a char but got eof
$readset->remove($fh);
close($fh);
map {
$pids{$_} == $fh and
waitpid($_,WNOHANG) and
delete $pids{$_} and
$::log->verb(5,"Collected pid $_ (rc=$?),",
length($logoutput{$metafile}),"bytes log output");
} keys %pids;
last;
}
}
}
}
# log out all collected log data from our children
foreach my $metafile ( sort keys %logoutput ) {
foreach my $line ( split(/\n/,$logoutput{$metafile}) ) {
$line =~ /^ERROR\s+(.*)$/ and $::log->err($1);
$line =~ /^WARN\s+(.*)$/ and $::log->warn($1);
$line =~ /^VERBOSE\((\d+)\)\s+(.*)$/ and $::log->verb($1,$2);
$line =~ /^DEBUG\((\d+)\)\s+(.*)$/ and $::log->debug($1,$2);
}
}
return 1;
}
#
# @(#)$Id$
#
#
package CRL;
use strict;
require OSSL and import OSSL unless defined &OSSL::new;
use vars qw/ $log $cnf /;
# Syntax:
# CRL->new( [name [,data]] );
# CRL->setName( name);
# CRL->setData( datablob ); # load a CRL in PEM format or bails out
# CRL->verify( cafilelist ); # returns path to CA or undef if verify failed
#
#
sub new {
my $obref = {}; bless $obref;
my $self = shift;
$self = $obref;
my $name = shift;
my $data = shift;
$self->{"name"} = "unknown";
$self->setName($name) if $name;
$self->setData($data) if $data;
return $self;
}
sub setName($$) {
my $self = shift or die "Invalid invocation of CRL::setName\n";
my $name = shift;
return 0 unless $name;
$self->{"name"} = $name;
return 1;
}
sub setData($$) {
my $self = shift or die "Invalid invocation of CRL::setData\n";
my $data = shift;
my $pemdata = undef;
my $errormsg;
my $openssl = OSSL->new() or $::log->err("OpenSSL not found") and return 0;
# try to recognise data type and normalise to PEM string
# but extract only the first blob of PEM (so max one CRL per data object)
#
if ( $data =~
/(^-----BEGIN X509 CRL-----\n[^-]+\n-----END X509 CRL-----$)/sm ) {
$pemdata = $1;
} elsif ( substr($data,0,1) eq "0" ) { # looks a bit like an ASN.1 SEQ
($pemdata,$errormsg) =
$openssl->Exec3($data, qw/ crl -inform DER -outform PEM / );
$pemdata or
$::log->warn("Apparent DER data for",$self->{"name"},"not recognised")
and return 0;
} else {
$::log->warn("CRL data for",$self->{"name"},"not recognised");
return 0;
}
# extract other data from the pem blob with openssl
(my $statusdata,$errormsg) =
$openssl->Exec3($pemdata, qw/ crl
-noout -issuer -sha1 -fingerprint -lastupdate -nextupdate -hash/);
defined $statusdata or do {
( my $eline = $errormsg ) =~ s/\n.*//sgm;
$::log->warn("Unable to extract CRL data for",$self->{"name"},$eline);
return 0;
};
$statusdata =~ /(?:^|\n)SHA1 Fingerprint=([^\n]+)\n/ and
$self->{"sha1fp"} = $1;
$statusdata =~ /(?:^|\n)issuer=([^\n]+)\n/ and
$self->{"issuer"} = $1;
$statusdata =~ /(?:^|\n)lastUpdate=([^\n]+)\n/ and
$self->{"lastupdatestr"} = $1;
$statusdata =~ /(?:^|\n)nextUpdate=([^\n]+)\n/ and
$self->{"nextupdatestr"} = $1;
$statusdata =~ /(?:^|\n)([0-9a-f]{8})\n/ and
$self->{"hash"} = $1;
$self->{"nextupdatestr"} and
$self->{"nextupdate"} = $openssl->gms2t($self->{"nextupdatestr"});
$self->{"lastupdatestr"} and
$self->{"lastupdate"} = $openssl->gms2t($self->{"lastupdatestr"});
#$self->{"nextupdate"} = time - 200;
#$self->{"lastupdate"} = time + 200;
$self->{"data"} = $data;
$self->{"pemdata"} = $pemdata;
return 1;
}
sub getLastUpdate($) {
my $self = shift or die "Invalid invocation of CRL::getLastUpdate\n";
return $self->{"lastupdate"} || undef;
}
sub getNextUpdate($) {
my $self = shift or die "Invalid invocation of CRL::getNextUpdate\n";
return $self->{"nextupdate"} || undef;
}
sub getAttribute($$) {
my $self = shift or die "Invalid invocation of CRL::getAttribute\n";
my $key = shift;
return $self->{$key} || undef;
}
sub getPEMdata($) {
my $self = shift or die "Invalid invocation of CRL::getPEMdata\n";
$self->{"pemdata"} or
$::log->err("Attempt to extract PEM data from bad CRL object",
($self->{"name"}||"unknown")) and
return undef;
return $self->{"pemdata"};
}
sub verify($@) {
my $self = shift or die "Invalid invocation of CRL::verify\n";
my $openssl = OSSL->new() or $::log->err("OpenSSL not found") and return 0;
$self->{"pemdata"} or
$::log->err("verify called on empty data blob") and return 0;
my @verifyStatus = ();
# openssl crl verify works against a single CA and does not need a
# full chain to be present. That suits us file (checked with OpenSSL
# 0.9.5a and 1.0.0a)
my $verifyOK;
foreach my $cafile ( @_ ) {
-e $cafile or
$::log->err("CRL::verify called with nonexistent CA file $cafile") and
next;
my ($dataout,$dataerr) =
$openssl->Exec3($self->{"pemdata"}, qw/crl -noout -CAfile/,$cafile);
$dataerr and $dataout .= $dataerr;
$dataout =~ /verify OK/ and $verifyOK = $cafile and last;
}
$verifyOK or push @verifyStatus, "CRL signature failed";
$verifyOK and
$::log->verb(4,"Verified CRL",$self->{"name"},"against $verifyOK");
$self->{"nextupdate"} or
push @verifyStatus, "CRL nextUpdate determination failed";
$self->{"lastupdate"} or
push @verifyStatus, "CRL lastUpdate determination failed";
if ( $self->{"nextupdate"} and $self->{"nextupdate"} < time ) {
push @verifyStatus, "CRL has nextUpdate time in the past";
}
if ( $self->{"lastupdate"} and $self->{"lastupdate"} > time ) {
push @verifyStatus, "CRL has lastUpdate time in the future";
}
return @verifyStatus;
}
1;
#
# @(#)$Id$
#
# ###########################################################################
#
#
# Syntax:
# CRLWriter->new( [name [,index]] );
# CRLWriter->setTA( trustanchor );
# CRLWriter->setIndex( index );
#
package CRLWriter;
use strict;
use File::Basename;
use File::Temp qw/ tempfile /;
require OSSL and import OSSL unless defined &OSSL::new;
require base64 and import base64 unless defined &base64::b64encode;
use vars qw/ $log $cnf /;
sub new {
my $obref = {}; bless $obref;
my $self = shift;
$self = $obref;
my $name = shift;
my $index = shift;
$self->setTA($name) if defined $name;
$self->setIndex($name) if defined $index;
return $self;
}
sub getName($) {
my $self = shift;
return 0 unless defined $self;
return $self->{"ta"}->getAnchorName;
}
sub setTA($$) {
my $self = shift;
my ($ta) = shift;
return 0 unless defined $ta and defined $self;
$ta->{"anchorname"} or
$::log->err("CRLWriter::setTA called without uninitialised trust anchor")
and return 0;
$self->{"ta"} = $ta;
return 1;
}
sub setIndex($$) {
my $self = shift;
my ($index) = shift;
return 0 unless defined $self;
$self->{"ta"} or
$::log->err("CRLWriter::setIndex called without a loaded TA") and
return 0;
my $ta = $self->{"ta"};
$ta->{"crlurls"} or
$::log->err("CRLWriter::setIndex called with uninitialised TA") and
return 0;
! defined $index and delete $self->{"index"} and return 1;
$index < 0 and
$::log->err("CRLWriter::setIndex called with invalid index $index") and
return 0;
$index > $#{$ta->{"crlurls"}} and
$::log->err("CRLWriter::setIndex index $index too large") and
return 0;
$self->{"index"} = $index;
return 1;
}
sub updatefile($$%) {
my $file = shift;
my $content = shift;
my %flags = @_;
$content or return undef;
$file or
$::log->err("Cannot write content to undefined path") and return undef;
my ( $basename, $path, $suffix ) = fileparse($file);
# get content and do a comparison. If data identical, touch only
# to update mtime (other tools like NGC Nagios use this mtime semantics)
#
my $olddata;
my $mytime;
-f $file and do {
$mytime = (stat(_))[9];
{
open OLDFILE,'<',$file or
$::log->err("Cannot make backup of $file: $!") and return undef;
binmode OLDFILE; local $/;
$olddata = <OLDFILE>; close OLDFILE;
}
};
if ( $flags{"BACKUP"} and $olddata ) {
if ( -w $path ) {
-e "$file~" and ( unlink "$file~" or
$::log->warn("Cannot remove old backup $file~: $!") and return undef);
if (open BCKFILE,'>',"$file~" ) {
print BCKFILE $olddata;
close BCKFILE;
utime $mytime,$mytime, "$file~";
} else {
$::log->warn("Cannot reate backup $file~: $!");
}
} else {
$::log->warn("Cannot make backup, $path not writable");
}
}
defined $olddata and $olddata eq $content and do {
$::log->verb(4,"$file unchanged - touch only");
utime time,time,$file and return 1;
$::log->warn("Touch of $file failed, CRL unmodified");
return 0;
};
# write new CRL to file ($file in $path) - attempting to do
# an atomic action to prevent a reace condition with clients
# but do not insist if the $path is not writable for new files
my $tmpcrlmode=((stat $file)[2] || 0644) & 07777;
$::log->verb(5,"TMP file for $file mode $tmpcrlmode");
my $tmpcrl = File::Temp->new(DIR => $path, SUFFIX => '.tmp',
PERMS => $tmpcrlmode, UNLINK => 1);
if ( defined $tmpcrl ) { # we could create a tempfile next to current
print $tmpcrl $content or
$::log->err("Write to $tmpcrl: $!") and return undef;
# atomic move, but no need to restore from backup on failure
# and the unlink on destroy is implicit
chmod $tmpcrlmode,$tmpcrl or
$::log->err("chmod on $tmpcrl (to $tmpcrlmode): $!") and
return undef;
rename($tmpcrl, $file) or
$::log->err("rename $tmpcrl to $file: $!") and return undef;
# file was successfully renamed, so nothing left to unlink
$tmpcrl->unlink_on_destroy( 0 );
} elsif ( open FH,'>',$file ) {
# no adjecent write possible, fall back to rewrite
print FH $content or
$::log->err("Write to $file: $!") and return undef;
close FH or
$::log->err("Close on write of $file: $!") and return undef;
} else { # something went wrong in opening the file for write,
# so try and restore backup if that was selected
$::log->err("Open for write of $file: $!");
$flags{"BACKUP"} and ! -s "$file" and -s "$file~" and do {
#file has been clobbed, but backup OK
unlink "$file" and link "$file~","$file" and unlink "$file~" or
$::log->err("Restore of backup $file failed: $!");
};
return undef;
}
return 1;
}
sub writePEM($$$$) {
my $self = shift;
my $idx = shift;
my $data = shift;
my $ta = shift;
defined $idx and $data and $ta or
$::log->err("CRLWriter::writePEM: missing index or data") and return 0;
my $output = $::cnf->{_}->{"output"};
$output = $::cnf->{_}->{"output_pem"} if defined $::cnf->{_}->{"output_pem"};
$output and -d $output or
$::log->err("PEM target directory $output invalid") and return 0;
my $filename = "$output/".$ta->{"nametemplate_pem"};
$filename =~ s/\@R\@/$idx/g;
my %flags = ();
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1;
if ($data !~ /\n$/sm) {
$::log->verb(5,"Appending newline to short PEM file",$filename);
$data="$data\n";
}
$::log->verb(3,"Writing PEM file",$filename);
&updatefile($filename,$data,%flags) or return 0;
return 1;
}
sub writeDER($$$$) {
my $self = shift;
my $idx = shift;
my $data = shift;
my $ta = shift;
defined $idx and $data and $ta or
$::log->err("CRLWriter::writeDER: missing index or data") and return 0;
my $output = $::cnf->{_}->{"output"};
$output = $::cnf->{_}->{"output_der"} if defined $::cnf->{_}->{"output_der"};
$output and -d $output or
$::log->err("DER target directory $output invalid") and return 0;
my $filename = "$output/".$ta->{"nametemplate_der"};
$filename =~ s/\@R\@/$idx/g;
my %flags = ();
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1;
my $openssl=OSSL->new();
my ($der,$errors) = $openssl->Exec3($data,qw/crl -inform PEM -outform DER/);
$errors or not $der and
$::log->err("Data count not be converted to DER: $errors") and return 0;
$::log->verb(3,"Writing DER file",$filename);
&updatefile($filename,$der,%flags) or return 0;
return 1;
}
sub writeOpenSSL($$$$) {
my $self = shift;
my $idx = shift;
my $data = shift;
my $ta = shift;
defined $idx and $data and $ta or
$::log->err("CRLWriter::writeOpenSSL: missing index, data or ta") and
return 0;
my $output = $::cnf->{_}->{"output"};
$output = $::cnf->{_}->{"output_openssl"} if
defined $::cnf->{_}->{"output_openssl"};
$output and -d $output or
$::log->err("OpenSSL target directory $output invalid") and return 0;
my $openssl=OSSL->new();
# guess the hash name or names from OpenSSL
# if mode is dual (and OpenSSL1 installed) write two files
my $opensslversion = $openssl->getVersion() or return 0;
my ($cmddata,$errors);
my @hashes = ();
if ( $opensslversion ge "1" and $::cnf->{_}->{"opensslmode"} eq "dual" ) {
$::log->verb(5,"OpenSSL version 1 dual-mode enabled");
# this mode needs the ta cafile to get both hashes, since these
# can only be extracted by the x509 subcommand from a CA ...
($cmddata,$errors) = $openssl->Exec3(undef,
qw/x509 -noout -subject_hash -subject_hash_old -in/,
$ta->{"cafile"}[0]);
$cmddata or
$::log->err("OpenSSL cannot extract hashes from",$ta->{"cafile"}[0]) and
return 0;
@hashes = split(/[\s\n]+/,$cmddata);
} else {
$::log->verb(5,"OpenSSL version 1 single-mode or pre-1.0 style");
($cmddata,$errors) = $openssl->Exec3($data,qw/crl -noout -hash/);
$cmddata or
$::log->err("OpenSSL cannot extract hashes from CRL for",
$ta->{"alias"}.'/'.$idx
) and
return 0;
@hashes = split(/[\s\n]+/,$cmddata);
}
my %flags = ();
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1;
foreach my $hash ( @hashes ) {
my $filename = "$output/$hash.r$idx";
$::log->verb(3,"Writing OpenSSL file",$filename);
&updatefile($filename,$data,%flags) or return 0;
}
return 1;
}
sub writeNSS($$$$) {
my $self = shift;
my $idx = shift;
my $data = shift;
my $ta = shift;
defined $idx and $data and $ta or
$::log->err("CRLWriter::writeNSS: missing index, data or ta") and return 0;
my $output = $::cnf->{_}->{"output"};
$output = $::cnf->{_}->{"output_nss"} if defined $::cnf->{_}->{"output_nss"};
$output and -d $output or
$::log->err("NSS target directory $output invalid") and return 0;
my $dbprefix="";
$dbprefix = $::cnf->{_}->{"nssdbprefix"}
if defined $::cnf->{_}->{"nssdbprefix"};
my $filename = "$output/$dbprefix";
# the crlutil tool requires the DER formatted cert in a file
my $tmpdir = $::cnf->{_}->{exec3tmpdir} || $ENV{"TMPDIR"} || '/tmp';
my ($derfh,$dername) = tempfile("fetchcrl3der.XXXXXX",
DIR=>$tmpdir, UNLINK=>1);
(my $b64data = $data) =~ s/-[^\n]+//gm;
$b64data =~ s/\s+//gm;
print $derfh base64::b64decode($b64data); # der is decoded PEM :-)
my $cmd = "crlutil -I -d \"$output\" -P \"$dbprefix\" ";
$::cnf->{_}->{nonssverify} and $cmd .= "-B ";
$cmd .= "-n ".$ta->{"alias"}.'.'.$idx." ";
$cmd .= "-i \"$dername\"";
my $result = `$cmd 2>&1`;
unlink $dername;
if ( $? != 0 ) {
$::log->err("Cannot update NSSDB filename: $result");
} else {
$::log->verb(3,"WriteNSS: ".$ta->{"alias"}.'.'.$idx." added to $filename");
}
return 1;
}
sub writeall($) {
my $self = shift;
return 0 unless defined $self;
$self->{"ta"} or
$::log->err("CRLWriter::setIndex called without a loaded TA") and
return 0;
my $ta = $self->{"ta"};
$ta->{"crlurls"} or
$::log->err("CRLWriter::setIndex called with uninitialised TA") and
return 0;
$::log->verb(2,"Writing CRLs for",$ta->{"anchorname"});
my $completesuccess = 1;
for ( my $idx = 0 ; $idx <= $#{$ta->{"crl"}} ; $idx++ ) {
$ta->{"crl"}[$idx]{"pemdata"} or
$::log->verb(3,"Ignored CRL $idx skipped") and
next; # ignore empty crls, leave these in place
my $writeAttempt = 0;
my $writeSuccess = 0;
( grep /^pem$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and
$writeSuccess += $self->writePEM($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta);
( grep /^der$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and
$writeSuccess += $self->writeDER($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta);
( grep /^openssl$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and
$writeSuccess += $self->writeOpenSSL($idx,
$ta->{"crl"}[$idx]{"pemdata"},$ta);
( grep /^nss$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and
$writeSuccess += $self->writeNSS($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta);
if ( $writeSuccess == $writeAttempt ) {
$::log->verb(4,"LastWrite time (mtime) set to current time");
$ta->{"crl"}[$idx]{"state"}{"mtime"} = time;
} else {
$::log->warn("Partial updating ($writeSuccess of $writeAttempt) for",
$ta->{"anchorname"},
"CRL $idx: mtime not updated");
}
$completesuccess &&= ($writeSuccess == $writeAttempt);
}
return $completesuccess;
}
1;
package ConfigTiny;
# derived from Config::Tiny 2.12, but with some local mods and
# some new syntax possibilities
# If you thought Config::Simple was small...
use strict;
BEGIN {
require 5.004;
$ConfigTiny::VERSION = '2.12';
$ConfigTiny::errstr = '';
}
# Create an empty object
sub new { bless {}, shift }
# Create an object from a file
sub read {
my $class = ref $_[0] ? shift : ref shift;
# Check the file
my $file = shift or return $class->_error( 'You did not specify a file name' );
return $class->_error( "File '$file' does not exist" ) unless -e $file;
return $class->_error( "'$file' is not a file or like endpoint" ) unless ( -f _ or -c _ or -S _ );
return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
# Slurp in the file
local $/ = undef;
open CFG, $file or return $class->_error( "Failed to open file '$file': $!" );
my $contents = <CFG>;
close CFG;
return $class->read_string( $contents );
}
# Create an object from a string
sub read_string {
my $class = ref $_[0] ? shift : ref shift;
my $self = $class;
#my $self = bless {}, $class;
#my $self = shift;
return undef unless defined $_[0];
# Parse the file
my $ns = '_';
my $counter = 0;
my $content = shift;
$content =~ s/\\(?:\015{1,2}\012|\015|\012)\s*//gm;
foreach ( split /(?:\015{1,2}\012|\015|\012)/, $content ) {
$counter++;
# Skip comments and empty lines
next if /^\s*(?:\#|\;|$)/;
# Remove inline comments
s/\s\;\s.+$//g;
# Handle section headers
if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
# Create the sub-hash if it doesn't exist.
# Without this sections without keys will not
# appear at all in the completed struct.
$self->{$ns = $1} ||= {};
next;
}
# Handle properties
if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
$self->{$ns}->{$1} = $2;
next;
}
# Handle settings
if ( /^\s*([^=]+?)\s*$/ ) {
$self->{$ns}->{$1} = 1;
next;
}
return $self->_error( "Syntax error at line $counter: '$_'" );
}
return $self;
}
# Save an object to a file
sub write {
my $self = shift;
my $file = shift or return $self->_error(
'No file name provided'
);
# Write it to the file
open( CFG, '>' . $file ) or return $self->_error(
"Failed to open file '$file' for writing: $!"
);
print CFG $self->write_string;
close CFG;
}
# Save an object to a string
sub write_string {
my $self = shift;
my $contents = '';
foreach my $section ( sort { (($b eq '_') <=> ($a eq '_')) || ($a cmp $b) } keys %$self ) {
my $block = $self->{$section};
$contents .= "\n" if length $contents;
$contents .= "[$section]\n" unless $section eq '_';
foreach my $property ( sort keys %$block ) {
$contents .= "$property=$block->{$property}\n";
}
}
$contents;
}
# Error handling
sub errstr { $ConfigTiny::errstr }
sub _error { $ConfigTiny::errstr = $_[1]; undef }
1;
#
# @(#)$Id$
#
# ###########################################################################
#
# Fetch-CRL3 logging support
package FCLog;
use Sys::Syslog;
# Syntax:
# $log = CL->new( [outputmode=qualified,cache,direct,syslog] )
# $log->destadd( destination [,facility] )
# $log->destremove ( destination )
# $log->setverbose( level )
# $log->setdebug( level )
# $log->setwarnings( 0|1 )
# $log->debug( level, message ...)
# $log->verb( level, message ...)
# $log->warn( level, message ...)
# $log->err( level, message ...)
# $log->clear( )
# $log->flush( )
# $log->exitstatus( )
#
sub new {
my $self = shift;
my $obref = {}; bless $obref;
$obref->{"debug"} = 0;
$obref->{"verbose"} = 0;
$obref->{"messagecache"} = ();
$obref->{"warnings"} = 1;
$obref->{"errors"} = 1;
$obref->{"rcmode"} = "normal";
$obref->{"warncount"} = 0;
$obref->{"errorcount"} = 0;
$obref->{"retrerrorcount"} = 0;
$obref->{"syslogfacility"} = "daemon";
while ( my $mode = shift ) {
$obref->destadd($mode);
}
return $obref;
}
sub destadd {
my $self = shift;
my $mode = shift;
my $facility = (shift or $self->{"syslogfacility"});
return 0 unless defined $mode;
$self->{"logmode"}{$mode} = 1;
if ( $mode eq "syslog" ) {
my $progname = $0;
$progname =~ s/^.*\///;
$self->{"syslogfacility"} = $facility;
openlog($progname,"nowait,pid", $facility);
}
return 1;
}
sub destremove {
my $self = shift;
my $ok = 1;
my $mode = shift;
$self->{"logmode"} = {} and return 1 if (defined $mode and $mode eq "all");
unshift @_,$mode;
while ( my $mode = shift ) {
if ( defined $self->{"logmode"}{$mode} ) {
closelog() if $mode eq "syslog";
delete $self->{"logmode"}{$mode};
} else {
$ok=0;
}
}
return $ok;
}
sub setverbose {
my ($self,$level) = @_;
my $oldlevel = $self->{"verbose"};
$self->{"verbose"} = 0+$level;
return $oldlevel;
}
sub getverbose {
my ($self) = @_;
return $self->{"verbose"};
}
sub setdebug {
my ($self,$level) = @_;
my $oldlevel = $self->{"debug"};
$self->{"debug"} = $level;
return $oldlevel;
}
sub getdebug {
my ($self) = @_;
return $self->{"debug"};
}
sub setwarnings {
my ($self,$level) = @_;
my $oldlevel = $self->{"warnings"};
$self->{"warnings"} = $level;
return $oldlevel;
}
sub getwarnings {
my ($self) = @_;
return $self->{"warnings"};
}
sub geterrors {
my ($self) = @_;
return $self->{"errors"};
}
sub seterrors {
my ($self,$level) = @_;
my $oldlevel = $self->{"errors"};
$self->{"errors"} = $level;
return $oldlevel;
}
sub getrcmode {
my ($self) = @_;
return $self->{"rcmode"};
}
sub setrcmode {
my ($self,$level) = @_;
if ( $level !~ /^(normal|differentiated|noretrievalerrors)$/ ) {
$self->err("Attempt to set rcmode to invalid value of $level");
return undef;
}
my $oldlevel = $self->{"rcmode"};
$self->{"rcmode"} = $level;
return $oldlevel;
}
sub verb($$$) {
my $self = shift;
my $level = shift;
return 1 unless ( $level <= $self->{"verbose"} );
my $message = "@_";
$self->output("VERBOSE($level)",$message);
return 1;
}
sub debug($$$) {
my $self = shift;
my $level = shift;
return 1 unless ( $level <= $self->{"debug"} );
my $message = "@_";
$self->output("DEBUG($level)",$message);
return 1;
}
sub warn($@) {
my $self = shift;
return 1 unless ( $self->{"warnings"} );
$self->{"warningcount"}++;
my $message = "@_";
$self->output("WARN",$message);
return 1;
}
sub err($@) {
my $self = shift;
my $message = "@_";
return 1 unless ( $self->{"errors"} );
$self->output("ERROR",$message);
$self->{"errorcount"}++;
return 1;
}
sub retr_err($@) {
my $self = shift;
my $message = "@_";
return 1 unless ( $self->{"errors"} );
$self->output("ERROR",$message);
$self->{"retrerrorcount"}++;
return 1;
}
sub output($$@) {
my ($self,$label,@message) = @_;
return 0 unless defined $label and @message;
my $message = join " ",@message;
print "" . ($label?"$label ":"") . "$message\n"
if ( defined $self->{"logmode"}{"qualified"} );
push @{$self->{"messagecache"}},"" . ($label?"$label ":"") . "$message\n"
if ( defined $self->{"logmode"}{"cache"} );
print "$message\n"
if ( defined $self->{"logmode"}{"direct"} );
if ( defined $self->{"logmode"}{"syslog"} ) {
my $severity = "LOG_INFO";
$severity = "LOG_NOTICE" if $label eq "WARN";
$severity = "LOG_ERR" if $label eq "ERROR";
$severity = "LOG_DEBUG" if $label =~ /^VERBOSE/;
$severity = "LOG_DEBUG" if $label =~ /^DEBUG/;
syslog($severity, "%s", $message);
}
return 1;
}
sub clear($) {
my $self = shift;
$self->{"messagecache"} = ();
return 1;
}
sub flush($) {
my $self = shift;
foreach my $s ( @{$self->{"messagecache"}} ) {
print $s;
}
$self->{"messagecache"} = ();
($self->{"errorcount"} + $self->{"retrerrorcount"}) and $self->{"errors"} and return 0;
$self->{"warningcount"} and $self->{"warnings"} and return 1;
return 1;
}
sub cleanse($) {
my $self = shift;
$self->{"messagecache"} = ();
$self->{"errorcount"} = 0;
$self->{"retrerrorcount"} = 0;
$self->{"warningcount"} = 0;
$self->{"logmode"} = {};
return 1;
}
sub exitstatus($) {
my $self = shift;
if ( $self->{"rcmode"} eq "normal" ) {
$self->{"errorcount"} and $self->{"errors"} and return 1;
$self->{"retrerrorcount"} and $self->{"errors"} and return 1;
} elsif ( $self->{"rcmode"} eq "differentiated" ) {
$self->{"errorcount"} and $self->{"errors"} and return 1;
$self->{"retrerrorcount"} and $self->{"errors"} and return 2;
} elsif ( $self->{"rcmode"} eq "noretrievalerrors" ) {
$self->{"errorcount"} and $self->{"errors"} and return 1;
} else {
return 1;
}
return 0;
}
1;
#
# @(#)$Id$
#
#
package OSSL;
use strict;
use POSIX;
use File::Temp qw/ tempfile /;
use IPC::Open3;
use IO::Select;
use Time::Local;
use vars qw/ $log $cnf $opensslversion /;
# Syntax:
# OSSL->new( [path] );
# OSSL->setName( name);
#
sub new {
my $obref = {}; bless $obref;
my $self = shift;
$self = $obref;
my $openssl = shift;
$self->{"openssl"} = "openssl";
$self->{"openssl"} = $::cnf->{_}->{"openssl"} if $::cnf->{_}->{"openssl"};
$self->setOpenSSL($openssl) if $openssl;
$self->{"version"} = undef;
return $self;
}
sub setOpenSSL($$) {
my $self = shift or die "Invalid invocation of CRL::setOpenSSL\n";
my $openssl = shift;
return 0 unless $openssl;
$openssl =~ /\// and ! -x "$openssl" or
$::log->err("OpenSSL binary $openssl is not executable or does not exist")
and return 0;
$::log->verb(4,"Using OpenSSL at $openssl");
$self->{"openssl"} = $openssl;
$self->{"version"} = undef;
return 1;
}
sub getVersion($) {
my $self = shift or die "Invalid invocation of CRL::getVersion\n";
#$self->{"version"} and return $self->{"version"};
$opensslversion and return $opensslversion;
my ($data,$errors) = $self->Exec3(undef,qw/version/);
if ( defined $data ) {
$data =~ /^OpenSSL\s+([\d\.]+\w)/ or
$::log->err("Cannot get OpenSSL version from command: invalid format in $data".($errors?" ($errors)":"")) and
return undef;
$self->{"version"} = $1;
$opensslversion = $self->{"version"};
return $1;
} else {
$::log->err("Cannot get OpenSSL version from command: $errors");
return undef;
}
}
sub Exec3select($$@) {
my $self = shift or die "Invalid invocation of CRL::OpenSSL\n";
my $datain = shift;
my ($dataout, $dataerr) = ("",undef);
my $rc = 0;
local(*CMD_IN, *CMD_OUT, *CMD_ERR);
$::log->verb(6,"Executing openssl",@_);
my $pid = open3(*CMD_IN, *CMD_OUT, *CMD_ERR, $self->{"openssl"}, @_ );
$SIG{CHLD} = sub {
$rc = $? >> 8 if waitpid($pid, 0) > 0
};
$datain and print CMD_IN $datain;
close(CMD_IN);
print STDERR "Printed " . length($datain). " bytes of data\n";
my $selector = IO::Select->new();
$selector->add(*CMD_ERR);
$selector->add(*CMD_OUT);
my ($char,$cnt);
while ($selector->count) {
my @ready = $selector->can_read(1);
#my @ready = IO::Select->select($selector,undef,undef,1);
foreach my $fh (@ready) {
if (fileno($fh) == fileno(CMD_ERR)) {
$cnt = sysread CMD_ERR, $char, 1;
if ( $cnt ) { $dataerr .= $char; }
else { $selector->remove($fh); $dataerr and print STDERR "$dataerr\n";}
} else {
$cnt = sysread CMD_OUT, $char, 1;
if ( $cnt ) { $dataout .= $char; }
else { $selector->remove($fh); $dataout and print STDERR "$dataout\n"; }
}
$selector->remove($fh) if eof($fh);
}
}
close(CMD_OUT);
close(CMD_ERR);
if ( $rc >> 8 ) {
$::log->warn("Execute openssl " . $ARGV[0] . " failed: $rc");
(my $errmsg = $dataerr) =~ s/\n.*//sgm;
$::log->verb(6,"STDERR:",$errmsg);
return undef unless wantarray;
return (undef,$dataerr);
}
return $dataout unless wantarray;
return ($dataout,$dataerr);
}
sub Exec3pipe($$@) {
my $self = shift or die "Invalid invocation of CRL::OpenSSL\n";
my $datain = shift;
my ($dataout, $dataerr) = ("",undef);
my $rc = 0;
local(*CMD_IN, *CMD_OUT, *CMD_ERR);
$::log->verb(6,"Executing openssl",@_);
my ($tmpfh,$tmpname);
$datain and do {
($tmpfh,$tmpname) = tempfile("fetchcrl3.XXXXXX", DIR=>'/tmp');
$|=1;
print $tmpfh $datain;
close $tmpfh;
push @_, "-in", $tmpname;
select undef,undef,undef,0.01;
};
$|=1;
my $pid = open3( *CMD_IN, *CMD_OUT, *CMD_ERR, $self->{"openssl"}, @_ );
# allow delay for child to startup - but will hang on many older platforms
select undef,undef,undef,0.15;
$SIG{CHLD} = sub {
$rc = $? >> 8 if waitpid($pid, 0) > 0
};
#close(CMD_IN);
CMD_OUT->autoflush;
CMD_ERR->autoflush;
my $selector = IO::Select->new();
$selector->add(*CMD_ERR, *CMD_OUT);
while (my @ready = $selector->can_read(0.01)) {
foreach my $fh (@ready) {
if (fileno($fh) == fileno(CMD_ERR)) {$dataerr .= scalar <CMD_ERR>}
else {$dataout .= scalar <CMD_OUT>}
$selector->remove($fh) if eof($fh);
}
}
close(CMD_OUT);
close(CMD_ERR);
$tmpname and unlink $tmpname;
if ( $rc >> 8 ) {
$::log->warn("Execute openssl " . $ARGV[0] . " failed: $rc");
(my $errmsg = $dataerr) =~ s/\n.*//sgm;
$::log->verb(6,"STDERR:",$errmsg);
return undef unless wantarray;
return (undef,$dataerr);
}
return $dataout unless wantarray;
return ($dataout,$dataerr);
}
sub Exec3file($$@) {
my $self = shift or die "Invalid invocation of CRL::OpenSSL\n";
my $datain = shift;
my ($dataout, $dataerr) = ("",undef);
my $rc = 0;
local(*CMD_IN, *CMD_OUT, *CMD_ERR);
$::log->verb(6,"Executing openssl",@_);
my ($tmpin,$tmpinname);
my ($tmpout,$tmpoutname);
my ($tmperr,$tmperrname);
my $tmpdir = $::cnf->{_}->{exec3tmpdir} || $ENV{"TMPDIR"} || '/tmp';
$|=1;
$datain and do {
($tmpin,$tmpinname) = tempfile("fetchcrl3in.XXXXXX",
DIR=>$tmpdir);
print $tmpin $datain;
close $tmpin;
};
($tmpout,$tmpoutname) = tempfile("fetchcrl3out.XXXXXX",
DIR=>$tmpdir);
($tmperr,$tmperrname) = tempfile("fetchcrl3out.XXXXXX",
DIR=>$tmpdir);
my $pid = fork();
defined $pid or
$::log->warn("Internal error, fork for openssl failed: $!") and
return undef;
if ( $pid == 0 ) { # I'm a kid
close STDIN;
if ( $tmpinname ) {
open STDIN, "<", $tmpinname or
die "Cannot open tempfile $tmpinname again $!\n";
} else {
open STDIN, "<", "/dev/null" or
die "Cannot open /dev/null ??? $!\n";
}
close STDOUT;
if ( $tmpoutname ) {
open STDOUT, ">", $tmpoutname or
die "Cannot open tempfile $tmpoutname again $!\n";
} else {
open STDOUT, ">", "/dev/null" or
die "Cannot open /dev/null ??? $!\n";
}
close STDERR;
if ( $tmpoutname ) {
open STDERR, ">", $tmperrname or
die "Cannot open tempfile $tmperrname again $!\n";
} else {
open STDERR, ">", "/dev/null" or
die "Cannot open /dev/null ??? $!\n";
}
exec $self->{"openssl"}, @_;
}
$rc = $? >> 8 if waitpid($pid, 0) > 0;
{ local $/; $dataout = <$tmpout>; };
{ local $/; $dataerr = <$tmperr>; };
$tmpinname and unlink $tmpinname;
$tmpoutname and unlink $tmpoutname;
$tmperrname and unlink $tmperrname;
if ( $rc >> 8 ) {
$::log->warn("Execute openssl " . $ARGV[0] . " failed: $rc");
(my $errmsg = $dataerr) =~ s/\n.*//sgm;
$::log->verb(6,"STDERR:",$errmsg);
return undef unless wantarray;
return (undef,$dataerr);
}
return $dataout unless wantarray;
return ($dataout,$dataerr);
}
sub Exec3($@) {
my $self = shift;
grep /^pipe$/, $::cnf->{_}->{exec3mode}||"" and return $self->Exec3pipe(@_);
grep /^select$/, $::cnf->{_}->{exec3mode}||"" and return $self->Exec3select(@_);
return $self->Exec3file(@_); # default
}
sub gms2t($$) {
my $self = shift;
my ( $month, $mday, $htm, $year, $tz ) = split(/\s+/,$_[0]);
die "OSSL::gms2t: cannot hangle non GMT output from OpenSSL\n"
unless $tz eq "GMT";
my %mon=("Jan"=>0,"Feb"=>1,"Mar"=>2,"Apr"=>3,"May"=>4,"Jun"=>5,
"Jul"=>6,"Aug"=>7,"Sep"=>8,"Oct"=>9,"Nov"=>10,"Dec"=>11);
my ( $hrs,$min,$sec ) = split(/:/,$htm);
my $gmt = timegm($sec,$min,$hrs,$mday,$mon{$month},$year);
#print STDERR ">>> converted $_[0] to $gmt\n";
return $gmt;
}
1;
#
# @(#)$Id$
#
# ###########################################################################
#
#
package TrustAnchor;
use strict;
use File::Basename;
use LWP;
require ConfigTiny and import ConfigTiny unless defined &ConfigTiny::new;
require CRL and import CRL unless defined &CRL::new;
require base64 and import base64 unless defined &base64::b64encode;
use vars qw/ $log $cnf /;
sub new {
my $obref = {}; bless $obref;
my $self = shift;
$self = $obref;
my $name = shift;
$self->{"infodir"} = $cnf->{_}->{infodir};
$self->{"suffix"} = "info";
$self->loadAnchor($name) if defined $name;
return $self;
}
sub saveLogMode($) {
my $self = shift;
return 0 unless defined $self;
$self->{"preserve_warnings"} = $::log->getwarnings;
$self->{"preserve_errors"} = $::log->geterrors;
return 1;
}
sub setLogMode($) {
my $self = shift;
return 0 unless defined $self;
$self->{"nowarnings"} and $::log->setwarnings(0);
$self->{"noerrors"} and $::log->seterrors(0);
return 1;
}
sub restoreLogMode($) {
my $self = shift;
return 0 unless defined $self;
(defined $self->{"preserve_warnings"} and defined $self->{"preserve_errors"})
or die "Internal error: restoreLogMode called without previous save\n";
$::log->setwarnings($self->{"preserve_warnings"});
$::log->seterrors($self->{"preserve_errors"});
return 1;
}
sub getInfodir($$) {
my $self = shift;
my ($path) = shift;
return 0 unless defined $self;
return $self->{"infodir"};
}
sub setInfodir($$) {
my $self = shift;
my ($path) = shift;
return 0 unless defined $path and defined $self;
-e $path or
$::log->err("setInfodir: path $path does not exist") and return 0;
-d $path or
$::log->err("setInfodir: path $path is not a directory") and return 0;
$self->{"infodir"} = $path;
return 1;
}
sub loadAnchor($$) {
my $self = shift;
my ($name) = @_;
return 0 unless defined $name;
$::log->verb(1,"Initializing trust anchor $name");
my ( $basename, $path, $suffix) = fileparse($name,('.info','.crl_url'));
$path = "" if $path eq "./" and substr($name,0,length($path)) ne $path ;
$::log->err("Invalid name of trust anchor $name") and return 0
unless $basename;
$self->{"infodir"} = $path if $path ne "";
$path = $self->{"infodir"} || "";
$path and $path .= "/" unless $path =~ /\/$/;
if ( $suffix ) {
-e $name or
$::log->err("Trust anchor data $name not found") and return 0;
} else { # try and guess which suffix should be used
($suffix eq "" and -e $path.$basename.".info" ) and $suffix = ".info";
($suffix eq "" and -e $path.$basename.".crl_url" ) and $suffix = ".crl_url";
$suffix or
$::log->err("No trust anchor metadata for $basename in '$path'")
and return 0;
}
if ( $suffix eq ".crl_url" ) {
$self->{"alias"} = $basename;
@{$self->{"crlurls"}} = ();
open CRLURL,"$path$basename$suffix" or
$::log->err("Error reading crl_url $path$basename$suffix: $!") and return 0;
$self->{"filename"} = "$path$basename$suffix";
my $urllist;
while (<CRLURL>) {
/^\s*([^#\n]+).*$/ and my $url = $1 or next;
$url =~ s/\s*$//; # trailing whitespace is ignored
$url =~ /^\w+:\/\/.*$/ or
$::log->err("File $path$basename$suffix contains a non-URL entry")
and close CRLURL and return 0;
$urllist and $urllist .= "\001";
$urllist .= $url;
}
close CRLURL;
push @{$self->{"crlurls"}}, $urllist;
$self->{"status"} ||= "unknown";
} else {
my $info = ConfigTiny->new();
$info->read( $path . $basename . $suffix ) or
$::log->err("Error reading info $path$basename$suffix", $info->errstr)
and return 0;
$self->{"filename"} = "$path$basename$suffix";
$info->{_}->{"crl_url"} and $info->{_}->{"crl_url.0"} and
$::log->err("Invalid info for $basename: crl_url and .0 duplicate") and
return 0;
$info->{_}->{"crl_url"} and
$info->{_}->{"crl_url.0"} = $info->{_}->{"crl_url"};
# only do something when there is actually a CRL to process
$info->{_}->{"crl_url.0"} or
$::log->verb(1,"Trust anchor $basename does not have a CRL") and return 0;
$info->{_}->{"alias"} or
$::log->err("Invalid info for $basename: no alias") and
return 0;
$self->{"alias"} = $info->{_}->{"alias"};
@{$self->{"crlurls"}} = ();
for ( my $i=0 ; defined $info->{_}{"crl_url.".$i} ; $i++ ) {
$info->{_}{"crl_url.".$i} =~ s/[;\s]+/\001/g;
$info->{_}{"crl_url.".$i} =~ s/^\s*([^\s]*)\s*$/$1/;
$info->{_}{"crl_url.".$i} =~ /^\w+:\/\// or
$::log->err("File $path$basename$suffix contains a non-URL entry",
$info->{_}{"crl_url.".$i})
and close CRLURL and return 0;
push @{$self->{"crlurls"}} , $info->{_}{"crl_url.".$i};
}
foreach my $field ( qw/email ca_url status/ ) {
$self->{$field} = $info->{_}->{$field} if $info->{_}->{$field};
}
# status of CA is only knwon for info-file based CAs
$self->{"status"} ||= "local";
}
# preserve basename of file for config and diagnostics
$self->{"anchorname"} = $basename;
#
# set defaults for common values
foreach my $key ( qw /
prepend_url postpend_url agingtolerance
httptimeout proctimeout
nowarnings noerrors nocache http_proxy https_proxy
nametemplate_der nametemplate_pem
cadir catemplate statedir
/ ) {
$self->{$key} = $self->{$key} ||
$::cnf->{$self->{"alias"}}->{$key} ||
$::cnf->{$self->{"anchorname"}}->{$key} ||
$::cnf->{_}->{$key} or delete $self->{$key};
defined $self->{$key} and do {
$self->{$key} =~ s/\@ANCHORNAME\@/$self->{"anchorname"}/g;
$self->{$key} =~ s/\@STATUS\@/$self->{"status"}/g;
$self->{$key} =~ s/\@ALIAS\@/$self->{"alias"}/g;
};
}
# reversible toggle options
foreach my $key ( qw / warnings errors cache / ) {
delete $self->{"no$key"} if $::cnf->{$self->{"alias"}}->{$key} or
$::cnf->{$self->{"anchorname"}}->{$key} or
$::cnf->{_}->{$key};
}
foreach my $key ( qw / nohttp_proxy nohttps_proxy noprepend_url nopostpend_url
nostatedir / ) {
(my $nokey = $key) =~ s/^no//;
delete $self->{"$nokey"} if $::cnf->{$self->{"alias"}}->{$key} or
$::cnf->{$self->{"anchorname"}}->{$key} or
$::cnf->{_}->{$key};
}
# overriding of the URLs (alias takes precedence over anchorname
foreach my $section ( qw / anchorname alias / ) {
my $i = 0;
while ( defined ($::cnf->{$self->{$section}}->{"crl_url.".$i}) ) {
my $urls;
($urls=$::cnf->{$self->{$section}}->{"crl_url.".$i} )=~s/[;\s]+/\001/g;
${$self->{"crlurls"}}[$i] = $urls;
$i++;
}
}
# templates to construct a CA name may still have other separators
$self->{"catemplate"} =~ s/[;\s]+/\001/g;
# select only http/https/ftp/file URLs
# also transform the URLs using the base patterns and prepend any
# local URL patterns (@ANCHORNAME@, @ALIAS@, and @R@)
for ( my $i=0; $i <= $#{$self->{"crlurls"}} ; $i++ ) {
my $urlstring = @{$self->{"crlurls"}}[$i];
my @urls = split(/\001/,$urlstring);
$urlstring="";
foreach my $url ( @urls ) {
if ( $url =~ /^(http:|https:|ftp:|file:)/ ) {
$urlstring.="\001" if $urlstring; $urlstring.=$url;
} else {
$::log->verb(0,"URL $url in $basename$suffix unsupported, ignored");
}
}
if ( my $purl = $self->{"prepend_url"} ) {
$purl =~ s/\@R\@/$i/g;
$urlstring = join "\001" , $purl , $urlstring;
}
if ( my $purl = $self->{"postpend_url"} ) {
$purl =~ s/\@R\@/$i/g;
$urlstring = join "\001" , $urlstring, $purl;
}
if ( ! $urlstring ) {
$::log->err("No usable CRL URLs for",$self->getAnchorName);
$self->{"crlurls"}[$i] = "";
} else {
$self->{"crlurls"}[$i] = $urlstring;
}
}
return 1;
}
sub getAnchorName($) {
my $self = shift;
return ($self->{"anchorname"} || undef);
}
sub printAnchorName($) {
my $self = shift;
print "" . ($self->{"anchorname"} || "undefined") ."\n";
}
sub displayAnchorName($) {
my $self = shift;
return ($self->{"anchorname"} || "undefined");
}
sub loadCAfiles($) {
my $self = shift;
my $idx = 0;
# try to find a CA dir, whatever it takes, almost
my $cadir = $self->{"cadir"} || $self->{"infodir"};
-d $cadir or
$::log->err("CA directory",$cadir,"does not exist") and
return 0;
# add @HASH@ support, inducing a file read and fork, only if really needed
my $crlhash;
if ( $self->{"catemplate"} =~ /\@HASH\@/ ) {
$self->{"crl"}[0]{"data"} ne "" or
$::log->err("CA name template contains HASH, but no CRL ".
"could be loaded in time for ".$self->displayAnchorName) and
return 0;
my $probecrl = CRL->new(undef,$self->{"crl"}[0]{"data"});
$crlhash = $probecrl->getAttribute("hash");
$::log->verb(3,"Inferred CA template HASH ".($crlhash?$crlhash:"failed").
" for ".$self->displayAnchorName);
}
@{$self->{"cafile"}} = ();
do {
my $cafile;
foreach my $catpl ( split /\001/, $self->{"catemplate"} ) {
$catpl =~ s/\@R\@/$idx/g;
$catpl =~ s/\@HASH\@/$crlhash/g;
-e $cadir.'/'.$catpl and
$cafile = $cadir.'/'.$catpl and last;
}
defined $cafile or do {
$idx or do $::log->err("Cannot find any CA for",
$self->{"alias"},"in",$cadir);
return $idx?1:0;
};
# is the new one any different from the previous (i.e. is the CA indexed?)
$#{$self->{"cafile"}} >= 0 and
$cafile eq $self->{"cafile"}[$#{$self->{"cafile"}}] and return 1;
push @{$self->{"cafile"}}, $cafile;
$::log->verb(3,"Added CA file $idx: $cafile");
} while(++$idx);
return 0; # you never should come here
}
sub loadState($$) {
my $self = shift;
my $fallbackmode = shift;
$self->{"crlurls"} or
$::log->err("loading state for uninitialised list of CRLs") and return 0;
$self->{"alias"} or
$::log->err("loading state for uninitialised trust anchor") and return 0;
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
if ( $self->{"statedir"} and
-e $self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state'
) {
my $state = ConfigTiny->new();
$state->read($self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state')
or $::log->err("Cannot read existing state file",
$self->{"statedir"}.'/'.$self->{"alias"}.'.$i.state',
" - ",$state->errstr) and return 0;
foreach my $key ( keys %{$state->{$self->{"alias"}}} ) {
$self->{"crl"}[$i]{"state"}{$key} = $state->{$self->{"alias"}}->{$key};
}
}
# fine, but we should find at least an mtime if at all possible
# make sure it is there:
# try to retrieve state from installed files in @output_
# where the first look-alike CRL will win. NSS databases
# are NOT supported for this heuristic
if ( ! defined $self->{"crl"}[$i]{"state"}{"mtime"} ) {
my $mtime;
STATEHUNT: foreach my $output ( ( $::cnf->{_}->{"output"},
$::cnf->{_}->{"output_der"}, $::cnf->{_}->{"output_pem"},
$::cnf->{_}->{"output_nss"}, $::cnf->{_}->{"output_openssl"}) ) {
defined $output and $output or next;
foreach my $ref (
$self->{"nametemplate_der"},
$self->{"nametemplate_pem"},
$self->{"alias"}.".r\@R\@",
$self->{"anchorname"}.".r\@R\@",
) {
next unless $ref;
my $file = $ref; # copy, not to change original
$file =~ s/\@R\@/$i/g;
$file = join "/", $output, $file;
next if ! -e $file;
$mtime = (stat(_))[9];
last STATEHUNT;
}
}
$::log->verb(3,"Inferred mtime for",$self->{"alias"},"is",$mtime) if $mtime;
$self->{"crl"}[$i]{"state"}{"mtime"} = $mtime if $mtime;
}
# as a last resort, set mtime to curren time
$self->{"crl"}[$i]{"state"}{"mtime"} ||= time;
}
return 1;
}
sub saveState($$) {
my $self = shift;
my $fallbackmode = shift;
$self->{"statedir"} and -d $self->{"statedir"} and -w $self->{"statedir"} or
return 0;
$self->{"crlurls"} or
$::log->err("loading state for uninitialised list of CRLs") and return 0;
$self->{"alias"} or
$::log->err("loading state for uninitialised trust anchor") and return 0;
# of state, mtime is set based on CRL write in $output and filled there
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
if ( defined $self->{"statedir"} and
-d $self->{"statedir"}
) {
my $state = ConfigTiny->new;
foreach my $key ( keys %{$self->{"crl"}[$i]{"state"}} ) {
$state->{$self->{"alias"}}->{$key} = $self->{"crl"}[$i]{"state"}{$key};
}
$state->write(
$self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state' );
$::log->verb(5,"State saved in",
$self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state');
}
}
return 1;
}
sub retrieveHTTP($$) {
my $self = shift;
my $idx = shift;
my $url = shift;
my %metadata;
my $data;
$url =~ /^(http:|https:|ftp:)/ or die "retrieveHTTP: non-http URL $url\n";
$::log->verb(3,"Downloading data from $url");
my $ua = LWP::UserAgent->new;
$ua->agent('fetch-crl/'.$::cnf->{_}->{version} . ' ('.
$ua->agent . '; '.$::cnf->{_}->{packager} . ')'
);
# allow overriding of userAgent string to bypass Fortigates and like filters
if ( defined $::cnf->{$self->{"alias"}}->{user_agent} ) {
$ua->agent($::cnf->{$self->{"alias"}}->{user_agent});
$::log->verb(5,"Setting user agent for " .
$self->{"alias"} . " to \"" .
$::cnf->{$self->{"alias"}}->{user_agent} . "\"" );
} elsif ( defined $::cnf->{_}->{user_agent} ) {
$ua->agent($::cnf->{_}->{user_agent});
$::log->verb(5,"Setting user agent to global value \"" .
$::cnf->{_}->{user_agent} . "\"" );
}
$ua->timeout($self->{"httptimeout"});
$ua->use_eval(0);
if ( $self->{"http_proxy"} ) {
if ( $self->{"http_proxy"} =~ /^ENV/i ) {
$ua->env_proxy();
} else {
$ua->proxy(["http","https"], $self->{"http_proxy"});
}
}
if ( $self->{"https_proxy"} ) {
if ( defined $self->{"http_proxy"} and ( $self->{"http_proxy"} =~ /^ENV/i ) ) {
$::log->warn("https_proxy setting cannot be used when ".
"http_proxy is set to ENV, https_proxy setting ignored.");
} else {
$ua->proxy("https", $self->{"https_proxy"});
}
}
# set request cache control if specified as valid in config
if ( defined $::cnf->{_}->{cache_control_request} ) {
$::log->verb(5,"Setting request cache-control to ".
$::cnf->{_}->{cache_control_request});
if ( $::cnf->{_}->{cache_control_request} =~ /^\d+$/ ) {
$ua->default_header('Cache-control' =>
"max-age=".$::cnf->{_}->{cache_control_request} );
} else {
die "Request cache control is invalid (not a number)\n";
}
}
# see with a HEAD request if we can get by with old data
# but to assess that we need Last-Modified from the previous request
# (so if the CA did not send that: too bad)
if ( $self->{"crl"}[$idx]{"state"}{"lastmod"} and
$self->{"crl"}[$idx]{"state"}{"b64data"}
) {
$::log->verb(4,"Lastmod set to",$self->{"crl"}[$idx]{"state"}{"lastmod"});
$::log->verb(4,"Attemping HEAD retrieval of $url");
my $response;
eval {
local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";};
alarm $self->{"httptimeout"};
$response = $ua->head($url);
alarm 0;
};
alarm 0; # make sure the alarm stops ticking, regardless of the eval
if ( $@ ) { # died, alarm hit: server bad, so try next URL
chomp($@);
my $shorterror = $@; $shorterror =~ s/\n.*$//gs;
$::log->verb(2,"HEAD error $url:", $shorterror);
# underlying socket library may be verybose - filter and qualify messages
if ( $shorterror ne $@ ) {
foreach my $errorline ( split(/\n/,$@) ) {
chomp($errorline); $errorline eq $shorterror and next; # nodups
$errorline and $::log->verb(4,"HEAD error detail:", $errorline);
}
}
return undef;
}
# try using cached data if it is fresh
if ( ( ! $@ ) and
$response->is_success and
$response->header("Last-Modified") ) {
my $lastmod = HTTP::Date::str2time($response->header("Last-Modified"));
if ( $lastmod == $self->{"crl"}[$idx]{"state"}{"lastmod"}) {
$::log->verb(4,"HEAD lastmod unchanged, using cache");
$data = base64::b64decode($self->{"crl"}[$idx]{"state"}{"b64data"});
%metadata = (
"freshuntil" => $response->fresh_until(heuristic_expiry=>0)||time,
"lastmod" => $self->{"crl"}[$idx]{"state"}{"lastmod"} || time,
"sourceurl" => $self->{"crl"}[$idx]{"state"}{"sourceurl"} || $url
);
return ($data,%metadata) if wantarray;
return $data;
} elsif ( $lastmod < $self->{"crl"}[$idx]{"state"}{"lastmod"} ) {
# retrieve again, but print warning abount this wierd behaviour
$::log->warn("Retrieved HEAD Last-Modified is older than cache: ".
"cache invalidated, GET issued");
}
}
}
# try get if head fails, there was no cache, cache disabled or invalidated
my $response;
eval {
local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";};
alarm $self->{"httptimeout"};
$ua->parse_head(0);
$response = $ua->get($url);
alarm 0;
};
alarm 0; # make sure the alarm stops ticking, regardless of the eval
if ( $@ ) {
chomp($@);
my $shorterror = $@; $shorterror =~ s/\n.*$//gs;
$::log->verb(0,"Download error $url:", $shorterror);
# underlying socket library may be verybose - filter and qualify messages
if ( $shorterror ne $@ ) {
foreach my $errorline ( split(/\n/,$@) ) {
chomp($errorline); $errorline eq $shorterror and next; # nodups
$errorline and $::log->verb(4,"Download error detail:", $errorline);
}
}
return undef;
}
if ( ! $response->is_success ) {
$::log->verb(0,"Download error $url:",$response->status_line);
return undef;
}
$data = $response->content;
$metadata{"freshuntil"}=$response->fresh_until(heuristic_expiry=>0)||time;
if ( my $lastmod = $response->header("Last-Modified") ) {
$metadata{"lastmod"} = HTTP::Date::str2time($lastmod);
}
$metadata{"sourceurl"} = $url;
return ($data,%metadata) if wantarray;
return $data;
}
sub retrieveFile($$) {
my $self = shift;
my $idx = shift;
my $url = shift;
$url =~ /^file:\/*(\/.*)$/ or die "retrieveFile: non-file URL $url\n";
$::log->verb(4,"Retrieving data from $url");
# for files the previous state does not matter, we retrieve it
# anyway
my $data;
{
open CRLFILE,$1 or do {
$! = "Cannot open $1: $!";
return undef;
};
binmode CRLFILE;
local $/;
$data = <CRLFILE>;
close CRLFILE;
}
my %metadata;
$metadata{"lastmod"} = (stat($1))[9];
$metadata{"freshuntil"} = time;
$metadata{"sourceurl"} = $url;
return ($data,%metadata) if wantarray;
return $data;
}
sub retrieve($) {
my $self = shift;
$self->{"crlurls"} or
$::log->err("Retrieving uninitialised list of CRL URLs") and return 0;
$::log->verb(2,"Retrieving CRLs for",$self->{"alias"});
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
my ($result,%response);
$::log->verb(3,"Retrieving CRL for",$self->{"alias"},"index $i");
# within the list of CRL URLs for a specific index, all entries
# are considered equivalent. I.e., if we get one, the metadata will
# be used for all (like Last-Modified, and cache control data)
# if we have a cached piece of fresh data, return that one
# and make sure the nextupdate in the CRL itself outlives claimed freshness
if ( !$self->{"nocache"} and
($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) > time and
($self->{"crl"}[$i]{"state"}{"nextupdate"} || time) >= time and
($self->{"crl"}[$i]{"state"}{"nextupdate"} || 0) >=
($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) and
$self->{"crl"}[$i]{"state"}{"b64data"} ) {
$::log->verb(3,"Using cached content for",$self->{"alias"},"index",$i);
$::log->verb(4,"Content dated",
scalar gmtime($self->{"crl"}[$i]{"state"}{"lastmod"}),
"valid until",
scalar gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"}),
"UTC");
$result = base64::b64decode($self->{"crl"}[$i]{"state"}{"b64data"});
%response = (
"freshuntil" => $self->{"crl"}[$i]{"state"}{"freshuntil"} || time,
"lastmod" => $self->{"crl"}[$i]{"state"}{"lastmod"} || time,
"sourceurl" => $self->{"crl"}[$i]{"state"}{"sourceurl"} || "null:"
);
} else {
foreach my $url ( split(/\001/,$self->{"crlurls"}[$i]) ) {
# of these, the first one wins
$url =~ /^(http:|https:|ftp:)/ and
($result,%response) = $self->retrieveHTTP($i,$url);
$url =~ /^(file:)/ and
($result,%response) = $self->retrieveFile($i,$url);
last if $result;
}
}
# check if result is there, otherwise invoke agingtolerance clause
# before actually raising this as an error
# note that agingtolerance stats counting only AFTER the freshness
# of the cache control directives has passed ...
if ( ! $result ) {
$::log->verb(1,"CRL retrieval for",
$self->{"alias"},($i?"[$i] ":"")."failed from all URLs");
if ( $self->{"agingtolerance"} && $self->{"crl"}[$i]{"state"}{"mtime"} ) {
if ( ( time - $self->{"crl"}[$i]{"state"}{"mtime"} ) <
3600*$self->{"agingtolerance"}) {
$::log->warn("CRL retrieval for",
$self->{"alias"},($i?"[$i] ":"")."failed,",
int((3600*$self->{"agingtolerance"}+
$self->{"crl"}[$i]{"state"}{"mtime"}-
time )/3600).
" left of ".$self->{"agingtolerance"}."h, retry later.");
} else {
$::log->retr_err("CRL retrieval for",
$self->{"alias"},($i?"[$i] ":"")."failed.",
$self->{"agingtolerance"}."h grace expired.",
"CRL not updated");
}
} else { # direct errors, no tolerance anymore
$::log->retr_err("CRL retrieval for",
$self->{"alias"},($i?"[$i] ":"")."failed,",
"CRL not updated");
}
next; # next subindex CRL for same CA, no further action on this one
}
# now data for $i is loaded in $result;
# for freshness checks, take a sum (SysV style)
my $sum = unpack("%32C*",$result) % 65535;
$::log->verb(4,"Got",length($result),"bytes of data (sum=$sum)");
$self->{"crl"}[$i]{"data"} = $result;
$self->{"crl"}[$i]{"state"}{"alias"} = $self->{"alias"};
$self->{"crl"}[$i]{"state"}{"index"} = $i;
$self->{"crl"}[$i]{"state"}{"sum"} = $sum;
($self->{"crl"}[$i]{"state"}{"b64data"} =
base64::b64encode($result)) =~ s/\s+//gm;
$self->{"crl"}[$i]{"state"}{"retrievaltime"} = time;
$self->{"crl"}[$i]{"state"}{"sourceurl"} = $response{"sourceurl"}||"null:";
$self->{"crl"}[$i]{"state"}{"freshuntil"} = $response{"freshuntil"}||time;
$self->{"crl"}[$i]{"state"}{"lastmod"} = $response{"lastmod"}||time;
}
return 1;
}
sub verifyAndConvertCRLs($) {
my $self = shift;
$self->{"crlurls"} or
$::log->err("Verifying uninitialised list of CRLs impossible") and return 0;
# all CRLs must be valid in order to proceed
# or we would end up shifting the relative ordering around and
# possibly creatiing holes (or overwriting good local copies of
# CRLs that have gone bad on the remote end
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
$self->{"crlurls"}[$i] or
$::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no valid URL)")
and next;
$self->{"crl"}[$i]{"data"} or
$::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no new data)")
and next;
$::log->verb(4,"Verifying CRL $i for",$self->getAnchorName);
my $crl = CRL->new($self->getAnchorName."/$i",$self->{"crl"}[$i]{"data"});
my @verifyMessages= $crl->verify(@{$self->{"cafile"}});
# do additional checks on correlation between download and current
# lastUpdate of current file? have to guess the current file
# unless we are stateful!
my $oldlastupdate = $self->{"crl"}[$i]{"state"}{"lastupdate"} || undef;
$oldlastupdate or do {
$::log->verb(6,"Attempting to extract lastUpdate of previous D/L");
CRLSTATEHUNT: foreach my $output ( @{$::cnf->{_}->{"output_"}} ,
$self->{"infodir"}
) {
foreach my $file (
$self->{"nametemplate_der"},
$self->{"nametemplate_pem"},
$self->{"alias"}.".r\@R\@",
$self->{"anchorname"}.".r\@R\@",
) {
next unless $file;
(my $thisfile = $file ) =~ s/\@R\@/$i/g;
$thisfile = join "/", $output, $thisfile;
$::log->verb(6,"Trying guess $file for old CRL");
next if ! -e $thisfile;
my $oldcrldata; {
open OCF,$thisfile and do {
binmode OCF;
local $/;
$oldcrldata = <OCF>;
close OCF;
}
}
my $oldcrl = CRL->new($thisfile,$oldcrldata);
$oldlastupdate = $oldcrl->getLastUpdate;
last CRLSTATEHUNT;
}
}
$::log->verb(3,"Inferred lastupdate for",$self->{"alias"},"is",
$oldlastupdate) if $oldlastupdate;
};
if ( ! $crl->getLastUpdate ) {
push @verifyMessages,"downloaded CRL lastUpdate could not be derived";
} elsif ( $oldlastupdate and ($crl->getLastUpdate < $oldlastupdate) and
($self->{"crl"}[$i]{"state"}{"mtime"} <= time)
) {
push @verifyMessages,"downloaded CRL lastUpdate predates installed CRL,",
"and current version has sane timestamp";
} elsif ( defined $oldlastupdate and $oldlastupdate > time ) {
$::log->warn($self->{"anchorname"}."/$i:","replaced with downloaded CRL",
"since current one has lastUpdate in the future");
}
$#verifyMessages >= 0 and do {
$::log->retr_err("CRL verification failed for",$self->{"anchorname"}."/$i",
"(".$self->{"alias"}.")");
foreach my $m ( @verifyMessages ) {
$::log->verb(0,$self->{"anchorname"}."/$i:",$m);
}
return 0;
};
$self->{"crl"}[$i]{"pemdata"} = $crl->getPEMdata();
foreach my $key ( qw/ lastupdate nextupdate sha1fp issuer / ) {
$self->{"crl"}[$i]{"state"}{$key} = $crl->getAttribute($key) || "";
}
# issue a low-level warning in case the cache control headers from
# the CA (or its CDN) are bugus, i.e. the CRL wille expire before the
# cache does. Don't log at warning, since the site cannot fix this
if ( defined ($self->{"crl"}[$i]{"state"}{"freshuntil"}) and
( $self->{"crl"}[$i]{"state"}{"freshuntil"} >
( $self->{"crl"}[$i]{"state"}{"nextupdate"} +
$::cnf->{_}->{expirestolerance} )
)
) {
$::log->verb(1,"Cache control headers for CA ".$self->{"alias"}." at ".
"URL ".$self->{"crl"}[$i]{"state"}{"sourceurl"}." have apparent ".
"freshness ".sprintf("%.1f",($self->{"crl"}[$i]{"state"}{"freshuntil"}-
$self->{"crl"}[$i]{"state"}{"nextupdate"})/3600).
"hrs beyond CRL expiration nextUpdate. Reset freshness from ".
gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"})." UTC to ".
$::cnf->{_}->{expirestolerance}." second before nextUpdate at ".
gmtime($self->{"crl"}[$i]{"state"}{"nextupdate"})." UTC.");
$self->{"crl"}[$i]{"state"}{"freshuntil"} =
$self->{"crl"}[$i]{"state"}{"nextupdate"} -
$::cnf->{_}->{expirestolerance};
}
# limit maximum freshness period to compensate for CAs that overdo it
if ( defined ($self->{"crl"}[$i]{"state"}{"freshuntil"}) and
$self->{"crl"}[$i]{"state"}{"freshuntil"} >
(time + $::cnf->{_}->{maxcachetime}) ) {
$self->{"crl"}[$i]{"state"}{"freshuntil"} =
time+$::cnf->{_}->{maxcachetime};
$::log->verb(1,"Cache state freshness expiry for CA ".$self->{"alias"}.
" reset to at most ".
sprintf("%.1f",$::cnf->{_}->{maxcachetime}/3600.).
"hrs beyond current time (".
gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"})." UTC)");
}
}
return 1;
}
1;
#
# Library inspired by the Perl 4 code from base64.pl by A. P. Barrett
# <barrett@ee.und.ac.za>, October 1993, and subsequent changes by
# Earl Hood <earl@earlhood.com> to use MIME::Base64 if available.
#
package base64;
my $use_MIMEBase64 = eval { require MIME::Base64; };
sub b64decode
{
return &MIME::Base64::decode_base64 if $use_MIMEBase64;
local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
use integer;
my $str = shift;
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
length($str) % 4 and
die "Internal error in state: length of base64 data not a multiple of 4";
$str =~ s/=+$//; # remove padding
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
return "" unless length $str;
unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
$str =~ /(.{1,60})/gs) ) );
}
sub b64encode
{
return &MIME::Base64::encode_base64 if $use_MIMEBase64;
local ($_) = shift;
local($^W) = 0;
use integer; # should be faster and more accurate
my $result = pack("u", $_);
$result =~ s/^.//mg;
$result =~ s/\n//g;
$result =~ tr|\` -_|AA-Za-z0-9+/|;
my $padding = (3 - length($_) % 3) % 3;
$result =~ s/.{$padding}$/'=' x $padding/e if $padding;
$result =~ s/(.{1,76})/$1\n/g;
$result;
}
1;