1 |
# |
2 |
# @(#)$Id$ |
3 |
# |
4 |
# ########################################################################### |
5 |
# |
6 |
# |
7 |
# Syntax: |
8 |
# CRLWriter->new( [name [,index]] ); |
9 |
# CRLWriter->setTA( trustanchor ); |
10 |
# CRLWriter->setIndex( index ); |
11 |
# |
12 |
package CRLWriter; |
13 |
use strict; |
14 |
use File::Basename; |
15 |
use File::Temp qw/ tempfile /; |
16 |
require OSSL and import OSSL unless defined &OSSL::new; |
17 |
require base64 and import base64 unless defined &base64::b64encode; |
18 |
use vars qw/ $log $cnf /; |
19 |
|
20 |
sub new { |
21 |
my $obref = {}; bless $obref; |
22 |
my $self = shift; |
23 |
$self = $obref; |
24 |
my $name = shift; |
25 |
my $index = shift; |
26 |
|
27 |
$self->setTA($name) if defined $name; |
28 |
$self->setIndex($name) if defined $index; |
29 |
|
30 |
return $self; |
31 |
} |
32 |
|
33 |
|
34 |
sub getName($) { |
35 |
my $self = shift; |
36 |
return 0 unless defined $self; |
37 |
return $self->{"ta"}->getAnchorName; |
38 |
} |
39 |
|
40 |
sub setTA($$) { |
41 |
my $self = shift; |
42 |
my ($ta) = shift; |
43 |
return 0 unless defined $ta and defined $self; |
44 |
$ta->{"anchorname"} or |
45 |
$::log->err("CRLWriter::setTA called without uninitialised trust anchor") |
46 |
and return 0; |
47 |
$self->{"ta"} = $ta; |
48 |
return 1; |
49 |
} |
50 |
|
51 |
sub setIndex($$) { |
52 |
my $self = shift; |
53 |
my ($index) = shift; |
54 |
return 0 unless defined $self; |
55 |
$self->{"ta"} or |
56 |
$::log->err("CRLWriter::setIndex called without a loaded TA") and |
57 |
return 0; |
58 |
my $ta = $self->{"ta"}; |
59 |
|
60 |
$ta->{"crlurls"} or |
61 |
$::log->err("CRLWriter::setIndex called with uninitialised TA") and |
62 |
return 0; |
63 |
|
64 |
! defined $index and delete $self->{"index"} and return 1; |
65 |
|
66 |
$index < 0 and |
67 |
$::log->err("CRLWriter::setIndex called with invalid index $index") and |
68 |
return 0; |
69 |
$index > $#{$ta->{"crlurls"}} and |
70 |
$::log->err("CRLWriter::setIndex index $index too large") and |
71 |
return 0; |
72 |
|
73 |
$self->{"index"} = $index; |
74 |
|
75 |
return 1; |
76 |
} |
77 |
|
78 |
sub updatefile($$%) { |
79 |
my $file = shift; |
80 |
my $content = shift; |
81 |
my %flags = @_; |
82 |
$content or return undef; |
83 |
$file or |
84 |
$::log->err("Cannot write content to undefined path") and return undef; |
85 |
|
86 |
my ( $basename, $path, $suffix ) = fileparse($file); |
87 |
|
88 |
# get content and do a comparison. If data identical, touch only |
89 |
# to update mtime (other tools like NGC Nagios use this mtime semantics) |
90 |
# |
91 |
my $olddata; |
92 |
my $mytime; |
93 |
-f $file and do { |
94 |
$mytime = (stat(_))[9]; |
95 |
{ |
96 |
open OLDFILE,'<',$file or |
97 |
$::log->err("Cannot make backup of $file: $!") and return undef; |
98 |
binmode OLDFILE; local $/; |
99 |
$olddata = <OLDFILE>; close OLDFILE; |
100 |
} |
101 |
}; |
102 |
if ( $flags{"BACKUP"} and $olddata ) { |
103 |
if ( -w $path ) { |
104 |
-e "$file~" and ( unlink "$file~" or |
105 |
$::log->warn("Cannot remove old backup $file~: $!") and return undef); |
106 |
if (open BCKFILE,'>',"$file~" ) { |
107 |
print BCKFILE $olddata; |
108 |
close BCKFILE; |
109 |
utime $mytime,$mytime, "$file~"; |
110 |
} else { |
111 |
$::log->warn("Cannot reate backup $file~: $!"); |
112 |
} |
113 |
} else { |
114 |
$::log->warn("Cannot make backup, $path not writable"); |
115 |
} |
116 |
} |
117 |
|
118 |
defined $olddata and $olddata eq $content and do { |
119 |
$::log->verb(4,"$file unchanged - touch only"); |
120 |
utime time,time,$file and return 1; |
121 |
$::log->warn("Touch of $file failed, CRL unmodified"); |
122 |
return 0; |
123 |
}; |
124 |
|
125 |
if ( open FH,'>',$file ) { |
126 |
print FH $content or |
127 |
$::log->err("Write to $file: $!") and return undef; |
128 |
close FH or |
129 |
$::log->err("Close on write of $file: $!") and return undef; |
130 |
} else { # something went wrong in opening the file for write, |
131 |
# so try and restore backup if that was selected |
132 |
$::log->err("Open for write of $file: $!"); |
133 |
$flags{"BACKUP"} and ! -s "$file" and -s "$file~" and do { |
134 |
#file has been clobbed, but backup OK |
135 |
unlink "$file" and link "$file~","$file" and unlink "$file~" or |
136 |
$::log->err("Restore of backup $file failed: $!"); |
137 |
}; |
138 |
return undef; |
139 |
} |
140 |
return 1; |
141 |
} |
142 |
|
143 |
sub writePEM($$$$) { |
144 |
my $self = shift; |
145 |
my $idx = shift; |
146 |
my $data = shift; |
147 |
my $ta = shift; |
148 |
defined $idx and $data and $ta or |
149 |
$::log->err("CRLWriter::writePEM: missing index or data") and return 0; |
150 |
|
151 |
my $output = $::cnf->{_}->{"output"}; |
152 |
$output = $::cnf->{_}->{"output_pem"} if defined $::cnf->{_}->{"output_pem"}; |
153 |
$output and -d $output or |
154 |
$::log->err("PEM target directory $output invalid") and return 0; |
155 |
|
156 |
my $filename = "$output/".$ta->{"nametemplate_pem"}; |
157 |
$filename =~ s/\@R\@/$idx/g; |
158 |
|
159 |
my %flags = (); |
160 |
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1; |
161 |
|
162 |
$::log->verb(3,"Writing PEM file",$filename); |
163 |
&updatefile($filename,$data,%flags) or return 0; |
164 |
return 1; |
165 |
} |
166 |
|
167 |
sub writeDER($$$$) { |
168 |
my $self = shift; |
169 |
my $idx = shift; |
170 |
my $data = shift; |
171 |
my $ta = shift; |
172 |
defined $idx and $data and $ta or |
173 |
$::log->err("CRLWriter::writeDER: missing index or data") and return 0; |
174 |
|
175 |
my $output = $::cnf->{_}->{"output"}; |
176 |
$output = $::cnf->{_}->{"output_der"} if defined $::cnf->{_}->{"output_der"}; |
177 |
$output and -d $output or |
178 |
$::log->err("DER target directory $output invalid") and return 0; |
179 |
|
180 |
my $filename = "$output/".$ta->{"nametemplate_der"}; |
181 |
$filename =~ s/\@R\@/$idx/g; |
182 |
|
183 |
my %flags = (); |
184 |
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1; |
185 |
|
186 |
my $openssl=OSSL->new(); |
187 |
my ($der,$errors) = $openssl->Exec3($data,qw/crl -inform PEM -outform DER/); |
188 |
$errors or not $der and |
189 |
$::log->err("Data count not be converted to DER: $errors") and return 0; |
190 |
|
191 |
$::log->verb(3,"Writing DER file",$filename); |
192 |
&updatefile($filename,$der,%flags) or return 0; |
193 |
return 1; |
194 |
} |
195 |
|
196 |
sub writeOpenSSL($$$$) { |
197 |
my $self = shift; |
198 |
my $idx = shift; |
199 |
my $data = shift; |
200 |
my $ta = shift; |
201 |
defined $idx and $data and $ta or |
202 |
$::log->err("CRLWriter::writeOpenSSL: missing index, data or ta") and |
203 |
return 0; |
204 |
|
205 |
my $output = $::cnf->{_}->{"output"}; |
206 |
$output = $::cnf->{_}->{"output_openssl"} if |
207 |
defined $::cnf->{_}->{"output_openssl"}; |
208 |
$output and -d $output or |
209 |
$::log->err("OpenSSL target directory $output invalid") and return 0; |
210 |
|
211 |
my $openssl=OSSL->new(); |
212 |
|
213 |
# guess the hash name or names from OpenSSL |
214 |
# if mode is dual (and OpenSSL1 installed) write two files |
215 |
my $opensslversion = $openssl->getVersion() or return 0; |
216 |
|
217 |
my ($cmddata,$errors); |
218 |
my @hashes = (); |
219 |
if ( $opensslversion ge "1" and $::cnf->{_}->{"opensslmode"} eq "dual" ) { |
220 |
$::log->verb(5,"OpenSSL version 1 dual-mode enabled"); |
221 |
# this mode needs the ta cafile to get both hashes, since these |
222 |
# can only be extracted by the x509 subcommand from a CA ... |
223 |
($cmddata,$errors) = $openssl->Exec3(undef, |
224 |
qw/x509 -noout -subject_hash -subject_hash_old -in/, |
225 |
$ta->{"cafile"}[0]); |
226 |
$cmddata or |
227 |
$::log->err("OpenSSL cannot extract hashes from",$ta->{"cafile"}[0]) and |
228 |
return 0; |
229 |
@hashes = split(/[\s\n]+/,$cmddata); |
230 |
} else { |
231 |
$::log->verb(5,"OpenSSL version 1 single-mode or pre-1.0 style"); |
232 |
($cmddata,$errors) = $openssl->Exec3($data,qw/crl -noout -hash/); |
233 |
$cmddata or |
234 |
$::log->err("OpenSSL cannot extract hashes from CRL for", |
235 |
$ta->{"alias"}.'/'.$idx |
236 |
) and |
237 |
return 0; |
238 |
@hashes = split(/[\s\n]+/,$cmddata); |
239 |
} |
240 |
|
241 |
my %flags = (); |
242 |
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1; |
243 |
|
244 |
foreach my $hash ( @hashes ) { |
245 |
my $filename = "$output/$hash.r$idx"; |
246 |
$::log->verb(3,"Writing OpenSSL file",$filename); |
247 |
&updatefile($filename,$data,%flags) or return 0; |
248 |
} |
249 |
return 1; |
250 |
} |
251 |
|
252 |
sub writeNSS($$$$) { |
253 |
my $self = shift; |
254 |
my $idx = shift; |
255 |
my $data = shift; |
256 |
my $ta = shift; |
257 |
defined $idx and $data and $ta or |
258 |
$::log->err("CRLWriter::writeNSS: missing index, data or ta") and return 0; |
259 |
|
260 |
my $output = $::cnf->{_}->{"output"}; |
261 |
$output = $::cnf->{_}->{"output_nss"} if defined $::cnf->{_}->{"output_nss"}; |
262 |
$output and -d $output or |
263 |
$::log->err("NSS target directory $output invalid") and return 0; |
264 |
|
265 |
my $dbprefix=""; |
266 |
$dbprefix = $::cnf->{_}->{"nssdbprefix"} |
267 |
if defined $::cnf->{_}->{"nssdbprefix"}; |
268 |
|
269 |
my $filename = "$output/$dbprefix"; |
270 |
|
271 |
# the crlutil tool requires the DER formatted cert in a file |
272 |
my $tmpdir = $::cnf->{_}->{exec3tmpdir} || $ENV{"TMPDIR"} || '/tmp'; |
273 |
my ($derfh,$dername) = tempfile("fetchcrl3der.XXXXXX", |
274 |
DIR=>$tmpdir, UNLINK=>1); |
275 |
(my $b64data = $data) =~ s/-[^\n]+//gm; |
276 |
$b64data =~ s/\s+//gm; |
277 |
print $derfh base64::b64decode($b64data); # der is decoded PEM :-) |
278 |
|
279 |
my $cmd = "crlutil -I -d \"$output\" -P \"$dbprefix\" "; |
280 |
$::cnf->{_}->{nonssverify} and $cmd .= "-B "; |
281 |
$cmd .= "-n ".$ta->{"alias"}.'.'.$idx." "; |
282 |
$cmd .= "-i \"$dername\""; |
283 |
my $result = `$cmd 2>&1`; |
284 |
unlink $dername; |
285 |
if ( $? != 0 ) { |
286 |
$::log->err("Cannot update NSSDB filename: $result"); |
287 |
} else { |
288 |
$::log->verb(3,"WriteNSS: ".$ta->{"alias"}.'.'.$idx." added to $filename"); |
289 |
} |
290 |
|
291 |
return 1; |
292 |
} |
293 |
|
294 |
|
295 |
sub writeall($) { |
296 |
my $self = shift; |
297 |
return 0 unless defined $self; |
298 |
$self->{"ta"} or |
299 |
$::log->err("CRLWriter::setIndex called without a loaded TA") and |
300 |
return 0; |
301 |
my $ta = $self->{"ta"}; |
302 |
$ta->{"crlurls"} or |
303 |
$::log->err("CRLWriter::setIndex called with uninitialised TA") and |
304 |
return 0; |
305 |
|
306 |
$::log->verb(2,"Writing CRLs for",$ta->{"anchorname"}); |
307 |
|
308 |
my $completesuccess = 1; |
309 |
for ( my $idx = 0 ; $idx <= $#{$ta->{"crl"}} ; $idx++ ) { |
310 |
$ta->{"crl"}[$idx]{"pemdata"} or |
311 |
$::log->verb(3,"Ignored CRL $idx skipped") and |
312 |
next; # ignore empty crls, leave these in place |
313 |
|
314 |
my $writeAttempt = 0; |
315 |
my $writeSuccess = 0; |
316 |
|
317 |
( grep /^pem$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
318 |
$writeSuccess += $self->writePEM($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta); |
319 |
|
320 |
( grep /^der$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
321 |
$writeSuccess += $self->writeDER($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta); |
322 |
|
323 |
( grep /^openssl$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
324 |
$writeSuccess += $self->writeOpenSSL($idx, |
325 |
$ta->{"crl"}[$idx]{"pemdata"},$ta); |
326 |
|
327 |
( grep /^nss$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
328 |
$writeSuccess += $self->writeNSS($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta); |
329 |
|
330 |
if ( $writeSuccess == $writeAttempt ) { |
331 |
$::log->verb(4,"LastWrite time (mtime) set to current time"); |
332 |
$ta->{"crl"}[$idx]{"state"}{"mtime"} = time; |
333 |
} else { |
334 |
$::log->warn("Partial updating ($writeSuccess of $writeAttempt) for", |
335 |
$ta->{"anchorname"}, |
336 |
"CRL $idx: mtime not updated"); |
337 |
} |
338 |
$completesuccess &&= ($writeSuccess == $writeAttempt); |
339 |
} |
340 |
|
341 |
return $completesuccess; |
342 |
} |
343 |
|
344 |
1; |