1 |
# |
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 |
$self->{"preserve_warnings"} and $self->{"preserve_errors"} or |
50 |
die "Internal error: restoreLogMode called without previous save\n"; |
51 |
$::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 |
$urllist and $urllist .= ""; |
125 |
$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 |
$info->{_}{"crl_url.".$i} =~ s/[;\s]+//g; |
156 |
$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 |
$self->{$key} = |
188 |
$::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 |
($urls=$::cnf->{$self->{$section}}->{"crl_url.".$i} )=~s/[;\s]+//g; |
217 |
${$self->{"crlurls"}}[$i] = $urls; |
218 |
$i++; |
219 |
} |
220 |
} |
221 |
|
222 |
# templates to construct a CA name may still have other separators |
223 |
$self->{"catemplate"} =~ s/[;\s]+//g; |
224 |
|
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 |
my @urls = split(//,$urlstring); |
231 |
$urlstring=""; |
232 |
foreach my $url ( @urls ) { |
233 |
if ( $url =~ /^(http:|https:|ftp:|file:)/ ) { |
234 |
$urlstring.="" if $urlstring; $urlstring.=$url; |
235 |
} 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 |
$urlstring = join "" , $purl , $urlstring; |
242 |
} |
243 |
if ( my $purl = $self->{"postpend_url"} ) { |
244 |
$purl =~ s/\@R\@/$i/g; |
245 |
$urlstring = join "" , $urlstring, $purl; |
246 |
} |
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 |
sub loadCAfiles($) { |
269 |
my $self = shift; |
270 |
my $idx = 0; |
271 |
|
272 |
-d $self->{"cadir"} or |
273 |
$::log->err("CA directory",$self->{"cadir"},"does not exist") and |
274 |
return 0; |
275 |
|
276 |
@{$self->{"cafile"}} = (); |
277 |
do { |
278 |
my $cafile; |
279 |
foreach my $catpl ( split //, $self->{"catemplate"} ) { |
280 |
$catpl =~ s/\@R\@/$idx/g; |
281 |
-e $self->{"cadir"}.'/'.$catpl and |
282 |
$cafile = $self->{"cadir"}.'/'.$catpl and last; |
283 |
} |
284 |
defined $cafile or do { |
285 |
$idx or do $::log->err("Cannot find any CA for", |
286 |
$self->{"alias"},"in",$self->{"cadir"}); |
287 |
return $idx?1:0; |
288 |
}; |
289 |
push @{$self->{"cafile"}}, $cafile; |
290 |
$::log->verb(3,"Added CA file $idx: $cafile"); |
291 |
} while(++$idx); |
292 |
return 0; # you never should come here |
293 |
} |
294 |
|
295 |
|
296 |
sub loadState($$) { |
297 |
my $self = shift; |
298 |
my $fallbackmode = shift; |
299 |
|
300 |
$self->{"crlurls"} or |
301 |
$::log->err("loading state for uninitialised list of CRLs") and return 0; |
302 |
$self->{"alias"} or |
303 |
$::log->err("loading state for uninitialised trust anchor") and return 0; |
304 |
|
305 |
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
306 |
if ( $self->{"statedir"} and |
307 |
-e $self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state' |
308 |
) { |
309 |
my $state = ConfigTiny->new(); |
310 |
$state->read($self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state') |
311 |
or $::log->err("Cannot read existing state file", |
312 |
$self->{"statedir"}.'/'.$self->{"alias"}.'.$i.state', |
313 |
" - ",$state->errstr) and return 0; |
314 |
foreach my $key ( keys %{$state->{$self->{"alias"}}} ) { |
315 |
$self->{"crl"}[$i]{"state"}{$key} = $state->{$self->{"alias"}}->{$key}; |
316 |
} |
317 |
} |
318 |
|
319 |
# fine, but we should find at least an mtime if at all possible |
320 |
# make sure it is there: |
321 |
# try to retrieve state from installed files in @output_ |
322 |
# where the first look-alike CRL will win. NSS databases |
323 |
# are NOT supported for this heuristic |
324 |
if ( ! defined $self->{"crl"}[$i]{"state"}{"mtime"} ) { |
325 |
my $mtime; |
326 |
STATEHUNT: foreach my $output ( @{$::cnf->{_}->{"output_"}} ) { |
327 |
foreach my $file ( |
328 |
$self->{"nametemplate_der"}, |
329 |
$self->{"nametemplate_pem"}, |
330 |
$self->{"alias"}.".r\@R\@", |
331 |
$self->{"anchorname"}.".r\@R\@", |
332 |
) { |
333 |
next unless $file; |
334 |
$file =~ s/\@R\@/$i/g; |
335 |
$file = join "/", $output, $file; |
336 |
next if ! -e $file; |
337 |
$mtime = (stat(_))[9]; |
338 |
last STATEHUNT; |
339 |
} |
340 |
} |
341 |
$::log->verb(3,"Inferred mtime for",$self->{"alias"},"is",$mtime) if $mtime; |
342 |
$self->{"crl"}[$i]{"state"}{"mtime"} = $mtime if $mtime; |
343 |
} |
344 |
} |
345 |
return 1; |
346 |
} |
347 |
|
348 |
sub saveState($$) { |
349 |
my $self = shift; |
350 |
my $fallbackmode = shift; |
351 |
|
352 |
$self->{"statedir"} and -d $self->{"statedir"} and -w $self->{"statedir"} or |
353 |
return 0; |
354 |
|
355 |
$self->{"crlurls"} or |
356 |
$::log->err("loading state for uninitialised list of CRLs") and return 0; |
357 |
$self->{"alias"} or |
358 |
$::log->err("loading state for uninitialised trust anchor") and return 0; |
359 |
|
360 |
# of state, mtime is set based on CRL write in $output and filled there |
361 |
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
362 |
if ( defined $self->{"statedir"} and |
363 |
-d $self->{"statedir"} |
364 |
) { |
365 |
my $state = ConfigTiny->new; |
366 |
foreach my $key ( keys %{$self->{"crl"}[$i]{"state"}} ) { |
367 |
$state->{$self->{"alias"}}->{$key} = $self->{"crl"}[$i]{"state"}{$key}; |
368 |
} |
369 |
$state->write( |
370 |
$self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state' ); |
371 |
$::log->verb(5,"State saved in", |
372 |
$self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state'); |
373 |
} |
374 |
|
375 |
} |
376 |
return 1; |
377 |
} |
378 |
|
379 |
sub retrieveHTTP($$) { |
380 |
my $self = shift; |
381 |
my $idx = shift; |
382 |
my $url = shift; |
383 |
my %metadata; |
384 |
my $data; |
385 |
|
386 |
$url =~ /^(http:|https:|ftp:)/ or die "retrieveHTTP: non-http URL $url\n"; |
387 |
|
388 |
$::log->verb(3,"Downloading data from $url"); |
389 |
my $ua = LWP::UserAgent->new; |
390 |
$ua->agent('fetch-crl/'.$::cnf->{_}->{version} . ' ('. |
391 |
$ua->agent . '; '.$::cnf->{_}->{packager} . ')' |
392 |
); |
393 |
$ua->timeout($self->{"httptimeout"}); |
394 |
$ua->use_eval(0); |
395 |
if ( $self->{"http_proxy"} ) { |
396 |
if ( $self->{"http_proxy"} =~ /^ENV/i ) { |
397 |
$ua->env_proxy(); |
398 |
} else { |
399 |
$ua->proxy("http", $self->{"http_proxy"}); |
400 |
} |
401 |
} |
402 |
|
403 |
|
404 |
# see with a HEAD request if we can get by with old data |
405 |
# but to assess that we need Last-Modified from the previous request |
406 |
# (so if the CA did not send that: too bad) |
407 |
if ( $self->{"crl"}[$idx]{"state"}{"lastmod"} and |
408 |
$self->{"crl"}[$idx]{"state"}{"b64data"} |
409 |
) { |
410 |
$::log->verb(4,"Lastmod set to",$self->{"crl"}[$idx]{"state"}{"lastmod"}); |
411 |
$::log->verb(4,"Attemping HEAD retrieval of $url"); |
412 |
|
413 |
my $response; |
414 |
eval { |
415 |
local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";}; |
416 |
alarm $self->{"httptimeout"}; |
417 |
$response = $ua->head($url); |
418 |
alarm 0; |
419 |
}; |
420 |
alarm 0; # make sure the alarm stops ticking, regardless of the eval |
421 |
|
422 |
if ( $@ ) { |
423 |
$::log->verb(2,"HEAD error $url:", $@); |
424 |
return undef; |
425 |
} |
426 |
|
427 |
# try get if head fails anyway |
428 |
if ( ( ! $@ ) and |
429 |
$response->is_success and |
430 |
$response->header("Last-Modified") ) { |
431 |
|
432 |
my $lastmod = HTTP::Date::str2time($response->header("Last-Modified")); |
433 |
if ( $lastmod == $self->{"crl"}[$idx]{"state"}{"lastmod"}) { |
434 |
$::log->verb(4,"HEAD lastmod unchanged, using cache"); |
435 |
$data = base64::b64decode($self->{"crl"}[$idx]{"state"}{"b64data"}); |
436 |
%metadata = ( |
437 |
"freshuntil" => $response->fresh_until(heuristic_expiry=>0)||time, |
438 |
"lastmod" => $self->{"crl"}[$idx]{"state"}{"lastmod"} || time, |
439 |
"sourceurl" => $self->{"crl"}[$idx]{"state"}{"sourceurl"} || $url |
440 |
); |
441 |
return ($data,%metadata) if wantarray; |
442 |
return $data; |
443 |
|
444 |
} elsif ( $lastmod < $self->{"crl"}[$idx]{"state"}{"lastmod"} ) { |
445 |
# retrieve again, but print warning abount this wierd behaviour |
446 |
$::log->warn("Retrieved HEAD Last-Modified is older than cache: ". |
447 |
"cache invalidated, GET issued"); |
448 |
} |
449 |
} |
450 |
} |
451 |
|
452 |
# try get if head fails anyway |
453 |
|
454 |
my $response; |
455 |
eval { |
456 |
local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";}; |
457 |
alarm $self->{"httptimeout"}; |
458 |
$response = $ua->get($url); |
459 |
alarm 0; |
460 |
}; |
461 |
alarm 0; # make sure the alarm stops ticking, regardless of the eval |
462 |
|
463 |
if ( $@ ) { |
464 |
chomp($@); |
465 |
$::log->verb(0,"Download error $url:", $@); |
466 |
return undef; |
467 |
} |
468 |
|
469 |
if ( ! $response->is_success ) { |
470 |
$::log->verb(0,"Download error $url:",$response->status_line); |
471 |
return undef; |
472 |
} |
473 |
|
474 |
$data = $response->content; |
475 |
|
476 |
$metadata{"freshuntil"}=$response->fresh_until(heuristic_expiry=>0)||time; |
477 |
if ( my $lastmod = $response->header("Last-Modified") ) { |
478 |
$metadata{"lastmod"} = HTTP::Date::str2time($lastmod); |
479 |
} |
480 |
$metadata{"sourceurl"} = $url; |
481 |
|
482 |
return ($data,%metadata) if wantarray; |
483 |
return $data; |
484 |
} |
485 |
|
486 |
sub retrieveFile($$) { |
487 |
my $self = shift; |
488 |
my $idx = shift; |
489 |
my $url = shift; |
490 |
$url =~ /^file:\/*(\/.*)$/ or die "retrieveFile: non-file URL $url\n"; |
491 |
$::log->verb(4,"Retrieving data from $url"); |
492 |
|
493 |
# for files the previous state does not matter, we retrieve it |
494 |
# anyway |
495 |
|
496 |
my $data; |
497 |
{ |
498 |
open CRLFILE,$1 or do { |
499 |
$! = "Cannot open $1: $!"; |
500 |
return undef; |
501 |
}; |
502 |
binmode CRLFILE; |
503 |
local $/; |
504 |
$data = <CRLFILE>; |
505 |
close CRLFILE; |
506 |
} |
507 |
|
508 |
my %metadata; |
509 |
$metadata{"lastmod"} = (stat($1))[9]; |
510 |
$metadata{"freshuntil"} = time; |
511 |
$metadata{"sourceurl"} = $url; |
512 |
|
513 |
return ($data,%metadata) if wantarray; |
514 |
return $data; |
515 |
} |
516 |
|
517 |
sub retrieve($) { |
518 |
my $self = shift; |
519 |
|
520 |
$self->{"crlurls"} or |
521 |
$::log->err("Retrieving uninitialised list of CRL URLs") and return 0; |
522 |
|
523 |
$::log->verb(2,"Retrieving CRLs for",$self->{"alias"}); |
524 |
|
525 |
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
526 |
my ($result,%response); |
527 |
|
528 |
$::log->verb(3,"Retrieving CRL for",$self->{"alias"},"index $i"); |
529 |
|
530 |
# within the list of CRL URLs for a specific index, all entries |
531 |
# are considered equivalent. I.e., if we get one, the metadata will |
532 |
# be used for all (like Last-Modified, and cache control data) |
533 |
|
534 |
# if we have a cached piece of fresh data, return that one |
535 |
if ( ($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) > time and |
536 |
$self->{"crl"}[$i]{"state"}{"b64data"} ) { |
537 |
$::log->verb(3,"Using cached content for",$self->{"alias"},"index",$i); |
538 |
$::log->verb(4,"Content dated", |
539 |
scalar gmtime($self->{"crl"}[$i]{"state"}{"lastmod"}), |
540 |
"valid until", |
541 |
scalar gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"}), |
542 |
"UTC"); |
543 |
$result = base64::b64decode($self->{"crl"}[$i]{"state"}{"b64data"}); |
544 |
%response = ( |
545 |
"freshuntil" => $self->{"crl"}[$i]{"state"}{"freshuntil"} || time, |
546 |
"lastmod" => $self->{"crl"}[$i]{"state"}{"lastmod"} || time, |
547 |
"sourceurl" => $self->{"crl"}[$i]{"state"}{"sourceurl"} || "null:" |
548 |
); |
549 |
} else { |
550 |
foreach my $url ( split(//,$self->{"crlurls"}[$i]) ) { |
551 |
# of these, the first one wins |
552 |
$url =~ /^(http:|https:|ftp:)/ and |
553 |
($result,%response) = $self->retrieveHTTP($i,$url); |
554 |
$url =~ /^(file:)/ and |
555 |
($result,%response) = $self->retrieveFile($i,$url); |
556 |
last if $result; |
557 |
} |
558 |
} |
559 |
|
560 |
# check if result is there, otherwise invoke agingtolerance clause |
561 |
# before actually raising this as an error |
562 |
# note that agingtolerance stats counting only AFTER the freshness |
563 |
# of the cache control directives has passed ... |
564 |
|
565 |
if ( ! $result ) { |
566 |
|
567 |
$::log->verb(1,"CRL retrieval for", |
568 |
$self->{"alias"},($i?"[$i] ":"")."failed from all URLs"); |
569 |
|
570 |
if ( $self->{"agingtolerance"} && $self->{"crl"}[$i]{"state"}{"mtime"} ) { |
571 |
if ( ( time - $self->{"crl"}[$i]{"state"}{"mtime"} ) < |
572 |
3600*$self->{"agingtolerance"}) { |
573 |
$::log->warn("CRL retrieval for", |
574 |
$self->{"alias"},($i?"[$i] ":"")."failed,", |
575 |
int((3600*$self->{"agingtolerance"}+ |
576 |
$self->{"crl"}[$i]{"state"}{"mtime"}- |
577 |
time )/3600). |
578 |
" left of ".$self->{"agingtolerance"}."h, retry later."); |
579 |
} else { |
580 |
$::log->err("CRL retrieval for", |
581 |
$self->{"alias"},($i?"[$i] ":"")."failed.", |
582 |
$self->{"agingtolerance"}."h grace expired.", |
583 |
"CRL not updated"); |
584 |
} |
585 |
} else { # direct errors, no tolerance anymore |
586 |
$::log->err("CRL retrieval for", |
587 |
$self->{"alias"},($i?"[$i] ":"")."failed,", |
588 |
"CRL not updated"); |
589 |
} |
590 |
next; # next subindex CRL for same CA, no further action on this one |
591 |
} |
592 |
|
593 |
# now data for $i is loaded in $result; |
594 |
# for freshness checks, take a sum (SysV style) |
595 |
my $sum = unpack("%32C*",$result) % 65535; |
596 |
|
597 |
$::log->verb(4,"Got",length($result),"bytes of data (sum=$sum)"); |
598 |
|
599 |
$self->{"crl"}[$i]{"data"} = $result; |
600 |
$self->{"crl"}[$i]{"state"}{"alias"} = $self->{"alias"}; |
601 |
$self->{"crl"}[$i]{"state"}{"index"} = $i; |
602 |
$self->{"crl"}[$i]{"state"}{"sum"} = $sum; |
603 |
($self->{"crl"}[$i]{"state"}{"b64data"} = |
604 |
base64::b64encode($result)) =~ s/\s+//gm; |
605 |
|
606 |
$self->{"crl"}[$i]{"state"}{"retrievaltime"} = time; |
607 |
$self->{"crl"}[$i]{"state"}{"sourceurl"} = $response{"sourceurl"}||"null:"; |
608 |
$self->{"crl"}[$i]{"state"}{"freshuntil"} = |
609 |
($self->{"nocache"}? 0 : $response{"freshuntil"}||time); |
610 |
$self->{"crl"}[$i]{"state"}{"lastmod"} = $response{"lastmod"}||time; |
611 |
|
612 |
} |
613 |
return 1; |
614 |
} |
615 |
|
616 |
sub verifyAndConvertCRLs($) { |
617 |
my $self = shift; |
618 |
$self->{"crlurls"} or |
619 |
$::log->err("Verifying uninitialised list of CRLs impossible") and return 0; |
620 |
|
621 |
# all CRLs must be valid in order to proceed |
622 |
# or we would end up shifting the relative ordering around and |
623 |
# possibly creatiing holes (or overwriting good local copies of |
624 |
# CRLs that have gone bad on the remote end |
625 |
|
626 |
for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices |
627 |
$self->{"crlurls"}[$i] or |
628 |
$::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no valid URL)") |
629 |
and next; |
630 |
$self->{"crl"}[$i]{"data"} or |
631 |
$::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no new data)") |
632 |
and next; |
633 |
$::log->verb(4,"Verifying CRL $i for",$self->getAnchorName); |
634 |
|
635 |
my $crl = CRL->new($self->getAnchorName."/$i",$self->{"crl"}[$i]{"data"}); |
636 |
my @verifyMessages= $crl->verify(@{$self->{"cafile"}}); |
637 |
|
638 |
# do additional checks on correlation between download and current |
639 |
# lastUpdate of current file? have to guess the current file |
640 |
# unless we are stateful! |
641 |
my $oldlastupdate = $self->{"crl"}[$i]{"state"}{"lastupdate"} || undef; |
642 |
$oldlastupdate or do { |
643 |
$::log->verb(6,"Attempting to extract lastUpdate of previous D/L"); |
644 |
CRLSTATEHUNT: foreach my $output ( @{$::cnf->{_}->{"output_"}} , |
645 |
$self->{"infodir"} |
646 |
) { |
647 |
foreach my $file ( |
648 |
$self->{"nametemplate_der"}, |
649 |
$self->{"nametemplate_pem"}, |
650 |
$self->{"alias"}.".r\@R\@", |
651 |
$self->{"anchorname"}.".r\@R\@", |
652 |
) { |
653 |
next unless $file; |
654 |
(my $thisfile = $file ) =~ s/\@R\@/$i/g; |
655 |
$thisfile = join "/", $output, $thisfile; |
656 |
$::log->verb(6,"Trying guess $file for old CRL"); |
657 |
next if ! -e $thisfile; |
658 |
my $oldcrldata; { |
659 |
open OCF,$thisfile and do { |
660 |
binmode OCF; |
661 |
local $/; |
662 |
$oldcrldata = <OCF>; |
663 |
close OCF; |
664 |
} |
665 |
} |
666 |
my $oldcrl = CRL->new($thisfile,$oldcrldata); |
667 |
$oldlastupdate = $oldcrl->getLastUpdate; |
668 |
last CRLSTATEHUNT; |
669 |
} |
670 |
} |
671 |
$::log->verb(3,"Inferred lastupdate for",$self->{"alias"},"is", |
672 |
$oldlastupdate) if $oldlastupdate; |
673 |
}; |
674 |
|
675 |
if ( ! $crl->getLastUpdate ) { |
676 |
push @verifyMessages,"downloaded CRL lastUpdate could not be derived"; |
677 |
} elsif ( $oldlastupdate and ($crl->getLastUpdate < $oldlastupdate) and |
678 |
($self->{"crl"}[$i]{"state"}{"mtime"} < time) |
679 |
) { |
680 |
push @verifyMessages,"downloaded CRL lastUpdate predates installed CRL,", |
681 |
"and current version has sane timestamp"; |
682 |
} elsif ( defined $oldlastupdate and $oldlastupdate > time ) { |
683 |
$::log->warn($self->{"anchorname"}."/$i:","replaced with downloaded CRL", |
684 |
"since current one has lastUpdate in the future"); |
685 |
} |
686 |
|
687 |
$#verifyMessages >= 0 and do { |
688 |
$::log->err("CRL verification failed for",$self->{"anchorname"}."/$i", |
689 |
"(".$self->{"alias"}.")"); |
690 |
foreach my $m ( @verifyMessages ) { |
691 |
$::log->verb(0,$self->{"anchorname"}."/$i:",$m); |
692 |
} |
693 |
return 0; |
694 |
}; |
695 |
|
696 |
$self->{"crl"}[$i]{"pemdata"} = $crl->getPEMdata(); |
697 |
foreach my $key ( qw/ lastupdate nextupdate sha1fp issuer / ) { |
698 |
$self->{"crl"}[$i]{"state"}{$key} = $crl->getAttribute($key) || ""; |
699 |
} |
700 |
} |
701 |
return 1; |
702 |
} |
703 |
|
704 |
|
705 |
1; |
706 |
|