/[pdpsoft]/nl.nikhef.pdp.fetchcrl/trunk/CRLWriter.pm
ViewVC logotype

Annotation of /nl.nikhef.pdp.fetchcrl/trunk/CRLWriter.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3334 - (hide annotations) (download) (as text)
Thu Nov 25 08:11:38 2021 UTC (5 months, 3 weeks ago) by davidg
File MIME type: application/x-perl
File size: 11638 byte(s)
mode for new CRL file should be set even if it did not yet exist. Default: 0644

1 davidg 1758 #
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 davidg 3333 # 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 davidg 3334 my $tmpcrlmode=((stat $file)[2] || 0644) & 07777;
129 davidg 3333 $::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 davidg 1758 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 davidg 3170 if ($data !~ /\n$/sm) {
183     $::log->verb(5,"Appending newline to short PEM file",$filename);
184     $data="$data\n";
185     }
186    
187 davidg 1758 $::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