#! /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} ) {
  &parallel_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;