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

Contents of /nl.nikhef.pdp.fetchcrl/tags/fetch-crl-3.0.22/CRLWriter.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3336 - (show annotations) (download) (as text)
Thu Nov 25 08:38:57 2021 UTC (5 months, 2 weeks ago) by davidg
File MIME type: application/x-perl
File size: 11638 byte(s)
tag version 3.0.22

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;

Properties

Name Value
svn:keywords Id

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