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

Contents of /nl.nikhef.pdp.fetchcrl/tags/fetch-crl-3.0.8-1/TrustAnchor.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2305 - (show annotations) (download) (as text)
Sun Jun 12 20:59:58 2011 UTC (10 years, 5 months ago) by davidg
Original Path: nl.nikhef.pdp.fetchcrl/trunk/TrustAnchor.pm
File MIME type: application/x-perl
File size: 24018 byte(s)
Fixed bug by Elan Ruusamae and works around Steven bug found in file(1)

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

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