| 1 |
davidg |
1758 |
# |
| 2 |
|
|
# @(#)$Id$ |
| 3 |
|
|
# |
| 4 |
|
|
# ########################################################################### |
| 5 |
|
|
# |
| 6 |
|
|
# |
| 7 |
|
|
package TrustAnchor; |
| 8 |
|
|
use strict; |
| 9 |
|
|
use File::Basename; |
| 10 |
|
|
use LWP; |
| 11 |
|
|
require ConfigTiny and import ConfigTiny unless defined &ConfigTiny::new; |
| 12 |
|
|
require CRL and import CRL unless defined &CRL::new; |
| 13 |
|
|
require base64 and import base64 unless defined &base64::b64encode; |
| 14 |
|
|
use vars qw/ $log $cnf /; |
| 15 |
|
|
|
| 16 |
|
|
sub new { |
| 17 |
|
|
my $obref = {}; bless $obref; |
| 18 |
|
|
my $self = shift; |
| 19 |
|
|
$self = $obref; |
| 20 |
|
|
my $name = shift; |
| 21 |
|
|
|
| 22 |
|
|
$self->{"infodir"} = $cnf->{_}->{infodir}; |
| 23 |
|
|
$self->{"suffix"} = "info"; |
| 24 |
|
|
|
| 25 |
|
|
$self->loadAnchor($name) if defined $name; |
| 26 |
|
|
|
| 27 |
|
|
return $self; |
| 28 |
|
|
} |
| 29 |
|
|
|
| 30 |
|
|
sub saveLogMode($) { |
| 31 |
|
|
my $self = shift; |
| 32 |
|
|
return 0 unless defined $self; |
| 33 |
|
|
$self->{"preserve_warnings"} = $::log->getwarnings; |
| 34 |
|
|
$self->{"preserve_errors"} = $::log->geterrors; |
| 35 |
|
|
return 1; |
| 36 |
|
|
} |
| 37 |
|
|
|
| 38 |
|
|
sub setLogMode($) { |
| 39 |
|
|
my $self = shift; |
| 40 |
|
|
return 0 unless defined $self; |
| 41 |
|
|
$self->{"nowarnings"} and $::log->setwarnings(0); |
| 42 |
|
|
$self->{"noerrors"} and $::log->seterrors(0); |
| 43 |
|
|
return 1; |
| 44 |
|
|
} |
| 45 |
|
|
|
| 46 |
|
|
sub restoreLogMode($) { |
| 47 |
|
|
my $self = shift; |
| 48 |
|
|
return 0 unless defined $self; |
| 49 |
davidg |
2188 |
(defined $self->{"preserve_warnings"} and defined $self->{"preserve_errors"}) |
| 50 |
|
|
or die "Internal error: restoreLogMode called without previous save\n"; |
| 51 |
davidg |
1758 |
$::log->setwarnings($self->{"preserve_warnings"}); |
| 52 |
|
|
$::log->seterrors($self->{"preserve_errors"}); |
| 53 |
|
|
return 1; |
| 54 |
|
|
} |
| 55 |
|
|
|
| 56 |
|
|
sub getInfodir($$) { |
| 57 |
|
|
my $self = shift; |
| 58 |
|
|
my ($path) = shift; |
| 59 |
|
|
return 0 unless defined $self; |
| 60 |
|
|
|
| 61 |
|
|
return $self->{"infodir"}; |
| 62 |
|
|
} |
| 63 |
|
|
|
| 64 |
|
|
sub setInfodir($$) { |
| 65 |
|
|
my $self = shift; |
| 66 |
|
|
my ($path) = shift; |
| 67 |
|
|
return 0 unless defined $path and defined $self; |
| 68 |
|
|
|
| 69 |
|
|
-e $path or |
| 70 |
|
|
$::log->err("setInfodir: path $path does not exist") and return 0; |
| 71 |
|
|
-d $path or |
| 72 |
|
|
$::log->err("setInfodir: path $path is not a directory") and return 0; |
| 73 |
|
|
|
| 74 |
|
|
$self->{"infodir"} = $path; |
| 75 |
|
|
|
| 76 |
|
|
return 1; |
| 77 |
|
|
} |
| 78 |
|
|
|
| 79 |
|
|
|
| 80 |
|
|
sub loadAnchor($$) { |
| 81 |
|
|
my $self = shift; |
| 82 |
|
|
my ($name) = @_; |
| 83 |
|
|
return 0 unless defined $name; |
| 84 |
|
|
|
| 85 |
|
|
$::log->verb(1,"Initializing trust anchor $name"); |
| 86 |
|
|
|
| 87 |
|
|
my ( $basename, $path, $suffix) = fileparse($name,('.info','.crl_url')); |
| 88 |
|
|
|
| 89 |
|
|
$path = "" if $path eq "./" and substr($name,0,length($path)) ne $path ; |
| 90 |
|
|
|
| 91 |
|
|
$::log->err("Invalid name of trust anchor $name") and return 0 |
| 92 |
|
|
unless $basename; |
| 93 |
|
|
|
| 94 |
|
|
$self->{"infodir"} = $path if $path ne ""; |
| 95 |
|
|
$path = $self->{"infodir"} || ""; |
| 96 |
|
|
$path and $path .= "/" unless $path =~ /\/$/; |
| 97 |
|
|
|
| 98 |
|
|
if ( $suffix ) { |
| 99 |
|
|
-e $name or |
| 100 |
|
|
$::log->err("Trust anchor data $name not found") and return 0; |
| 101 |
|
|
} else { # try and guess which suffix should be used |
| 102 |
|
|
($suffix eq "" and -e $path.$basename.".info" ) and $suffix = ".info"; |
| 103 |
|
|
($suffix eq "" and -e $path.$basename.".crl_url" ) and $suffix = ".crl_url"; |
| 104 |
|
|
$suffix or |
| 105 |
|
|
$::log->err("No trust anchor metadata for $basename in '$path'") |
| 106 |
|
|
and return 0; |
| 107 |
|
|
} |
| 108 |
|
|
|
| 109 |
|
|
if ( $suffix eq ".crl_url" ) { |
| 110 |
|
|
|
| 111 |
|
|
$self->{"alias"} = $basename; |
| 112 |
|
|
@{$self->{"crlurls"}} = (); |
| 113 |
|
|
open CRLURL,"$path$basename$suffix" or |
| 114 |
|
|
$::log->err("Error reading crl_url $path$basename$suffix: $!") and return 0; |
| 115 |
|
|
my $urllist; |
| 116 |
|
|
while (<CRLURL>) { |
| 117 |
|
|
/^\s*([^#\n]+).*$/ and my $url = $1 or next; |
| 118 |
|
|
$url =~ s/\s*$//; # trailing whitespace is ignored |
| 119 |
|
|
|
| 120 |
|
|
$url =~ /^\w+:\/\/.*$/ or |
| 121 |
|
|
$::log->err("File $path$basename$suffix contains a non-URL entry") |
| 122 |
|
|
and close CRLURL and return 0; |
| 123 |
|
|
|
| 124 |
davidg |
2305 |
$urllist and $urllist .= "\001"; |
| 125 |
davidg |
1758 |
$urllist .= $url; |
| 126 |
|
|
} |
| 127 |
|
|
close CRLURL; |
| 128 |
|
|
push @{$self->{"crlurls"}}, $urllist; |
| 129 |
|
|
$self->{"status"} ||= "unknown"; |
| 130 |
|
|
|
| 131 |
|
|
} else { |
| 132 |
|
|
|
| 133 |
|
|
my $info = ConfigTiny->new(); |
| 134 |
|
|
$info->read( $path . $basename . $suffix ) or |
| 135 |
|
|
$::log->err("Error reading info $path$basename$suffix", $info->errstr) |
| 136 |
|
|
and return 0; |
| 137 |
|
|
|
| 138 |
|
|
$info->{_}->{"crl_url"} and $info->{_}->{"crl_url.0"} and |
| 139 |
|
|
$::log->err("Invalid info for $basename: crl_url and .0 duplicate") and |
| 140 |
|
|
return 0; |
| 141 |
|
|
$info->{_}->{"crl_url"} and |
| 142 |
|
|
$info->{_}->{"crl_url.0"} = $info->{_}->{"crl_url"}; |
| 143 |
|
|
|
| 144 |
|
|
# only do something when there is actually a CRL to process |
| 145 |
|
|
$info->{_}->{"crl_url.0"} or |
| 146 |
|
|
$::log->verb(1,"Trust anchor $basename does not have a CRL") and return 0; |
| 147 |
|
|
|
| 148 |
|
|
$info->{_}->{"alias"} or |
| 149 |
|
|
$::log->err("Invalid info for $basename: no alias") and |
| 150 |
|
|
return 0; |
| 151 |
|
|
$self->{"alias"} = $info->{_}->{"alias"}; |
| 152 |
|
|
|
| 153 |
|
|
@{$self->{"crlurls"}} = (); |
| 154 |
|
|
for ( my $i=0 ; defined $info->{_}{"crl_url.".$i} ; $i++ ) { |
| 155 |
davidg |
2305 |
$info->{_}{"crl_url.".$i} =~ s/[;\s]+/\001/g; |
| 156 |
davidg |
1758 |
$info->{_}{"crl_url.".$i} =~ s/^\s*([^\s]*)\s*$/$1/; |
| 157 |
|
|
|
| 158 |
|
|
$info->{_}{"crl_url.".$i} =~ /^\w+:\/\// or |
| 159 |
|
|
$::log->err("File $path$basename$suffix contains a non-URL entry", |
| 160 |
|
|
$info->{_}{"crl_url.".$i}) |
| 161 |
|
|
and close CRLURL and return 0; |
| 162 |
|
|
|
| 163 |
|
|
push @{$self->{"crlurls"}} , $info->{_}{"crl_url.".$i}; |
| 164 |
|
|
} |
| 165 |
|
|
|
| 166 |
|
|
foreach my $field ( qw/email ca_url status/ ) { |
| 167 |
|
|
$self->{$field} = $info->{_}->{$field} if $info->{_}->{$field}; |
| 168 |
|
|
} |
| 169 |
|
|
|
| 170 |
|
|
# status of CA is only knwon for info-file based CAs |
| 171 |
|
|
$self->{"status"} ||= "local"; |
| 172 |
|
|
|
| 173 |
|
|
} |
| 174 |
|
|
|
| 175 |
|
|
# preserve basename of file for config and diagnostics |
| 176 |
|
|
$self->{"anchorname"} = $basename; |
| 177 |
|
|
|
| 178 |
|
|
# |
| 179 |
|
|
# set defaults for common values |
| 180 |
|
|
foreach my $key ( qw / |
| 181 |
|
|
prepend_url postpend_url agingtolerance |
| 182 |
|
|
httptimeout proctimeout |
| 183 |
|
|
nowarnings noerrors nocache http_proxy |
| 184 |
|
|
nametemplate_der nametemplate_pem |
| 185 |
|
|
cadir catemplate statedir |
| 186 |
|
|
/ ) { |
| 187 |
davidg |
1767 |
$self->{$key} = $self->{$key} || |
| 188 |
davidg |
1758 |
$::cnf->{$self->{"alias"}}->{$key} || |
| 189 |
|
|
$::cnf->{$self->{"anchorname"}}->{$key} || |
| 190 |
|
|
$::cnf->{_}->{$key} or delete $self->{$key}; |
| 191 |
|
|
defined $self->{$key} and do { |
| 192 |
|
|
$self->{$key} =~ s/\@ANCHORNAME\@/$self->{"anchorname"}/g; |
| 193 |
|
|
$self->{$key} =~ s/\@STATUS\@/$self->{"status"}/g; |
| 194 |
|
|
$self->{$key} =~ s/\@ALIAS\@/$self->{"alias"}/g; |
| 195 |
|
|
}; |
| 196 |
|
|
} |
| 197 |
|
|
# reversible toggle options |
| 198 |
|
|
foreach my $key ( qw / warnings errors cache / ) { |
| 199 |
|
|
delete $self->{"no$key"} if $::cnf->{$self->{"alias"}}->{$key} or |
| 200 |
|
|
$::cnf->{$self->{"anchorname"}}->{$key} or |
| 201 |
|
|
$::cnf->{_}->{$key}; |
| 202 |
|
|
} |
| 203 |
|
|
foreach my $key ( qw / nohttp_proxy noprepend_url nopostpend_url |
| 204 |
|
|
nostatedir / ) { |
| 205 |
|
|
(my $nokey = $key) =~ s/^no//; |
| 206 |
|
|
delete $self->{"$nokey"} if $::cnf->{$self->{"alias"}}->{$key} or |
| 207 |
|
|
$::cnf->{$self->{"anchorname"}}->{$key} or |
| 208 |
|
|
$::cnf->{_}->{$key}; |
| 209 |
|
|
} |
| 210 |
|
|
|
| 211 |
|
|
# overriding of the URLs (alias takes precedence over anchorname |
| 212 |
|
|
foreach my $section ( qw / anchorname alias / ) { |
| 213 |
|
|
my $i = 0; |
| 214 |
|
|
while ( defined ($::cnf->{$self->{$section}}->{"crl_url.".$i}) ) { |
| 215 |
|
|
my $urls; |
| 216 |
davidg |
2305 |
($urls=$::cnf->{$self->{$section}}->{"crl_url.".$i} )=~s/[;\s]+/\001/g; |
| 217 |
davidg |
1758 |
${$self->{"crlurls"}}[$i] = $urls; |
| 218 |
|
|
$i++; |
| 219 |
|
|
} |
| 220 |
|
|
} |
| 221 |
|
|
|
| 222 |
|
|
# templates to construct a CA name may still have other separators |
| 223 |
davidg |
2305 |
$self->{"catemplate"} =~ s/[;\s]+/\001/g; |
| 224 |
davidg |
1758 |
|
| 225 |
|
|
# select only http/https/ftp/file URLs |
| 226 |
|
|
# also transform the URLs using the base patterns and prepend any |
| 227 |
|
|
# local URL patterns (@ANCHORNAME@, @ALIAS@, and @R@) |
| 228 |
|
|
for ( my $i=0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { |
| 229 |
|
|
my $urlstring = @{$self->{"crlurls"}}[$i]; |
| 230 |
davidg |
2305 |
my @urls = split(/\001/,$urlstring); |
| 231 |
davidg |
1758 |
$urlstring=""; |
| 232 |
|
|
foreach my $url ( @urls ) { |
| 233 |
|
|
if ( $url =~ /^(http:|https:|ftp:|file:)/ ) { |
| 234 |
davidg |
2305 |
$urlstring.="\001" if $urlstring; $urlstring.=$url; |
| 235 |
davidg |
1758 |
} else { |
| 236 |
|
|
$::log->verb(0,"URL $url in $basename$suffix unsupported, ignored"); |
| 237 |
|
|
} |
| 238 |
|
|
} |
| 239 |
|
|
if ( my $purl = $self->{"prepend_url"} ) { |
| 240 |
|
|
$purl =~ s/\@R\@/$i/g; |
| 241 |
davidg |
2305 |
$urlstring = join "\001" , $purl , $urlstring; |
| 242 |
davidg |
1758 |
} |
| 243 |
|
|
if ( my $purl = $self->{"postpend_url"} ) { |
| 244 |
|
|
$purl =~ s/\@R\@/$i/g; |
| 245 |
davidg |
2305 |
$urlstring = join "\001" , $urlstring, $purl; |
| 246 |
davidg |
1758 |
} |
| 247 |
|
|
if ( ! $urlstring ) { |
| 248 |
|
|
$::log->err("No usable CRL URLs for",$self->getAnchorName); |
| 249 |
|
|
$self->{"crlurls"}[$i] = ""; |
| 250 |
|
|
} else { |
| 251 |
|
|
$self->{"crlurls"}[$i] = $urlstring; |
| 252 |
|
|
} |
| 253 |
|
|
} |
| 254 |
|
|
|
| 255 |
|
|
return 1; |
| 256 |
|
|
} |
| 257 |
|
|
|
| 258 |
|
|
sub getAnchorName($) { |
| 259 |
|
|
my $self = shift; |
| 260 |
|
|
return ($self->{"anchorname"} || undef); |
| 261 |
|
|
} |
| 262 |
|
|
|
| 263 |
|
|
sub printAnchorName($) { |
| 264 |
|
|
my $self = shift; |
| 265 |
|
|
print "" . ($self->{"anchorname"} || "undefined") ."\n"; |
| 266 |
|
|
} |
| 267 |
|
|
|
| 268 |
davidg |
2420 |
sub displayAnchorName($) { |
| 269 |
|
|
my $self = shift; |
| 270 |
|
|
return ($self->{"anchorname"} || "undefined"); |
| 271 |
|
|
} |
| 272 |
|
|
|
| 273 |
davidg |
1758 |
sub loadCAfiles($) { |
| 274 |
|
|
my $self = shift; |
| 275 |
|
|
my $idx = 0; |
| 276 |
|
|
|
| 277 |
davidg |
1767 |
# try to find a CA dir, whatever it takes, almost |
| 278 |
|
|
my $cadir = $self->{"cadir"} || $self->{"infodir"}; |
| 279 |
|
|
|
| 280 |
|
|
-d $cadir or |
| 281 |
|
|
$::log->err("CA directory",$cadir,"does not exist") and |
| 282 |
davidg |
1758 |
return 0; |
| 283 |
|
|
|
| 284 |
davidg |
2420 |
# add @HASH@ support, inducing a file read and fork, only if really needed |
| 285 |
|
|
my $crlhash; |
| 286 |
|
|
if ( $self->{"catemplate"} =~ /\@HASH\@/ ) { |
| 287 |
|
|
$self->{"crl"}[0]{"data"} ne "" or |
| 288 |
|
|
$::log->err("CA name template contains HASH, but no CRL ". |
| 289 |
|
|
"could be loaded in time for ".$self->displayAnchorName) and |
| 290 |
|
|
return 0; |
| 291 |
|
|
my $probecrl = CRL->new(undef,$self->{"crl"}[0]{"data"}); |
| 292 |
|
|
$crlhash = $probecrl->getAttribute("hash"); |
| 293 |
|
|
$::log->verb(3,"Inferred CA template HASH ".($crlhash?$crlhash:"failed"). |
| 294 |
|
|
" for ".$self->displayAnchorName); |
| 295 |
|
|
} |
| 296 |
|
|
|
| 297 |
davidg |
1758 |
@{$self->{"cafile"}} = (); |
| 298 |
|
|
do { |
| 299 |
|
|
my $cafile; |
| 300 |
davidg |
2420 |
|
| 301 |
davidg |
2305 |
foreach my $catpl ( split /\001/, $self->{"catemplate"} ) { |
| 302 |
davidg |
1758 |
$catpl =~ s/\@R\@/$idx/g; |
| 303 |
davidg |
2420 |
$catpl =~ s/\@HASH\@/$crlhash/g; |
| 304 |
davidg |
1767 |
-e $cadir.'/'.$catpl and |
| 305 |
|
|
$cafile = $cadir.'/'.$catpl and last; |
| 306 |
davidg |
1758 |
} |
| 307 |
|
|
defined $cafile or do { |
| 308 |
|
|
$idx or do $::log->err("Cannot find any CA for", |
| 309 |
davidg |
1767 |
$self->{"alias"},"in",$cadir); |
| 310 |
davidg |
1758 |
return $idx?1:0; |
| 311 |
|
|
}; |
| 312 |
davidg |
1878 |
# is the new one any different from the previous (i.e. is the CA indexed?) |
| 313 |
|
|
$#{$self->{"cafile"}} >= 0 and |
| 314 |
|
|
$cafile eq $self->{"cafile"}[$#{$self->{"cafile"}}] and return 1; |
| 315 |
davidg |
1758 |
push @{$self->{"cafile"}}, $cafile; |
| 316 |
|
|
$::log->verb(3,"Added CA file $idx: $cafile"); |
| 317 |
|
|
} while(++$idx); |
| 318 |
|
|
return 0; # you never should come here |
| 319 |
|
|
} |
| 320 |
|
|
|
| 321 |
|
|
|
| 322 |
|
|
sub loadState($$) { |
| 323 |
|
|
my $self = shift; |
| 324 |
|
|
my $fallbackmode = shift; |
| 325 |
|
|
|
| 326 |
|
|
$self->{"crlurls"} or |
| 327 |
|
|
$::log->err("loading state for uninitialised list of CRLs") and return 0; |
| 328 |
|
|
$self->{"alias"} or |
| 329 |
|
|
$::log->err("loading state for uninitialised trust anchor") and return 0; |
| 330 |
|
|
|
| 331 |
|
|
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
| 332 |
|
|
if ( $self->{"statedir"} and |
| 333 |
|
|
-e $self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state' |
| 334 |
|
|
) { |
| 335 |
|
|
my $state = ConfigTiny->new(); |
| 336 |
|
|
$state->read($self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state') |
| 337 |
|
|
or $::log->err("Cannot read existing state file", |
| 338 |
|
|
$self->{"statedir"}.'/'.$self->{"alias"}.'.$i.state', |
| 339 |
|
|
" - ",$state->errstr) and return 0; |
| 340 |
|
|
foreach my $key ( keys %{$state->{$self->{"alias"}}} ) { |
| 341 |
|
|
$self->{"crl"}[$i]{"state"}{$key} = $state->{$self->{"alias"}}->{$key}; |
| 342 |
|
|
} |
| 343 |
|
|
} |
| 344 |
|
|
|
| 345 |
|
|
# fine, but we should find at least an mtime if at all possible |
| 346 |
|
|
# make sure it is there: |
| 347 |
|
|
# try to retrieve state from installed files in @output_ |
| 348 |
|
|
# where the first look-alike CRL will win. NSS databases |
| 349 |
|
|
# are NOT supported for this heuristic |
| 350 |
|
|
if ( ! defined $self->{"crl"}[$i]{"state"}{"mtime"} ) { |
| 351 |
|
|
my $mtime; |
| 352 |
davidg |
1901 |
STATEHUNT: foreach my $output ( ( $::cnf->{_}->{"output"}, |
| 353 |
|
|
$::cnf->{_}->{"output_der"}, $::cnf->{_}->{"output_pem"}, |
| 354 |
|
|
$::cnf->{_}->{"output_nss"}, $::cnf->{_}->{"output_openssl"}) ) { |
| 355 |
|
|
defined $output and $output or next; |
| 356 |
davidg |
2305 |
foreach my $ref ( |
| 357 |
davidg |
1758 |
$self->{"nametemplate_der"}, |
| 358 |
|
|
$self->{"nametemplate_pem"}, |
| 359 |
|
|
$self->{"alias"}.".r\@R\@", |
| 360 |
|
|
$self->{"anchorname"}.".r\@R\@", |
| 361 |
|
|
) { |
| 362 |
davidg |
2305 |
next unless $ref; |
| 363 |
|
|
my $file = $ref; # copy, not to change original |
| 364 |
davidg |
1758 |
$file =~ s/\@R\@/$i/g; |
| 365 |
|
|
$file = join "/", $output, $file; |
| 366 |
|
|
next if ! -e $file; |
| 367 |
|
|
$mtime = (stat(_))[9]; |
| 368 |
|
|
last STATEHUNT; |
| 369 |
|
|
} |
| 370 |
|
|
} |
| 371 |
|
|
$::log->verb(3,"Inferred mtime for",$self->{"alias"},"is",$mtime) if $mtime; |
| 372 |
|
|
$self->{"crl"}[$i]{"state"}{"mtime"} = $mtime if $mtime; |
| 373 |
|
|
} |
| 374 |
davidg |
1901 |
|
| 375 |
|
|
# as a last resort, set mtime to curren time |
| 376 |
|
|
$self->{"crl"}[$i]{"state"}{"mtime"} ||= time; |
| 377 |
|
|
|
| 378 |
davidg |
1758 |
} |
| 379 |
|
|
return 1; |
| 380 |
|
|
} |
| 381 |
|
|
|
| 382 |
|
|
sub saveState($$) { |
| 383 |
|
|
my $self = shift; |
| 384 |
|
|
my $fallbackmode = shift; |
| 385 |
|
|
|
| 386 |
|
|
$self->{"statedir"} and -d $self->{"statedir"} and -w $self->{"statedir"} or |
| 387 |
|
|
return 0; |
| 388 |
|
|
|
| 389 |
|
|
$self->{"crlurls"} or |
| 390 |
|
|
$::log->err("loading state for uninitialised list of CRLs") and return 0; |
| 391 |
|
|
$self->{"alias"} or |
| 392 |
|
|
$::log->err("loading state for uninitialised trust anchor") and return 0; |
| 393 |
|
|
|
| 394 |
|
|
# of state, mtime is set based on CRL write in $output and filled there |
| 395 |
|
|
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
| 396 |
|
|
if ( defined $self->{"statedir"} and |
| 397 |
|
|
-d $self->{"statedir"} |
| 398 |
|
|
) { |
| 399 |
|
|
my $state = ConfigTiny->new; |
| 400 |
|
|
foreach my $key ( keys %{$self->{"crl"}[$i]{"state"}} ) { |
| 401 |
|
|
$state->{$self->{"alias"}}->{$key} = $self->{"crl"}[$i]{"state"}{$key}; |
| 402 |
|
|
} |
| 403 |
|
|
$state->write( |
| 404 |
|
|
$self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state' ); |
| 405 |
|
|
$::log->verb(5,"State saved in", |
| 406 |
|
|
$self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state'); |
| 407 |
|
|
} |
| 408 |
|
|
|
| 409 |
|
|
} |
| 410 |
|
|
return 1; |
| 411 |
|
|
} |
| 412 |
|
|
|
| 413 |
|
|
sub retrieveHTTP($$) { |
| 414 |
|
|
my $self = shift; |
| 415 |
|
|
my $idx = shift; |
| 416 |
|
|
my $url = shift; |
| 417 |
|
|
my %metadata; |
| 418 |
|
|
my $data; |
| 419 |
|
|
|
| 420 |
|
|
$url =~ /^(http:|https:|ftp:)/ or die "retrieveHTTP: non-http URL $url\n"; |
| 421 |
|
|
|
| 422 |
|
|
$::log->verb(3,"Downloading data from $url"); |
| 423 |
|
|
my $ua = LWP::UserAgent->new; |
| 424 |
|
|
$ua->agent('fetch-crl/'.$::cnf->{_}->{version} . ' ('. |
| 425 |
|
|
$ua->agent . '; '.$::cnf->{_}->{packager} . ')' |
| 426 |
|
|
); |
| 427 |
|
|
$ua->timeout($self->{"httptimeout"}); |
| 428 |
|
|
$ua->use_eval(0); |
| 429 |
|
|
if ( $self->{"http_proxy"} ) { |
| 430 |
|
|
if ( $self->{"http_proxy"} =~ /^ENV/i ) { |
| 431 |
|
|
$ua->env_proxy(); |
| 432 |
|
|
} else { |
| 433 |
|
|
$ua->proxy("http", $self->{"http_proxy"}); |
| 434 |
|
|
} |
| 435 |
|
|
} |
| 436 |
|
|
|
| 437 |
|
|
|
| 438 |
|
|
# see with a HEAD request if we can get by with old data |
| 439 |
|
|
# but to assess that we need Last-Modified from the previous request |
| 440 |
|
|
# (so if the CA did not send that: too bad) |
| 441 |
|
|
if ( $self->{"crl"}[$idx]{"state"}{"lastmod"} and |
| 442 |
|
|
$self->{"crl"}[$idx]{"state"}{"b64data"} |
| 443 |
|
|
) { |
| 444 |
|
|
$::log->verb(4,"Lastmod set to",$self->{"crl"}[$idx]{"state"}{"lastmod"}); |
| 445 |
|
|
$::log->verb(4,"Attemping HEAD retrieval of $url"); |
| 446 |
|
|
|
| 447 |
|
|
my $response; |
| 448 |
|
|
eval { |
| 449 |
|
|
local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";}; |
| 450 |
|
|
alarm $self->{"httptimeout"}; |
| 451 |
|
|
$response = $ua->head($url); |
| 452 |
|
|
alarm 0; |
| 453 |
|
|
}; |
| 454 |
|
|
alarm 0; # make sure the alarm stops ticking, regardless of the eval |
| 455 |
|
|
|
| 456 |
|
|
if ( $@ ) { |
| 457 |
|
|
$::log->verb(2,"HEAD error $url:", $@); |
| 458 |
|
|
return undef; |
| 459 |
|
|
} |
| 460 |
|
|
|
| 461 |
|
|
# try get if head fails anyway |
| 462 |
|
|
if ( ( ! $@ ) and |
| 463 |
|
|
$response->is_success and |
| 464 |
|
|
$response->header("Last-Modified") ) { |
| 465 |
|
|
|
| 466 |
|
|
my $lastmod = HTTP::Date::str2time($response->header("Last-Modified")); |
| 467 |
|
|
if ( $lastmod == $self->{"crl"}[$idx]{"state"}{"lastmod"}) { |
| 468 |
|
|
$::log->verb(4,"HEAD lastmod unchanged, using cache"); |
| 469 |
|
|
$data = base64::b64decode($self->{"crl"}[$idx]{"state"}{"b64data"}); |
| 470 |
|
|
%metadata = ( |
| 471 |
|
|
"freshuntil" => $response->fresh_until(heuristic_expiry=>0)||time, |
| 472 |
|
|
"lastmod" => $self->{"crl"}[$idx]{"state"}{"lastmod"} || time, |
| 473 |
|
|
"sourceurl" => $self->{"crl"}[$idx]{"state"}{"sourceurl"} || $url |
| 474 |
|
|
); |
| 475 |
|
|
return ($data,%metadata) if wantarray; |
| 476 |
|
|
return $data; |
| 477 |
|
|
|
| 478 |
|
|
} elsif ( $lastmod < $self->{"crl"}[$idx]{"state"}{"lastmod"} ) { |
| 479 |
|
|
# retrieve again, but print warning abount this wierd behaviour |
| 480 |
|
|
$::log->warn("Retrieved HEAD Last-Modified is older than cache: ". |
| 481 |
|
|
"cache invalidated, GET issued"); |
| 482 |
|
|
} |
| 483 |
|
|
} |
| 484 |
|
|
} |
| 485 |
|
|
|
| 486 |
|
|
# try get if head fails anyway |
| 487 |
|
|
|
| 488 |
|
|
my $response; |
| 489 |
|
|
eval { |
| 490 |
|
|
local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";}; |
| 491 |
|
|
alarm $self->{"httptimeout"}; |
| 492 |
davidg |
2232 |
$ua->parse_head(0); |
| 493 |
davidg |
1758 |
$response = $ua->get($url); |
| 494 |
|
|
alarm 0; |
| 495 |
|
|
}; |
| 496 |
|
|
alarm 0; # make sure the alarm stops ticking, regardless of the eval |
| 497 |
|
|
|
| 498 |
|
|
if ( $@ ) { |
| 499 |
|
|
chomp($@); |
| 500 |
|
|
$::log->verb(0,"Download error $url:", $@); |
| 501 |
|
|
return undef; |
| 502 |
|
|
} |
| 503 |
|
|
|
| 504 |
|
|
if ( ! $response->is_success ) { |
| 505 |
|
|
$::log->verb(0,"Download error $url:",$response->status_line); |
| 506 |
|
|
return undef; |
| 507 |
|
|
} |
| 508 |
|
|
|
| 509 |
|
|
$data = $response->content; |
| 510 |
|
|
|
| 511 |
|
|
$metadata{"freshuntil"}=$response->fresh_until(heuristic_expiry=>0)||time; |
| 512 |
|
|
if ( my $lastmod = $response->header("Last-Modified") ) { |
| 513 |
|
|
$metadata{"lastmod"} = HTTP::Date::str2time($lastmod); |
| 514 |
|
|
} |
| 515 |
|
|
$metadata{"sourceurl"} = $url; |
| 516 |
|
|
|
| 517 |
|
|
return ($data,%metadata) if wantarray; |
| 518 |
|
|
return $data; |
| 519 |
|
|
} |
| 520 |
|
|
|
| 521 |
|
|
sub retrieveFile($$) { |
| 522 |
|
|
my $self = shift; |
| 523 |
|
|
my $idx = shift; |
| 524 |
|
|
my $url = shift; |
| 525 |
|
|
$url =~ /^file:\/*(\/.*)$/ or die "retrieveFile: non-file URL $url\n"; |
| 526 |
|
|
$::log->verb(4,"Retrieving data from $url"); |
| 527 |
|
|
|
| 528 |
|
|
# for files the previous state does not matter, we retrieve it |
| 529 |
|
|
# anyway |
| 530 |
|
|
|
| 531 |
|
|
my $data; |
| 532 |
|
|
{ |
| 533 |
|
|
open CRLFILE,$1 or do { |
| 534 |
|
|
$! = "Cannot open $1: $!"; |
| 535 |
|
|
return undef; |
| 536 |
|
|
}; |
| 537 |
|
|
binmode CRLFILE; |
| 538 |
|
|
local $/; |
| 539 |
|
|
$data = <CRLFILE>; |
| 540 |
|
|
close CRLFILE; |
| 541 |
|
|
} |
| 542 |
|
|
|
| 543 |
|
|
my %metadata; |
| 544 |
|
|
$metadata{"lastmod"} = (stat($1))[9]; |
| 545 |
|
|
$metadata{"freshuntil"} = time; |
| 546 |
|
|
$metadata{"sourceurl"} = $url; |
| 547 |
|
|
|
| 548 |
|
|
return ($data,%metadata) if wantarray; |
| 549 |
|
|
return $data; |
| 550 |
|
|
} |
| 551 |
|
|
|
| 552 |
|
|
sub retrieve($) { |
| 553 |
|
|
my $self = shift; |
| 554 |
|
|
|
| 555 |
|
|
$self->{"crlurls"} or |
| 556 |
|
|
$::log->err("Retrieving uninitialised list of CRL URLs") and return 0; |
| 557 |
|
|
|
| 558 |
|
|
$::log->verb(2,"Retrieving CRLs for",$self->{"alias"}); |
| 559 |
|
|
|
| 560 |
|
|
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
| 561 |
|
|
my ($result,%response); |
| 562 |
|
|
|
| 563 |
|
|
$::log->verb(3,"Retrieving CRL for",$self->{"alias"},"index $i"); |
| 564 |
|
|
|
| 565 |
|
|
# within the list of CRL URLs for a specific index, all entries |
| 566 |
|
|
# are considered equivalent. I.e., if we get one, the metadata will |
| 567 |
|
|
# be used for all (like Last-Modified, and cache control data) |
| 568 |
|
|
|
| 569 |
|
|
# if we have a cached piece of fresh data, return that one |
| 570 |
davidg |
1763 |
if ( !$self->{"nocache"} and |
| 571 |
|
|
($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) > time and |
| 572 |
davidg |
2085 |
($self->{"crl"}[$i]{"state"}{"nextupdate"} || time) >= time and |
| 573 |
davidg |
1758 |
$self->{"crl"}[$i]{"state"}{"b64data"} ) { |
| 574 |
|
|
$::log->verb(3,"Using cached content for",$self->{"alias"},"index",$i); |
| 575 |
|
|
$::log->verb(4,"Content dated", |
| 576 |
|
|
scalar gmtime($self->{"crl"}[$i]{"state"}{"lastmod"}), |
| 577 |
|
|
"valid until", |
| 578 |
|
|
scalar gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"}), |
| 579 |
|
|
"UTC"); |
| 580 |
|
|
$result = base64::b64decode($self->{"crl"}[$i]{"state"}{"b64data"}); |
| 581 |
|
|
%response = ( |
| 582 |
|
|
"freshuntil" => $self->{"crl"}[$i]{"state"}{"freshuntil"} || time, |
| 583 |
|
|
"lastmod" => $self->{"crl"}[$i]{"state"}{"lastmod"} || time, |
| 584 |
|
|
"sourceurl" => $self->{"crl"}[$i]{"state"}{"sourceurl"} || "null:" |
| 585 |
|
|
); |
| 586 |
|
|
} else { |
| 587 |
davidg |
2305 |
foreach my $url ( split(/\001/,$self->{"crlurls"}[$i]) ) { |
| 588 |
davidg |
1758 |
# of these, the first one wins |
| 589 |
|
|
$url =~ /^(http:|https:|ftp:)/ and |
| 590 |
|
|
($result,%response) = $self->retrieveHTTP($i,$url); |
| 591 |
|
|
$url =~ /^(file:)/ and |
| 592 |
|
|
($result,%response) = $self->retrieveFile($i,$url); |
| 593 |
|
|
last if $result; |
| 594 |
|
|
} |
| 595 |
|
|
} |
| 596 |
|
|
|
| 597 |
|
|
# check if result is there, otherwise invoke agingtolerance clause |
| 598 |
|
|
# before actually raising this as an error |
| 599 |
|
|
# note that agingtolerance stats counting only AFTER the freshness |
| 600 |
|
|
# of the cache control directives has passed ... |
| 601 |
|
|
|
| 602 |
|
|
if ( ! $result ) { |
| 603 |
|
|
|
| 604 |
|
|
$::log->verb(1,"CRL retrieval for", |
| 605 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed from all URLs"); |
| 606 |
|
|
|
| 607 |
|
|
if ( $self->{"agingtolerance"} && $self->{"crl"}[$i]{"state"}{"mtime"} ) { |
| 608 |
|
|
if ( ( time - $self->{"crl"}[$i]{"state"}{"mtime"} ) < |
| 609 |
|
|
3600*$self->{"agingtolerance"}) { |
| 610 |
|
|
$::log->warn("CRL retrieval for", |
| 611 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed,", |
| 612 |
|
|
int((3600*$self->{"agingtolerance"}+ |
| 613 |
|
|
$self->{"crl"}[$i]{"state"}{"mtime"}- |
| 614 |
|
|
time )/3600). |
| 615 |
|
|
" left of ".$self->{"agingtolerance"}."h, retry later."); |
| 616 |
|
|
} else { |
| 617 |
|
|
$::log->err("CRL retrieval for", |
| 618 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed.", |
| 619 |
|
|
$self->{"agingtolerance"}."h grace expired.", |
| 620 |
|
|
"CRL not updated"); |
| 621 |
|
|
} |
| 622 |
|
|
} else { # direct errors, no tolerance anymore |
| 623 |
|
|
$::log->err("CRL retrieval for", |
| 624 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed,", |
| 625 |
|
|
"CRL not updated"); |
| 626 |
|
|
} |
| 627 |
|
|
next; # next subindex CRL for same CA, no further action on this one |
| 628 |
|
|
} |
| 629 |
|
|
|
| 630 |
|
|
# now data for $i is loaded in $result; |
| 631 |
|
|
# for freshness checks, take a sum (SysV style) |
| 632 |
|
|
my $sum = unpack("%32C*",$result) % 65535; |
| 633 |
|
|
|
| 634 |
|
|
$::log->verb(4,"Got",length($result),"bytes of data (sum=$sum)"); |
| 635 |
|
|
|
| 636 |
|
|
$self->{"crl"}[$i]{"data"} = $result; |
| 637 |
|
|
$self->{"crl"}[$i]{"state"}{"alias"} = $self->{"alias"}; |
| 638 |
|
|
$self->{"crl"}[$i]{"state"}{"index"} = $i; |
| 639 |
|
|
$self->{"crl"}[$i]{"state"}{"sum"} = $sum; |
| 640 |
|
|
($self->{"crl"}[$i]{"state"}{"b64data"} = |
| 641 |
|
|
base64::b64encode($result)) =~ s/\s+//gm; |
| 642 |
|
|
|
| 643 |
|
|
$self->{"crl"}[$i]{"state"}{"retrievaltime"} = time; |
| 644 |
|
|
$self->{"crl"}[$i]{"state"}{"sourceurl"} = $response{"sourceurl"}||"null:"; |
| 645 |
davidg |
1763 |
$self->{"crl"}[$i]{"state"}{"freshuntil"} = $response{"freshuntil"}||time; |
| 646 |
davidg |
1758 |
$self->{"crl"}[$i]{"state"}{"lastmod"} = $response{"lastmod"}||time; |
| 647 |
|
|
|
| 648 |
|
|
} |
| 649 |
|
|
return 1; |
| 650 |
|
|
} |
| 651 |
|
|
|
| 652 |
|
|
sub verifyAndConvertCRLs($) { |
| 653 |
|
|
my $self = shift; |
| 654 |
|
|
$self->{"crlurls"} or |
| 655 |
|
|
$::log->err("Verifying uninitialised list of CRLs impossible") and return 0; |
| 656 |
|
|
|
| 657 |
|
|
# all CRLs must be valid in order to proceed |
| 658 |
|
|
# or we would end up shifting the relative ordering around and |
| 659 |
|
|
# possibly creatiing holes (or overwriting good local copies of |
| 660 |
|
|
# CRLs that have gone bad on the remote end |
| 661 |
|
|
|
| 662 |
|
|
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
| 663 |
|
|
$self->{"crlurls"}[$i] or |
| 664 |
|
|
$::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no valid URL)") |
| 665 |
|
|
and next; |
| 666 |
|
|
$self->{"crl"}[$i]{"data"} or |
| 667 |
|
|
$::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no new data)") |
| 668 |
|
|
and next; |
| 669 |
|
|
$::log->verb(4,"Verifying CRL $i for",$self->getAnchorName); |
| 670 |
|
|
|
| 671 |
|
|
my $crl = CRL->new($self->getAnchorName."/$i",$self->{"crl"}[$i]{"data"}); |
| 672 |
|
|
my @verifyMessages= $crl->verify(@{$self->{"cafile"}}); |
| 673 |
|
|
|
| 674 |
|
|
# do additional checks on correlation between download and current |
| 675 |
|
|
# lastUpdate of current file? have to guess the current file |
| 676 |
|
|
# unless we are stateful! |
| 677 |
|
|
my $oldlastupdate = $self->{"crl"}[$i]{"state"}{"lastupdate"} || undef; |
| 678 |
|
|
$oldlastupdate or do { |
| 679 |
|
|
$::log->verb(6,"Attempting to extract lastUpdate of previous D/L"); |
| 680 |
|
|
CRLSTATEHUNT: foreach my $output ( @{$::cnf->{_}->{"output_"}} , |
| 681 |
|
|
$self->{"infodir"} |
| 682 |
|
|
) { |
| 683 |
|
|
foreach my $file ( |
| 684 |
|
|
$self->{"nametemplate_der"}, |
| 685 |
|
|
$self->{"nametemplate_pem"}, |
| 686 |
|
|
$self->{"alias"}.".r\@R\@", |
| 687 |
|
|
$self->{"anchorname"}.".r\@R\@", |
| 688 |
|
|
) { |
| 689 |
|
|
next unless $file; |
| 690 |
|
|
(my $thisfile = $file ) =~ s/\@R\@/$i/g; |
| 691 |
|
|
$thisfile = join "/", $output, $thisfile; |
| 692 |
|
|
$::log->verb(6,"Trying guess $file for old CRL"); |
| 693 |
|
|
next if ! -e $thisfile; |
| 694 |
|
|
my $oldcrldata; { |
| 695 |
|
|
open OCF,$thisfile and do { |
| 696 |
|
|
binmode OCF; |
| 697 |
|
|
local $/; |
| 698 |
|
|
$oldcrldata = <OCF>; |
| 699 |
|
|
close OCF; |
| 700 |
|
|
} |
| 701 |
|
|
} |
| 702 |
|
|
my $oldcrl = CRL->new($thisfile,$oldcrldata); |
| 703 |
|
|
$oldlastupdate = $oldcrl->getLastUpdate; |
| 704 |
|
|
last CRLSTATEHUNT; |
| 705 |
|
|
} |
| 706 |
|
|
} |
| 707 |
|
|
$::log->verb(3,"Inferred lastupdate for",$self->{"alias"},"is", |
| 708 |
|
|
$oldlastupdate) if $oldlastupdate; |
| 709 |
|
|
}; |
| 710 |
|
|
|
| 711 |
|
|
if ( ! $crl->getLastUpdate ) { |
| 712 |
|
|
push @verifyMessages,"downloaded CRL lastUpdate could not be derived"; |
| 713 |
|
|
} elsif ( $oldlastupdate and ($crl->getLastUpdate < $oldlastupdate) and |
| 714 |
davidg |
1901 |
($self->{"crl"}[$i]{"state"}{"mtime"} <= time) |
| 715 |
davidg |
1758 |
) { |
| 716 |
|
|
push @verifyMessages,"downloaded CRL lastUpdate predates installed CRL,", |
| 717 |
|
|
"and current version has sane timestamp"; |
| 718 |
|
|
} elsif ( defined $oldlastupdate and $oldlastupdate > time ) { |
| 719 |
|
|
$::log->warn($self->{"anchorname"}."/$i:","replaced with downloaded CRL", |
| 720 |
|
|
"since current one has lastUpdate in the future"); |
| 721 |
|
|
} |
| 722 |
|
|
|
| 723 |
|
|
$#verifyMessages >= 0 and do { |
| 724 |
|
|
$::log->err("CRL verification failed for",$self->{"anchorname"}."/$i", |
| 725 |
|
|
"(".$self->{"alias"}.")"); |
| 726 |
|
|
foreach my $m ( @verifyMessages ) { |
| 727 |
|
|
$::log->verb(0,$self->{"anchorname"}."/$i:",$m); |
| 728 |
|
|
} |
| 729 |
|
|
return 0; |
| 730 |
|
|
}; |
| 731 |
|
|
|
| 732 |
|
|
$self->{"crl"}[$i]{"pemdata"} = $crl->getPEMdata(); |
| 733 |
|
|
foreach my $key ( qw/ lastupdate nextupdate sha1fp issuer / ) { |
| 734 |
|
|
$self->{"crl"}[$i]{"state"}{$key} = $crl->getAttribute($key) || ""; |
| 735 |
|
|
} |
| 736 |
|
|
} |
| 737 |
|
|
return 1; |
| 738 |
|
|
} |
| 739 |
|
|
|
| 740 |
|
|
|
| 741 |
|
|
1; |
| 742 |
|
|
|
Parent Directory
| 
Revision Log