/[pdpsoft]/nl.nikhef.pdp.fetchcrl/trunk/TrustAnchor.pm
ViewVC logotype

Contents of /nl.nikhef.pdp.fetchcrl/trunk/TrustAnchor.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3275 - (show annotations) (download) (as text)
Thu Jan 16 20:33:09 2020 UTC (21 months ago) by davidg
File MIME type: application/x-perl
File size: 28912 byte(s)
Allow overriding of UserAgent strings of the perl LWP libwww-perl. This mitigates hyperactive Fortigates that block libwww-perl clients

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 (defined $self->{"preserve_warnings"} and defined $self->{"preserve_errors"})
50 or 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 $self->{"filename"} = "$path$basename$suffix";
116 my $urllist;
117 while (<CRLURL>) {
118 /^\s*([^#\n]+).*$/ and my $url = $1 or next;
119 $url =~ s/\s*$//; # trailing whitespace is ignored
120
121 $url =~ /^\w+:\/\/.*$/ or
122 $::log->err("File $path$basename$suffix contains a non-URL entry")
123 and close CRLURL and return 0;
124
125 $urllist and $urllist .= "\001";
126 $urllist .= $url;
127 }
128 close CRLURL;
129 push @{$self->{"crlurls"}}, $urllist;
130 $self->{"status"} ||= "unknown";
131
132 } else {
133
134 my $info = ConfigTiny->new();
135 $info->read( $path . $basename . $suffix ) or
136 $::log->err("Error reading info $path$basename$suffix", $info->errstr)
137 and return 0;
138 $self->{"filename"} = "$path$basename$suffix";
139
140 $info->{_}->{"crl_url"} and $info->{_}->{"crl_url.0"} and
141 $::log->err("Invalid info for $basename: crl_url and .0 duplicate") and
142 return 0;
143 $info->{_}->{"crl_url"} and
144 $info->{_}->{"crl_url.0"} = $info->{_}->{"crl_url"};
145
146 # only do something when there is actually a CRL to process
147 $info->{_}->{"crl_url.0"} or
148 $::log->verb(1,"Trust anchor $basename does not have a CRL") and return 0;
149
150 $info->{_}->{"alias"} or
151 $::log->err("Invalid info for $basename: no alias") and
152 return 0;
153 $self->{"alias"} = $info->{_}->{"alias"};
154
155 @{$self->{"crlurls"}} = ();
156 for ( my $i=0 ; defined $info->{_}{"crl_url.".$i} ; $i++ ) {
157 $info->{_}{"crl_url.".$i} =~ s/[;\s]+/\001/g;
158 $info->{_}{"crl_url.".$i} =~ s/^\s*([^\s]*)\s*$/$1/;
159
160 $info->{_}{"crl_url.".$i} =~ /^\w+:\/\// or
161 $::log->err("File $path$basename$suffix contains a non-URL entry",
162 $info->{_}{"crl_url.".$i})
163 and close CRLURL and return 0;
164
165 push @{$self->{"crlurls"}} , $info->{_}{"crl_url.".$i};
166 }
167
168 foreach my $field ( qw/email ca_url status/ ) {
169 $self->{$field} = $info->{_}->{$field} if $info->{_}->{$field};
170 }
171
172 # status of CA is only knwon for info-file based CAs
173 $self->{"status"} ||= "local";
174
175 }
176
177 # preserve basename of file for config and diagnostics
178 $self->{"anchorname"} = $basename;
179
180 #
181 # set defaults for common values
182 foreach my $key ( qw /
183 prepend_url postpend_url agingtolerance
184 httptimeout proctimeout
185 nowarnings noerrors nocache http_proxy
186 nametemplate_der nametemplate_pem
187 cadir catemplate statedir
188 / ) {
189 $self->{$key} = $self->{$key} ||
190 $::cnf->{$self->{"alias"}}->{$key} ||
191 $::cnf->{$self->{"anchorname"}}->{$key} ||
192 $::cnf->{_}->{$key} or delete $self->{$key};
193 defined $self->{$key} and do {
194 $self->{$key} =~ s/\@ANCHORNAME\@/$self->{"anchorname"}/g;
195 $self->{$key} =~ s/\@STATUS\@/$self->{"status"}/g;
196 $self->{$key} =~ s/\@ALIAS\@/$self->{"alias"}/g;
197 };
198 }
199 # reversible toggle options
200 foreach my $key ( qw / warnings errors cache / ) {
201 delete $self->{"no$key"} if $::cnf->{$self->{"alias"}}->{$key} or
202 $::cnf->{$self->{"anchorname"}}->{$key} or
203 $::cnf->{_}->{$key};
204 }
205 foreach my $key ( qw / nohttp_proxy noprepend_url nopostpend_url
206 nostatedir / ) {
207 (my $nokey = $key) =~ s/^no//;
208 delete $self->{"$nokey"} if $::cnf->{$self->{"alias"}}->{$key} or
209 $::cnf->{$self->{"anchorname"}}->{$key} or
210 $::cnf->{_}->{$key};
211 }
212
213 # overriding of the URLs (alias takes precedence over anchorname
214 foreach my $section ( qw / anchorname alias / ) {
215 my $i = 0;
216 while ( defined ($::cnf->{$self->{$section}}->{"crl_url.".$i}) ) {
217 my $urls;
218 ($urls=$::cnf->{$self->{$section}}->{"crl_url.".$i} )=~s/[;\s]+/\001/g;
219 ${$self->{"crlurls"}}[$i] = $urls;
220 $i++;
221 }
222 }
223
224 # templates to construct a CA name may still have other separators
225 $self->{"catemplate"} =~ s/[;\s]+/\001/g;
226
227 # select only http/https/ftp/file URLs
228 # also transform the URLs using the base patterns and prepend any
229 # local URL patterns (@ANCHORNAME@, @ALIAS@, and @R@)
230 for ( my $i=0; $i <= $#{$self->{"crlurls"}} ; $i++ ) {
231 my $urlstring = @{$self->{"crlurls"}}[$i];
232 my @urls = split(/\001/,$urlstring);
233 $urlstring="";
234 foreach my $url ( @urls ) {
235 if ( $url =~ /^(http:|https:|ftp:|file:)/ ) {
236 $urlstring.="\001" if $urlstring; $urlstring.=$url;
237 } else {
238 $::log->verb(0,"URL $url in $basename$suffix unsupported, ignored");
239 }
240 }
241 if ( my $purl = $self->{"prepend_url"} ) {
242 $purl =~ s/\@R\@/$i/g;
243 $urlstring = join "\001" , $purl , $urlstring;
244 }
245 if ( my $purl = $self->{"postpend_url"} ) {
246 $purl =~ s/\@R\@/$i/g;
247 $urlstring = join "\001" , $urlstring, $purl;
248 }
249 if ( ! $urlstring ) {
250 $::log->err("No usable CRL URLs for",$self->getAnchorName);
251 $self->{"crlurls"}[$i] = "";
252 } else {
253 $self->{"crlurls"}[$i] = $urlstring;
254 }
255 }
256
257 return 1;
258 }
259
260 sub getAnchorName($) {
261 my $self = shift;
262 return ($self->{"anchorname"} || undef);
263 }
264
265 sub printAnchorName($) {
266 my $self = shift;
267 print "" . ($self->{"anchorname"} || "undefined") ."\n";
268 }
269
270 sub displayAnchorName($) {
271 my $self = shift;
272 return ($self->{"anchorname"} || "undefined");
273 }
274
275 sub loadCAfiles($) {
276 my $self = shift;
277 my $idx = 0;
278
279 # try to find a CA dir, whatever it takes, almost
280 my $cadir = $self->{"cadir"} || $self->{"infodir"};
281
282 -d $cadir or
283 $::log->err("CA directory",$cadir,"does not exist") and
284 return 0;
285
286 # add @HASH@ support, inducing a file read and fork, only if really needed
287 my $crlhash;
288 if ( $self->{"catemplate"} =~ /\@HASH\@/ ) {
289 $self->{"crl"}[0]{"data"} ne "" or
290 $::log->err("CA name template contains HASH, but no CRL ".
291 "could be loaded in time for ".$self->displayAnchorName) and
292 return 0;
293 my $probecrl = CRL->new(undef,$self->{"crl"}[0]{"data"});
294 $crlhash = $probecrl->getAttribute("hash");
295 $::log->verb(3,"Inferred CA template HASH ".($crlhash?$crlhash:"failed").
296 " for ".$self->displayAnchorName);
297 }
298
299 @{$self->{"cafile"}} = ();
300 do {
301 my $cafile;
302
303 foreach my $catpl ( split /\001/, $self->{"catemplate"} ) {
304 $catpl =~ s/\@R\@/$idx/g;
305 $catpl =~ s/\@HASH\@/$crlhash/g;
306 -e $cadir.'/'.$catpl and
307 $cafile = $cadir.'/'.$catpl and last;
308 }
309 defined $cafile or do {
310 $idx or do $::log->err("Cannot find any CA for",
311 $self->{"alias"},"in",$cadir);
312 return $idx?1:0;
313 };
314 # is the new one any different from the previous (i.e. is the CA indexed?)
315 $#{$self->{"cafile"}} >= 0 and
316 $cafile eq $self->{"cafile"}[$#{$self->{"cafile"}}] and return 1;
317 push @{$self->{"cafile"}}, $cafile;
318 $::log->verb(3,"Added CA file $idx: $cafile");
319 } while(++$idx);
320 return 0; # you never should come here
321 }
322
323
324 sub loadState($$) {
325 my $self = shift;
326 my $fallbackmode = shift;
327
328 $self->{"crlurls"} or
329 $::log->err("loading state for uninitialised list of CRLs") and return 0;
330 $self->{"alias"} or
331 $::log->err("loading state for uninitialised trust anchor") and return 0;
332
333 for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
334 if ( $self->{"statedir"} and
335 -e $self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state'
336 ) {
337 my $state = ConfigTiny->new();
338 $state->read($self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state')
339 or $::log->err("Cannot read existing state file",
340 $self->{"statedir"}.'/'.$self->{"alias"}.'.$i.state',
341 " - ",$state->errstr) and return 0;
342 foreach my $key ( keys %{$state->{$self->{"alias"}}} ) {
343 $self->{"crl"}[$i]{"state"}{$key} = $state->{$self->{"alias"}}->{$key};
344 }
345 }
346
347 # fine, but we should find at least an mtime if at all possible
348 # make sure it is there:
349 # try to retrieve state from installed files in @output_
350 # where the first look-alike CRL will win. NSS databases
351 # are NOT supported for this heuristic
352 if ( ! defined $self->{"crl"}[$i]{"state"}{"mtime"} ) {
353 my $mtime;
354 STATEHUNT: foreach my $output ( ( $::cnf->{_}->{"output"},
355 $::cnf->{_}->{"output_der"}, $::cnf->{_}->{"output_pem"},
356 $::cnf->{_}->{"output_nss"}, $::cnf->{_}->{"output_openssl"}) ) {
357 defined $output and $output or next;
358 foreach my $ref (
359 $self->{"nametemplate_der"},
360 $self->{"nametemplate_pem"},
361 $self->{"alias"}.".r\@R\@",
362 $self->{"anchorname"}.".r\@R\@",
363 ) {
364 next unless $ref;
365 my $file = $ref; # copy, not to change original
366 $file =~ s/\@R\@/$i/g;
367 $file = join "/", $output, $file;
368 next if ! -e $file;
369 $mtime = (stat(_))[9];
370 last STATEHUNT;
371 }
372 }
373 $::log->verb(3,"Inferred mtime for",$self->{"alias"},"is",$mtime) if $mtime;
374 $self->{"crl"}[$i]{"state"}{"mtime"} = $mtime if $mtime;
375 }
376
377 # as a last resort, set mtime to curren time
378 $self->{"crl"}[$i]{"state"}{"mtime"} ||= time;
379
380 }
381 return 1;
382 }
383
384 sub saveState($$) {
385 my $self = shift;
386 my $fallbackmode = shift;
387
388 $self->{"statedir"} and -d $self->{"statedir"} and -w $self->{"statedir"} or
389 return 0;
390
391 $self->{"crlurls"} or
392 $::log->err("loading state for uninitialised list of CRLs") and return 0;
393 $self->{"alias"} or
394 $::log->err("loading state for uninitialised trust anchor") and return 0;
395
396 # of state, mtime is set based on CRL write in $output and filled there
397 for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
398 if ( defined $self->{"statedir"} and
399 -d $self->{"statedir"}
400 ) {
401 my $state = ConfigTiny->new;
402 foreach my $key ( keys %{$self->{"crl"}[$i]{"state"}} ) {
403 $state->{$self->{"alias"}}->{$key} = $self->{"crl"}[$i]{"state"}{$key};
404 }
405 $state->write(
406 $self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state' );
407 $::log->verb(5,"State saved in",
408 $self->{"statedir"}.'/'.$self->{"alias"}.'.'.$i.'.state');
409 }
410
411 }
412 return 1;
413 }
414
415 sub retrieveHTTP($$) {
416 my $self = shift;
417 my $idx = shift;
418 my $url = shift;
419 my %metadata;
420 my $data;
421
422 $url =~ /^(http:|https:|ftp:)/ or die "retrieveHTTP: non-http URL $url\n";
423
424 $::log->verb(3,"Downloading data from $url");
425 my $ua = LWP::UserAgent->new;
426
427 $ua->agent('fetch-crl/'.$::cnf->{_}->{version} . ' ('.
428 $ua->agent . '; '.$::cnf->{_}->{packager} . ')'
429 );
430 # allow overriding of userAgent string to bypass Fortigates and like filters
431 if ( defined $::cnf->{$self->{"alias"}}->{user_agent} ) {
432 $ua->agent($::cnf->{$self->{"alias"}}->{user_agent});
433 $::log->verb(5,"Setting user agent for " .
434 $self->{"alias"} . " to \"" .
435 $::cnf->{$self->{"alias"}}->{user_agent} . "\"" );
436 } elsif ( defined $::cnf->{_}->{user_agent} ) {
437 $ua->agent($::cnf->{_}->{user_agent});
438 $::log->verb(5,"Setting user agent to global value \"" .
439 $::cnf->{_}->{user_agent} . "\"" );
440 }
441
442 $ua->timeout($self->{"httptimeout"});
443 $ua->use_eval(0);
444 if ( $self->{"http_proxy"} ) {
445 if ( $self->{"http_proxy"} =~ /^ENV/i ) {
446 $ua->env_proxy();
447 } else {
448 $ua->proxy("http", $self->{"http_proxy"});
449 }
450 }
451 # set request cache control if specified as valid in config
452 if ( defined $::cnf->{_}->{cache_control_request} ) {
453 $::log->verb(5,"Setting request cache-control to ".
454 $::cnf->{_}->{cache_control_request});
455 if ( $::cnf->{_}->{cache_control_request} =~ /^\d+$/ ) {
456 $ua->default_header('Cache-control' =>
457 "max-age=".$::cnf->{_}->{cache_control_request} );
458 } else {
459 die "Request cache control is invalid (not a number)\n";
460 }
461 }
462
463 # see with a HEAD request if we can get by with old data
464 # but to assess that we need Last-Modified from the previous request
465 # (so if the CA did not send that: too bad)
466 if ( $self->{"crl"}[$idx]{"state"}{"lastmod"} and
467 $self->{"crl"}[$idx]{"state"}{"b64data"}
468 ) {
469 $::log->verb(4,"Lastmod set to",$self->{"crl"}[$idx]{"state"}{"lastmod"});
470 $::log->verb(4,"Attemping HEAD retrieval of $url");
471
472 my $response;
473 eval {
474 local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";};
475 alarm $self->{"httptimeout"};
476 $response = $ua->head($url);
477 alarm 0;
478 };
479 alarm 0; # make sure the alarm stops ticking, regardless of the eval
480
481 if ( $@ ) { # died, alarm hit: server bad, so try next URL
482 chomp($@);
483 my $shorterror = $@; $shorterror =~ s/\n.*$//gs;
484 $::log->verb(2,"HEAD error $url:", $shorterror);
485 # underlying socket library may be verybose - filter and qualify messages
486 if ( $shorterror ne $@ ) {
487 foreach my $errorline ( split(/\n/,$@) ) {
488 chomp($errorline); $errorline eq $shorterror and next; # nodups
489 $errorline and $::log->verb(4,"HEAD error detail:", $errorline);
490 }
491 }
492 return undef;
493 }
494
495 # try using cached data if it is fresh
496 if ( ( ! $@ ) and
497 $response->is_success and
498 $response->header("Last-Modified") ) {
499
500 my $lastmod = HTTP::Date::str2time($response->header("Last-Modified"));
501 if ( $lastmod == $self->{"crl"}[$idx]{"state"}{"lastmod"}) {
502 $::log->verb(4,"HEAD lastmod unchanged, using cache");
503 $data = base64::b64decode($self->{"crl"}[$idx]{"state"}{"b64data"});
504 %metadata = (
505 "freshuntil" => $response->fresh_until(heuristic_expiry=>0)||time,
506 "lastmod" => $self->{"crl"}[$idx]{"state"}{"lastmod"} || time,
507 "sourceurl" => $self->{"crl"}[$idx]{"state"}{"sourceurl"} || $url
508 );
509 return ($data,%metadata) if wantarray;
510 return $data;
511
512 } elsif ( $lastmod < $self->{"crl"}[$idx]{"state"}{"lastmod"} ) {
513 # retrieve again, but print warning abount this wierd behaviour
514 $::log->warn("Retrieved HEAD Last-Modified is older than cache: ".
515 "cache invalidated, GET issued");
516 }
517 }
518 }
519
520 # try get if head fails, there was no cache, cache disabled or invalidated
521
522 my $response;
523 eval {
524 local $SIG{ALRM}=sub{die "timed out after ".$self->{"httptimeout"}."s\n";};
525 alarm $self->{"httptimeout"};
526 $ua->parse_head(0);
527 $response = $ua->get($url);
528 alarm 0;
529 };
530 alarm 0; # make sure the alarm stops ticking, regardless of the eval
531
532 if ( $@ ) {
533 chomp($@);
534 my $shorterror = $@; $shorterror =~ s/\n.*$//gs;
535 $::log->verb(0,"Download error $url:", $shorterror);
536 # underlying socket library may be verybose - filter and qualify messages
537 if ( $shorterror ne $@ ) {
538 foreach my $errorline ( split(/\n/,$@) ) {
539 chomp($errorline); $errorline eq $shorterror and next; # nodups
540 $errorline and $::log->verb(4,"Download error detail:", $errorline);
541 }
542 }
543 return undef;
544 }
545
546 if ( ! $response->is_success ) {
547 $::log->verb(0,"Download error $url:",$response->status_line);
548 return undef;
549 }
550
551 $data = $response->content;
552
553 $metadata{"freshuntil"}=$response->fresh_until(heuristic_expiry=>0)||time;
554 if ( my $lastmod = $response->header("Last-Modified") ) {
555 $metadata{"lastmod"} = HTTP::Date::str2time($lastmod);
556 }
557 $metadata{"sourceurl"} = $url;
558
559 return ($data,%metadata) if wantarray;
560 return $data;
561 }
562
563 sub retrieveFile($$) {
564 my $self = shift;
565 my $idx = shift;
566 my $url = shift;
567 $url =~ /^file:\/*(\/.*)$/ or die "retrieveFile: non-file URL $url\n";
568 $::log->verb(4,"Retrieving data from $url");
569
570 # for files the previous state does not matter, we retrieve it
571 # anyway
572
573 my $data;
574 {
575 open CRLFILE,$1 or do {
576 $! = "Cannot open $1: $!";
577 return undef;
578 };
579 binmode CRLFILE;
580 local $/;
581 $data = <CRLFILE>;
582 close CRLFILE;
583 }
584
585 my %metadata;
586 $metadata{"lastmod"} = (stat($1))[9];
587 $metadata{"freshuntil"} = time;
588 $metadata{"sourceurl"} = $url;
589
590 return ($data,%metadata) if wantarray;
591 return $data;
592 }
593
594 sub retrieve($) {
595 my $self = shift;
596
597 $self->{"crlurls"} or
598 $::log->err("Retrieving uninitialised list of CRL URLs") and return 0;
599
600 $::log->verb(2,"Retrieving CRLs for",$self->{"alias"});
601
602 for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
603 my ($result,%response);
604
605 $::log->verb(3,"Retrieving CRL for",$self->{"alias"},"index $i");
606
607 # within the list of CRL URLs for a specific index, all entries
608 # are considered equivalent. I.e., if we get one, the metadata will
609 # be used for all (like Last-Modified, and cache control data)
610
611 # if we have a cached piece of fresh data, return that one
612 # and make sure the nextupdate in the CRL itself outlives claimed freshness
613 if ( !$self->{"nocache"} and
614 ($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) > time and
615 ($self->{"crl"}[$i]{"state"}{"nextupdate"} || time) >= time and
616 ($self->{"crl"}[$i]{"state"}{"nextupdate"} || 0) >=
617 ($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) and
618 $self->{"crl"}[$i]{"state"}{"b64data"} ) {
619 $::log->verb(3,"Using cached content for",$self->{"alias"},"index",$i);
620 $::log->verb(4,"Content dated",
621 scalar gmtime($self->{"crl"}[$i]{"state"}{"lastmod"}),
622 "valid until",
623 scalar gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"}),
624 "UTC");
625 $result = base64::b64decode($self->{"crl"}[$i]{"state"}{"b64data"});
626 %response = (
627 "freshuntil" => $self->{"crl"}[$i]{"state"}{"freshuntil"} || time,
628 "lastmod" => $self->{"crl"}[$i]{"state"}{"lastmod"} || time,
629 "sourceurl" => $self->{"crl"}[$i]{"state"}{"sourceurl"} || "null:"
630 );
631 } else {
632 foreach my $url ( split(/\001/,$self->{"crlurls"}[$i]) ) {
633 # of these, the first one wins
634 $url =~ /^(http:|https:|ftp:)/ and
635 ($result,%response) = $self->retrieveHTTP($i,$url);
636 $url =~ /^(file:)/ and
637 ($result,%response) = $self->retrieveFile($i,$url);
638 last if $result;
639 }
640 }
641
642 # check if result is there, otherwise invoke agingtolerance clause
643 # before actually raising this as an error
644 # note that agingtolerance stats counting only AFTER the freshness
645 # of the cache control directives has passed ...
646
647 if ( ! $result ) {
648
649 $::log->verb(1,"CRL retrieval for",
650 $self->{"alias"},($i?"[$i] ":"")."failed from all URLs");
651
652 if ( $self->{"agingtolerance"} && $self->{"crl"}[$i]{"state"}{"mtime"} ) {
653 if ( ( time - $self->{"crl"}[$i]{"state"}{"mtime"} ) <
654 3600*$self->{"agingtolerance"}) {
655 $::log->warn("CRL retrieval for",
656 $self->{"alias"},($i?"[$i] ":"")."failed,",
657 int((3600*$self->{"agingtolerance"}+
658 $self->{"crl"}[$i]{"state"}{"mtime"}-
659 time )/3600).
660 " left of ".$self->{"agingtolerance"}."h, retry later.");
661 } else {
662 $::log->retr_err("CRL retrieval for",
663 $self->{"alias"},($i?"[$i] ":"")."failed.",
664 $self->{"agingtolerance"}."h grace expired.",
665 "CRL not updated");
666 }
667 } else { # direct errors, no tolerance anymore
668 $::log->retr_err("CRL retrieval for",
669 $self->{"alias"},($i?"[$i] ":"")."failed,",
670 "CRL not updated");
671 }
672 next; # next subindex CRL for same CA, no further action on this one
673 }
674
675 # now data for $i is loaded in $result;
676 # for freshness checks, take a sum (SysV style)
677 my $sum = unpack("%32C*",$result) % 65535;
678
679 $::log->verb(4,"Got",length($result),"bytes of data (sum=$sum)");
680
681 $self->{"crl"}[$i]{"data"} = $result;
682 $self->{"crl"}[$i]{"state"}{"alias"} = $self->{"alias"};
683 $self->{"crl"}[$i]{"state"}{"index"} = $i;
684 $self->{"crl"}[$i]{"state"}{"sum"} = $sum;
685 ($self->{"crl"}[$i]{"state"}{"b64data"} =
686 base64::b64encode($result)) =~ s/\s+//gm;
687
688 $self->{"crl"}[$i]{"state"}{"retrievaltime"} = time;
689 $self->{"crl"}[$i]{"state"}{"sourceurl"} = $response{"sourceurl"}||"null:";
690 $self->{"crl"}[$i]{"state"}{"freshuntil"} = $response{"freshuntil"}||time;
691 $self->{"crl"}[$i]{"state"}{"lastmod"} = $response{"lastmod"}||time;
692
693 }
694 return 1;
695 }
696
697 sub verifyAndConvertCRLs($) {
698 my $self = shift;
699 $self->{"crlurls"} or
700 $::log->err("Verifying uninitialised list of CRLs impossible") and return 0;
701
702 # all CRLs must be valid in order to proceed
703 # or we would end up shifting the relative ordering around and
704 # possibly creatiing holes (or overwriting good local copies of
705 # CRLs that have gone bad on the remote end
706
707 for ( my $i = 0; $i <= $#{$self->{"crlurls"}} ; $i++ ) { # all indices
708 $self->{"crlurls"}[$i] or
709 $::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no valid URL)")
710 and next;
711 $self->{"crl"}[$i]{"data"} or
712 $::log->verb(3,"CRL",$self->getAnchorName."/".$i,"ignored (no new data)")
713 and next;
714 $::log->verb(4,"Verifying CRL $i for",$self->getAnchorName);
715
716 my $crl = CRL->new($self->getAnchorName."/$i",$self->{"crl"}[$i]{"data"});
717 my @verifyMessages= $crl->verify(@{$self->{"cafile"}});
718
719 # do additional checks on correlation between download and current
720 # lastUpdate of current file? have to guess the current file
721 # unless we are stateful!
722 my $oldlastupdate = $self->{"crl"}[$i]{"state"}{"lastupdate"} || undef;
723 $oldlastupdate or do {
724 $::log->verb(6,"Attempting to extract lastUpdate of previous D/L");
725 CRLSTATEHUNT: foreach my $output ( @{$::cnf->{_}->{"output_"}} ,
726 $self->{"infodir"}
727 ) {
728 foreach my $file (
729 $self->{"nametemplate_der"},
730 $self->{"nametemplate_pem"},
731 $self->{"alias"}.".r\@R\@",
732 $self->{"anchorname"}.".r\@R\@",
733 ) {
734 next unless $file;
735 (my $thisfile = $file ) =~ s/\@R\@/$i/g;
736 $thisfile = join "/", $output, $thisfile;
737 $::log->verb(6,"Trying guess $file for old CRL");
738 next if ! -e $thisfile;
739 my $oldcrldata; {
740 open OCF,$thisfile and do {
741 binmode OCF;
742 local $/;
743 $oldcrldata = <OCF>;
744 close OCF;
745 }
746 }
747 my $oldcrl = CRL->new($thisfile,$oldcrldata);
748 $oldlastupdate = $oldcrl->getLastUpdate;
749 last CRLSTATEHUNT;
750 }
751 }
752 $::log->verb(3,"Inferred lastupdate for",$self->{"alias"},"is",
753 $oldlastupdate) if $oldlastupdate;
754 };
755
756 if ( ! $crl->getLastUpdate ) {
757 push @verifyMessages,"downloaded CRL lastUpdate could not be derived";
758 } elsif ( $oldlastupdate and ($crl->getLastUpdate < $oldlastupdate) and
759 ($self->{"crl"}[$i]{"state"}{"mtime"} <= time)
760 ) {
761 push @verifyMessages,"downloaded CRL lastUpdate predates installed CRL,",
762 "and current version has sane timestamp";
763 } elsif ( defined $oldlastupdate and $oldlastupdate > time ) {
764 $::log->warn($self->{"anchorname"}."/$i:","replaced with downloaded CRL",
765 "since current one has lastUpdate in the future");
766 }
767
768 $#verifyMessages >= 0 and do {
769 $::log->retr_err("CRL verification failed for",$self->{"anchorname"}."/$i",
770 "(".$self->{"alias"}.")");
771 foreach my $m ( @verifyMessages ) {
772 $::log->verb(0,$self->{"anchorname"}."/$i:",$m);
773 }
774 return 0;
775 };
776
777 $self->{"crl"}[$i]{"pemdata"} = $crl->getPEMdata();
778 foreach my $key ( qw/ lastupdate nextupdate sha1fp issuer / ) {
779 $self->{"crl"}[$i]{"state"}{$key} = $crl->getAttribute($key) || "";
780 }
781
782
783 # issue a low-level warning in case the cache control headers from
784 # the CA (or its CDN) are bugus, i.e. the CRL wille expire before the
785 # cache does. Don't log at warning, since the site cannot fix this
786 if ( defined ($self->{"crl"}[$i]{"state"}{"freshuntil"}) and
787 ( $self->{"crl"}[$i]{"state"}{"freshuntil"} >
788 ( $self->{"crl"}[$i]{"state"}{"nextupdate"} +
789 $::cnf->{_}->{expirestolerance} )
790 )
791 ) {
792 $::log->verb(1,"Cache control headers for CA ".$self->{"alias"}." at ".
793 "URL ".$self->{"crl"}[$i]{"state"}{"sourceurl"}." have apparent ".
794 "freshness ".sprintf("%.1f",($self->{"crl"}[$i]{"state"}{"freshuntil"}-
795 $self->{"crl"}[$i]{"state"}{"nextupdate"})/3600).
796 "hrs beyond CRL expiration nextUpdate. Reset freshness from ".
797 gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"})." UTC to ".
798 $::cnf->{_}->{expirestolerance}." second before nextUpdate at ".
799 gmtime($self->{"crl"}[$i]{"state"}{"nextupdate"})." UTC.");
800 $self->{"crl"}[$i]{"state"}{"freshuntil"} =
801 $self->{"crl"}[$i]{"state"}{"nextupdate"} -
802 $::cnf->{_}->{expirestolerance};
803 }
804
805 # limit maximum freshness period to compensate for CAs that overdo it
806 if ( defined ($self->{"crl"}[$i]{"state"}{"freshuntil"}) and
807 $self->{"crl"}[$i]{"state"}{"freshuntil"} >
808 (time + $::cnf->{_}->{maxcachetime}) ) {
809 $self->{"crl"}[$i]{"state"}{"freshuntil"} =
810 time+$::cnf->{_}->{maxcachetime};
811 $::log->verb(1,"Cache state freshness expiry for CA ".$self->{"alias"}.
812 " reset to at most ".
813 sprintf("%.1f",$::cnf->{_}->{maxcachetime}/3600.).
814 "hrs beyond current time (".
815 gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"})." UTC)");
816 }
817
818 }
819 return 1;
820 }
821
822
823 1;
824

Properties

Name Value
svn:keywords Id

grid.support@nikhef.nl
ViewVC Help
Powered by ViewVC 1.1.28