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 |
# write new CRL to file ($file in $path) - attempting to do |
126 |
# an atomic action to prevent a reace condition with clients |
127 |
# but do not insist if the $path is not writable for new files |
128 |
my $tmpcrlmode=((stat $file)[2] || 0644) & 07777; |
129 |
$::log->verb(5,"TMP file for $file mode $tmpcrlmode"); |
130 |
my $tmpcrl = File::Temp->new(DIR => $path, SUFFIX => '.tmp', |
131 |
PERMS => $tmpcrlmode, UNLINK => 1); |
132 |
if ( defined $tmpcrl ) { # we could create a tempfile next to current |
133 |
print $tmpcrl $content or |
134 |
$::log->err("Write to $tmpcrl: $!") and return undef; |
135 |
# atomic move, but no need to restore from backup on failure |
136 |
# and the unlink on destroy is implicit |
137 |
chmod $tmpcrlmode,$tmpcrl or |
138 |
$::log->err("chmod on $tmpcrl (to $tmpcrlmode): $!") and |
139 |
return undef; |
140 |
rename($tmpcrl, $file) or |
141 |
$::log->err("rename $tmpcrl to $file: $!") and return undef; |
142 |
# file was successfully renamed, so nothing left to unlink |
143 |
$tmpcrl->unlink_on_destroy( 0 ); |
144 |
} elsif ( open FH,'>',$file ) { |
145 |
# no adjecent write possible, fall back to rewrite |
146 |
print FH $content or |
147 |
$::log->err("Write to $file: $!") and return undef; |
148 |
close FH or |
149 |
$::log->err("Close on write of $file: $!") and return undef; |
150 |
} else { # something went wrong in opening the file for write, |
151 |
# so try and restore backup if that was selected |
152 |
$::log->err("Open for write of $file: $!"); |
153 |
$flags{"BACKUP"} and ! -s "$file" and -s "$file~" and do { |
154 |
#file has been clobbed, but backup OK |
155 |
unlink "$file" and link "$file~","$file" and unlink "$file~" or |
156 |
$::log->err("Restore of backup $file failed: $!"); |
157 |
}; |
158 |
return undef; |
159 |
} |
160 |
return 1; |
161 |
} |
162 |
|
163 |
sub writePEM($$$$) { |
164 |
my $self = shift; |
165 |
my $idx = shift; |
166 |
my $data = shift; |
167 |
my $ta = shift; |
168 |
defined $idx and $data and $ta or |
169 |
$::log->err("CRLWriter::writePEM: missing index or data") and return 0; |
170 |
|
171 |
my $output = $::cnf->{_}->{"output"}; |
172 |
$output = $::cnf->{_}->{"output_pem"} if defined $::cnf->{_}->{"output_pem"}; |
173 |
$output and -d $output or |
174 |
$::log->err("PEM target directory $output invalid") and return 0; |
175 |
|
176 |
my $filename = "$output/".$ta->{"nametemplate_pem"}; |
177 |
$filename =~ s/\@R\@/$idx/g; |
178 |
|
179 |
my %flags = (); |
180 |
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1; |
181 |
|
182 |
if ($data !~ /\n$/sm) { |
183 |
$::log->verb(5,"Appending newline to short PEM file",$filename); |
184 |
$data="$data\n"; |
185 |
} |
186 |
|
187 |
$::log->verb(3,"Writing PEM file",$filename); |
188 |
&updatefile($filename,$data,%flags) or return 0; |
189 |
return 1; |
190 |
} |
191 |
|
192 |
sub writeDER($$$$) { |
193 |
my $self = shift; |
194 |
my $idx = shift; |
195 |
my $data = shift; |
196 |
my $ta = shift; |
197 |
defined $idx and $data and $ta or |
198 |
$::log->err("CRLWriter::writeDER: missing index or data") and return 0; |
199 |
|
200 |
my $output = $::cnf->{_}->{"output"}; |
201 |
$output = $::cnf->{_}->{"output_der"} if defined $::cnf->{_}->{"output_der"}; |
202 |
$output and -d $output or |
203 |
$::log->err("DER target directory $output invalid") and return 0; |
204 |
|
205 |
my $filename = "$output/".$ta->{"nametemplate_der"}; |
206 |
$filename =~ s/\@R\@/$idx/g; |
207 |
|
208 |
my %flags = (); |
209 |
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1; |
210 |
|
211 |
my $openssl=OSSL->new(); |
212 |
my ($der,$errors) = $openssl->Exec3($data,qw/crl -inform PEM -outform DER/); |
213 |
$errors or not $der and |
214 |
$::log->err("Data count not be converted to DER: $errors") and return 0; |
215 |
|
216 |
$::log->verb(3,"Writing DER file",$filename); |
217 |
&updatefile($filename,$der,%flags) or return 0; |
218 |
return 1; |
219 |
} |
220 |
|
221 |
sub writeOpenSSL($$$$) { |
222 |
my $self = shift; |
223 |
my $idx = shift; |
224 |
my $data = shift; |
225 |
my $ta = shift; |
226 |
defined $idx and $data and $ta or |
227 |
$::log->err("CRLWriter::writeOpenSSL: missing index, data or ta") and |
228 |
return 0; |
229 |
|
230 |
my $output = $::cnf->{_}->{"output"}; |
231 |
$output = $::cnf->{_}->{"output_openssl"} if |
232 |
defined $::cnf->{_}->{"output_openssl"}; |
233 |
$output and -d $output or |
234 |
$::log->err("OpenSSL target directory $output invalid") and return 0; |
235 |
|
236 |
my $openssl=OSSL->new(); |
237 |
|
238 |
# guess the hash name or names from OpenSSL |
239 |
# if mode is dual (and OpenSSL1 installed) write two files |
240 |
my $opensslversion = $openssl->getVersion() or return 0; |
241 |
|
242 |
my ($cmddata,$errors); |
243 |
my @hashes = (); |
244 |
if ( $opensslversion ge "1" and $::cnf->{_}->{"opensslmode"} eq "dual" ) { |
245 |
$::log->verb(5,"OpenSSL version 1 dual-mode enabled"); |
246 |
# this mode needs the ta cafile to get both hashes, since these |
247 |
# can only be extracted by the x509 subcommand from a CA ... |
248 |
($cmddata,$errors) = $openssl->Exec3(undef, |
249 |
qw/x509 -noout -subject_hash -subject_hash_old -in/, |
250 |
$ta->{"cafile"}[0]); |
251 |
$cmddata or |
252 |
$::log->err("OpenSSL cannot extract hashes from",$ta->{"cafile"}[0]) and |
253 |
return 0; |
254 |
@hashes = split(/[\s\n]+/,$cmddata); |
255 |
} else { |
256 |
$::log->verb(5,"OpenSSL version 1 single-mode or pre-1.0 style"); |
257 |
($cmddata,$errors) = $openssl->Exec3($data,qw/crl -noout -hash/); |
258 |
$cmddata or |
259 |
$::log->err("OpenSSL cannot extract hashes from CRL for", |
260 |
$ta->{"alias"}.'/'.$idx |
261 |
) and |
262 |
return 0; |
263 |
@hashes = split(/[\s\n]+/,$cmddata); |
264 |
} |
265 |
|
266 |
my %flags = (); |
267 |
$::cnf->{_}->{"backups"} and $flags{"BACKUP"} = 1; |
268 |
|
269 |
foreach my $hash ( @hashes ) { |
270 |
my $filename = "$output/$hash.r$idx"; |
271 |
$::log->verb(3,"Writing OpenSSL file",$filename); |
272 |
&updatefile($filename,$data,%flags) or return 0; |
273 |
} |
274 |
return 1; |
275 |
} |
276 |
|
277 |
sub writeNSS($$$$) { |
278 |
my $self = shift; |
279 |
my $idx = shift; |
280 |
my $data = shift; |
281 |
my $ta = shift; |
282 |
defined $idx and $data and $ta or |
283 |
$::log->err("CRLWriter::writeNSS: missing index, data or ta") and return 0; |
284 |
|
285 |
my $output = $::cnf->{_}->{"output"}; |
286 |
$output = $::cnf->{_}->{"output_nss"} if defined $::cnf->{_}->{"output_nss"}; |
287 |
$output and -d $output or |
288 |
$::log->err("NSS target directory $output invalid") and return 0; |
289 |
|
290 |
my $dbprefix=""; |
291 |
$dbprefix = $::cnf->{_}->{"nssdbprefix"} |
292 |
if defined $::cnf->{_}->{"nssdbprefix"}; |
293 |
|
294 |
my $filename = "$output/$dbprefix"; |
295 |
|
296 |
# the crlutil tool requires the DER formatted cert in a file |
297 |
my $tmpdir = $::cnf->{_}->{exec3tmpdir} || $ENV{"TMPDIR"} || '/tmp'; |
298 |
my ($derfh,$dername) = tempfile("fetchcrl3der.XXXXXX", |
299 |
DIR=>$tmpdir, UNLINK=>1); |
300 |
(my $b64data = $data) =~ s/-[^\n]+//gm; |
301 |
$b64data =~ s/\s+//gm; |
302 |
print $derfh base64::b64decode($b64data); # der is decoded PEM :-) |
303 |
|
304 |
my $cmd = "crlutil -I -d \"$output\" -P \"$dbprefix\" "; |
305 |
$::cnf->{_}->{nonssverify} and $cmd .= "-B "; |
306 |
$cmd .= "-n ".$ta->{"alias"}.'.'.$idx." "; |
307 |
$cmd .= "-i \"$dername\""; |
308 |
my $result = `$cmd 2>&1`; |
309 |
unlink $dername; |
310 |
if ( $? != 0 ) { |
311 |
$::log->err("Cannot update NSSDB filename: $result"); |
312 |
} else { |
313 |
$::log->verb(3,"WriteNSS: ".$ta->{"alias"}.'.'.$idx." added to $filename"); |
314 |
} |
315 |
|
316 |
return 1; |
317 |
} |
318 |
|
319 |
|
320 |
sub writeall($) { |
321 |
my $self = shift; |
322 |
return 0 unless defined $self; |
323 |
$self->{"ta"} or |
324 |
$::log->err("CRLWriter::setIndex called without a loaded TA") and |
325 |
return 0; |
326 |
my $ta = $self->{"ta"}; |
327 |
$ta->{"crlurls"} or |
328 |
$::log->err("CRLWriter::setIndex called with uninitialised TA") and |
329 |
return 0; |
330 |
|
331 |
$::log->verb(2,"Writing CRLs for",$ta->{"anchorname"}); |
332 |
|
333 |
my $completesuccess = 1; |
334 |
for ( my $idx = 0 ; $idx <= $#{$ta->{"crl"}} ; $idx++ ) { |
335 |
$ta->{"crl"}[$idx]{"pemdata"} or |
336 |
$::log->verb(3,"Ignored CRL $idx skipped") and |
337 |
next; # ignore empty crls, leave these in place |
338 |
|
339 |
my $writeAttempt = 0; |
340 |
my $writeSuccess = 0; |
341 |
|
342 |
( grep /^pem$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
343 |
$writeSuccess += $self->writePEM($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta); |
344 |
|
345 |
( grep /^der$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
346 |
$writeSuccess += $self->writeDER($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta); |
347 |
|
348 |
( grep /^openssl$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
349 |
$writeSuccess += $self->writeOpenSSL($idx, |
350 |
$ta->{"crl"}[$idx]{"pemdata"},$ta); |
351 |
|
352 |
( grep /^nss$/, @{$::cnf->{_}->{formats_}} ) and ++$writeAttempt and |
353 |
$writeSuccess += $self->writeNSS($idx,$ta->{"crl"}[$idx]{"pemdata"},$ta); |
354 |
|
355 |
if ( $writeSuccess == $writeAttempt ) { |
356 |
$::log->verb(4,"LastWrite time (mtime) set to current time"); |
357 |
$ta->{"crl"}[$idx]{"state"}{"mtime"} = time; |
358 |
} else { |
359 |
$::log->warn("Partial updating ($writeSuccess of $writeAttempt) for", |
360 |
$ta->{"anchorname"}, |
361 |
"CRL $idx: mtime not updated"); |
362 |
} |
363 |
$completesuccess &&= ($writeSuccess == $writeAttempt); |
364 |
} |
365 |
|
366 |
return $completesuccess; |
367 |
} |
368 |
|
369 |
1; |