← Back to branch summary

~pi-rho/+junk/certdog

« back to all changes in this revision

Viewing changes to certdog

  • Committer: pi-rho
  • Date: 2013-12-29 06:02:27 UTC
  • Revision ID: ubuntu@tyr.cx-20131229060227-p7gmfkyhp68qkxpu
more cleanups, thanks to perlcritic
rework savecrl
created two generics, save and load for basic file io

Show diffs side-by-side

added added

removed removed

Lines of Context:
certdog
161
161
# Print a message
162
162
sub output {
163
163
    my $message = join('', @_);
164
 
    print colorize prep_message('+', $message), $/;
 
164
    print colorize prep_message(q{+}, $message), $/;
165
165
    return;
166
166
}
167
167
 
181
181
 
182
182
# Print a header
183
183
sub hr {
184
 
    return print colorize ">>>" . '-' x 72, $/;
 
184
    my $width = scalar chars;
 
185
    $width -= 4;
 
186
    return print colorize ">>>" . q{-} x $width, $/;
185
187
}
186
188
 
187
189
sub outgraph {
220
222
    my ($url, $hash_hint, $queue) = @_;
221
223
 
222
224
    my $p7c = _getcert_url($url);
223
 
    my $pkcs;
224
225
 
225
226
    # save it out to a temp file
226
227
    my $cmd = 'openssl pkcs7 -print_certs';
306
307
# @throws die if $file cannot be opened
307
308
sub _getcert_file {
308
309
    my ($file) = @_;
309
 
    local $/ = undef;
310
 
    open my $fh, "<", $file
311
 
        or die "Cannot open $file $!\n";
312
 
    binmode($fh);
313
 
    my $data = <$fh>;
314
 
    close $fh;
 
310
    my $data = load($file, binary => 1);
315
311
    unlink $file if $file =~ /^(?:pkcs7-dump|server-provided)-\d+.tmp/;
316
312
    return $data;
317
313
}
364
360
sub savecert {
365
361
    my ($cert, $name, $hash, $depth) = @_;
366
362
    $name = clean_name($name);
367
 
    open my $fh, ">", "$name.pem"
368
 
        or die "unable to open $name.pem for writing: $!\n";
369
 
    print {$fh} $cert;
370
 
    close $fh;
 
363
    save("$name.pem", $cert);
371
364
    symlink("$name.pem", "$hash.0") if defined $hash;
372
365
    symlink("$name.pem", sprintf("%04d.pem", $depth)) if defined $depth;
373
366
    return "$name.pem";
387
380
 
388
381
    $crl = _getcert_url($crl);
389
382
    my $fh;
390
 
    if ($crl =~ m/$RE{CRLbegin}/) {
391
 
        open $fh, ">", "$name.crl"
392
 
            or die "unable to open $name.crl for writing: $!\n";
393
 
    } elsif ($crl =~ m{\A[[:print:]\s]+\Z}smx) {
394
 
        open $fh, "|-", "base64 -di 2>/dev/null | openssl crl -inform DER -out '$name.crl' 2>/dev/null"
395
 
            or die "unable to open openssl to conver the crl: $!\n";
396
 
    } else {
397
 
        open $fh, "|-", "openssl crl -inform DER -out '$name.crl' 2>/dev/null"
398
 
            or die "unable to open openssl to conver the crl: $!\n";
399
 
        binmode $fh;
 
383
    if (isbin($crl)) {
 
384
        openssl('crl', '-inform DER', input => \$crl, output => "$name.crl")
 
385
    } elsif ($crl =~ m/$RE{CRLbegin}/) {
 
386
        save("$name.crl", $crl);
 
387
    } else {   # to address a weird case of CAs publishing base64-ed DER CRLs
 
388
        run( [ 'base64', '-di' ], '<', \$crl, '2>', '/dev/null',
 
389
            '|', binary, [ qw{openssl crl -inform DER} ], '>', "$name.crl", '2>', '/dev/null');
400
390
    }
401
 
    print {$fh} $crl;
402
 
    close $fh;
403
391
    symlink("$name.crl", "$hash.r0");
404
392
    return "$name.crl";
405
393
}
426
414
# -- }}}
427
415
# Utilities {{{
428
416
 
 
417
# save a string to a file
 
418
sub save {
 
419
    my ($fn, $data, %opts) = @_;
 
420
    open my $fh, ">", $fn
 
421
        or die "unable to open $fn for writing: $!\n";
 
422
    binmode($fh) if $opts{binary};
 
423
    print {$fh} $data;
 
424
    close $fh;
 
425
    return;
 
426
}
 
427
 
 
428
# load the contents of a file
 
429
sub load {
 
430
    my ($fn, %opts) = @_;
 
431
    local $/ = undef;
 
432
    open my $fh, "<", $fn
 
433
        or die "Cannot open $fn for reading: $!\n";
 
434
    binmode($fh) if $opts{binary};
 
435
    my $data = <$fh>;
 
436
    close $fh;
 
437
    return $data;
 
438
}
 
439
 
429
440
# is the string binary?
430
441
sub isbin {
431
442
    my ($s) = @_;
433
444
    return $s !~ m/\A[[:print:]\s]*\Z/smx;
434
445
}
435
446
 
 
447
# pump the graph
436
448
sub mkgraph {
437
449
    my ($skid, $sDN, $serial, $fp, $akid, $iDN, $depth) = @_;
438
450
 
441
453
        $skid ? sprintf('%s\n%s', hexer($skid), cn($sDN)) : cn($sDN),
442
454
        sprintf('\'%s\'', lc $serial)
443
455
    );
 
456
    my $fill_levels = 9;
444
457
    $a->set_attribute('fontsize', '80%');
445
 
    $a->set_attribute('fill', ($depth + 2) % 9);
 
458
    $a->set_attribute('fill', ($depth + 2) % $fill_levels);
446
459
    $b->set_attribute('fontsize', '80%');
447
 
    $b->set_attribute('fill', ($depth + 1) % 9);
 
460
    $b->set_attribute('fill', ($depth + 1) % $fill_levels);
448
461
    $e->set_attribute('fontsize', '70%');
449
462
    return;
450
463
}
717
730
 
718
731
Certificates, when found, will be saved to the current directory using the most
719
732
significant DN attribute (I<filesystem-safe-name.pem>). Symbolic links will be
720
 
made to facilitate validation with OpenSSL's L<verify(1)> (hash.0), and to
 
733
made to facilitate validation with OpenSSL's L<verify(1)|verify> (hash.0), and to
721
734
indicate depth (I<depth.pem>). I<0000.pem> will always point to the target
722
735
certificate.
723
736
 
769
782
 
770
783
=item connect:I<server.ip.or.name>:[I<port>]
771
784
 
772
 
Use OpenSSL's L<s_client(1)> to connect to a server and retrieve its SSL
 
785
Use OpenSSL's L<s_client(1)|s_client> to connect to a server and retrieve its SSL
773
786
certificate.
774
787
 
775
788
=item I</path/to/cert>
782
795
 
783
796
=head1 AUTHOR
784
797
 
785
 
B<certdog> was created by pi-rho L<pi-rho@tyr.cx>.
 
798
B<certdog> was created by pi-rho
786
799
 
787
800
=head1 LICENSE AND COPYRIGHT
788
801
 
789
 
B<certdog> is Copyright 2013, pi-rho L<pi-rho@tyr.cx>
790
 
 
791
 
=over 4
792
 
 
793
 
 Redistribution and use in source and binary forms, with or without
794
 
 modification, are permitted provided that the following conditions
795
 
 are met:
796
 
 
797
 
 1. Redistributions of source code must retain the above copyright
798
 
    notice, this list of conditions and the following disclaimer.
799
 
 
800
 
 2. Redistributions in binary form must reproduce the above copyright
801
 
    notice, this list of conditions and the following disclaimer in the
802
 
    documentation and/or other materials provided with the distribution.
803
 
 
804
 
 3. Neither the name of the University nor the names of its contributors
805
 
    may be used to endorse or promote products derived from this software
806
 
    without specific prior written permission.
807
 
 
808
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
809
 
 ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
810
 
 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 
811
 
 A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE HOLDERS OR
812
 
 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
813
 
 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 
814
 
 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 
815
 
 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 
816
 
 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 
817
 
 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
818
 
 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
819
 
 
820
 
=back
 
802
B<certdog> is Copyright 2013, pi-rho L<pi-rho@tyr.cx|mailto:pi-rho@tyr.cx> and
 
803
it is licensed under the BSD 3-clause license