File Coverage

lib/XML/Compile/WSS/SecToken/X509v3.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             # Copyrights 2012-2013 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.01.
5 1     1   2629 use warnings;
  1         2  
  1         43  
6 1     1   6 use strict;
  1         2  
  1         58  
7              
8             package XML::Compile::WSS::SecToken::X509v3;
9 1     1   6 use vars '$VERSION';
  1         2  
  1         78  
10             $VERSION = '2.01';
11              
12 1     1   8 use base 'XML::Compile::WSS::SecToken';
  1         1  
  1         188  
13              
14             use Log::Report 'xml-compile-wss-sig';
15              
16             use XML::Compile::WSS::Util qw/XTP10_X509v3/;
17              
18             use Scalar::Util qw/blessed/;
19             use Crypt::OpenSSL::X509 qw/FORMAT_ASN1 FORMAT_PEM/;
20              
21              
22             sub init($)
23             { my ($self, $args) = @_;
24             $args->{cert_file} and panic "removed in 1.07, use fromFile()";
25              
26             $args->{type} ||= XTP10_X509v3;
27              
28             my $cert;
29             if($cert = $args->{certificate}) {}
30             elsif(my $bin = $args->{binary})
31             { $cert = Crypt::OpenSSL::X509->new_from_string($bin, FORMAT_ASN1) }
32             else { error __x"certificate or binary required for X509 token" }
33              
34             blessed $cert && $cert->isa('Crypt::OpenSSL::X509')
35             or error __x"X509 certificate object not supported (yet)";
36              
37             $args->{name} ||= $cert->subject;
38             $args->{fingerprint} ||= $cert->fingerprint_sha1;
39             $self->SUPER::init($args);
40              
41             $self->{XCWSX_cert} = $cert;
42             $self;
43             }
44              
45              
46             sub fromFile($%)
47             { my ($class, $fn, %args) = @_;
48              
49             # openssl's error message are a poor
50             -f $fn or error __x"key file {fn} does not exit", fn => $fn;
51              
52             my $format = delete $args{format} || FORMAT_PEM;
53             my $cert = eval { Crypt::OpenSSL::X509->new_from_file($fn, $format) };
54             if($@)
55             { my $err = $@;
56             $err =~ s/\. at.*//;
57             error __x"in file {file}: {err}" , file => $fn, err => $err;
58             }
59              
60             $class->new(certificate => $cert, %args);
61             }
62              
63             #------------------------
64              
65             sub certificate() {shift->{XCWSX_cert}}
66              
67             #------------------------
68              
69             sub asBinary() {shift->certificate->as_string(FORMAT_ASN1)}
70              
71             1;