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 |
|
|
$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 |
davidg |
1763 |
if ( !$self->{"nocache"} and |
536 |
|
|
($self->{"crl"}[$i]{"state"}{"freshuntil"} || 0) > time and |
537 |
davidg |
1758 |
$self->{"crl"}[$i]{"state"}{"b64data"} ) { |
538 |
|
|
$::log->verb(3,"Using cached content for",$self->{"alias"},"index",$i); |
539 |
|
|
$::log->verb(4,"Content dated", |
540 |
|
|
scalar gmtime($self->{"crl"}[$i]{"state"}{"lastmod"}), |
541 |
|
|
"valid until", |
542 |
|
|
scalar gmtime($self->{"crl"}[$i]{"state"}{"freshuntil"}), |
543 |
|
|
"UTC"); |
544 |
|
|
$result = base64::b64decode($self->{"crl"}[$i]{"state"}{"b64data"}); |
545 |
|
|
%response = ( |
546 |
|
|
"freshuntil" => $self->{"crl"}[$i]{"state"}{"freshuntil"} || time, |
547 |
|
|
"lastmod" => $self->{"crl"}[$i]{"state"}{"lastmod"} || time, |
548 |
|
|
"sourceurl" => $self->{"crl"}[$i]{"state"}{"sourceurl"} || "null:" |
549 |
|
|
); |
550 |
|
|
} else { |
551 |
|
|
foreach my $url ( split(//,$self->{"crlurls"}[$i]) ) { |
552 |
|
|
# of these, the first one wins |
553 |
|
|
$url =~ /^(http:|https:|ftp:)/ and |
554 |
|
|
($result,%response) = $self->retrieveHTTP($i,$url); |
555 |
|
|
$url =~ /^(file:)/ and |
556 |
|
|
($result,%response) = $self->retrieveFile($i,$url); |
557 |
|
|
last if $result; |
558 |
|
|
} |
559 |
|
|
} |
560 |
|
|
|
561 |
|
|
# check if result is there, otherwise invoke agingtolerance clause |
562 |
|
|
# before actually raising this as an error |
563 |
|
|
# note that agingtolerance stats counting only AFTER the freshness |
564 |
|
|
# of the cache control directives has passed ... |
565 |
|
|
|
566 |
|
|
if ( ! $result ) { |
567 |
|
|
|
568 |
|
|
$::log->verb(1,"CRL retrieval for", |
569 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed from all URLs"); |
570 |
|
|
|
571 |
|
|
if ( $self->{"agingtolerance"} && $self->{"crl"}[$i]{"state"}{"mtime"} ) { |
572 |
|
|
if ( ( time - $self->{"crl"}[$i]{"state"}{"mtime"} ) < |
573 |
|
|
3600*$self->{"agingtolerance"}) { |
574 |
|
|
$::log->warn("CRL retrieval for", |
575 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed,", |
576 |
|
|
int((3600*$self->{"agingtolerance"}+ |
577 |
|
|
$self->{"crl"}[$i]{"state"}{"mtime"}- |
578 |
|
|
time )/3600). |
579 |
|
|
" left of ".$self->{"agingtolerance"}."h, retry later."); |
580 |
|
|
} else { |
581 |
|
|
$::log->err("CRL retrieval for", |
582 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed.", |
583 |
|
|
$self->{"agingtolerance"}."h grace expired.", |
584 |
|
|
"CRL not updated"); |
585 |
|
|
} |
586 |
|
|
} else { # direct errors, no tolerance anymore |
587 |
|
|
$::log->err("CRL retrieval for", |
588 |
|
|
$self->{"alias"},($i?"[$i] ":"")."failed,", |
589 |
|
|
"CRL not updated"); |
590 |
|
|
} |
591 |
|
|
next; # next subindex CRL for same CA, no further action on this one |
592 |
|
|
} |
593 |
|
|
|
594 |
|
|
# now data for $i is loaded in $result; |
595 |
|
|
# for freshness checks, take a sum (SysV style) |
596 |
|
|
my $sum = unpack("%32C*",$result) % 65535; |
597 |
|
|
|
598 |
|
|
$::log->verb(4,"Got",length($result),"bytes of data (sum=$sum)"); |
599 |
|
|
|
600 |
|
|
$self->{"crl"}[$i]{"data"} = $result; |
601 |
|
|
$self->{"crl"}[$i]{"state"}{"alias"} = $self->{"alias"}; |
602 |
|
|
$self->{"crl"}[$i]{"state"}{"index"} = $i; |
603 |
|
|
$self->{"crl"}[$i]{"state"}{"sum"} = $sum; |
604 |
|
|
($self->{"crl"}[$i]{"state"}{"b64data"} = |
605 |
|
|
base64::b64encode($result)) =~ s/\s+//gm; |
606 |
|
|
|
607 |
|
|
$self->{"crl"}[$i]{"state"}{"retrievaltime"} = time; |
608 |
|
|
$self->{"crl"}[$i]{"state"}{"sourceurl"} = $response{"sourceurl"}||"null:"; |
609 |
davidg |
1763 |
$self->{"crl"}[$i]{"state"}{"freshuntil"} = $response{"freshuntil"}||time; |
610 |
davidg |
1758 |
$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 |
|
|
|