/[pdpsoft]/nl.nikhef.pdp.fetchcrl/tags/fetch-crl-3.0.18/TrustAnchor.pm
ViewVC logotype

Annotation of /nl.nikhef.pdp.fetchcrl/tags/fetch-crl-3.0.18/TrustAnchor.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2650 - (hide annotations) (download) (as text)
Tue Jul 2 19:07:45 2013 UTC (8 years, 5 months ago) by davidg
Original Path: nl.nikhef.pdp.fetchcrl/trunk/TrustAnchor.pm
File MIME type: application/x-perl
File size: 24841 byte(s)
Improvements in comments around getting new CRLs

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 davidg 2650 if ( $@ ) { # died, alarm hit: server bad, so try next URL
457 davidg 1758 $::log->verb(2,"HEAD error $url:", $@);
458     return undef;
459     }
460    
461 davidg 2650 # try using cached data if it is fresh
462 davidg 1758 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 davidg 2650 # try get if head fails, there was no cache, cache disabled or invalidated
487 davidg 1758
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    

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