line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyrights 2012-2016 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.02. |
5
|
1
|
|
|
1
|
|
128540
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
6
|
1
|
|
|
1
|
|
3
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package XML::Compile::WSS::SecToken; |
9
|
1
|
|
|
1
|
|
10
|
use vars '$VERSION'; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
37
|
|
10
|
|
|
|
|
|
|
$VERSION = '2.02'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
3
|
use Log::Report 'xml-compile-wss-sig'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
200
|
use XML::Compile::WSS::Util qw/XTP10_X509v3 WSU_10 :wsm10 :wsm11 XENC_NS/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
121
|
|
16
|
1
|
|
|
1
|
|
4
|
use Scalar::Util qw/blessed/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
389
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub new(@) |
20
|
0
|
|
|
0
|
1
|
|
{ my $class = shift; |
21
|
0
|
0
|
|
|
|
|
my $args = @_==1 ? shift : {@_}; |
22
|
0
|
|
0
|
|
|
|
my $type = delete $args->{type} || XTP10_X509v3; |
23
|
0
|
0
|
|
|
|
|
if($class eq __PACKAGE__) |
24
|
0
|
0
|
|
|
|
|
{ if($type =~ /509/) |
25
|
0
|
|
|
|
|
|
{ $class = 'XML::Compile::WSS::SecToken::X509v3'; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
else |
28
|
0
|
|
|
|
|
|
{ error __x"security token type {type} not (yet) supported" |
29
|
|
|
|
|
|
|
, type => $type; |
30
|
|
|
|
|
|
|
} |
31
|
0
|
0
|
|
|
|
|
eval "require $class"; panic $@ if $@; |
|
0
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
} |
33
|
0
|
|
|
|
|
|
(bless {XCWS_type => $type}, $class)->init($args); |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub init($) |
37
|
0
|
|
|
0
|
0
|
|
{ my ($self, $args) = @_; |
38
|
0
|
|
0
|
|
|
|
$self->{XCWS_id} = $args->{id} || 'my-token'; |
39
|
0
|
|
0
|
|
|
|
$self->{XCWS_enc} = $args->{encoding} || WSM10_BASE64; |
40
|
0
|
|
|
|
|
|
$self->{XCWS_fp} = $args->{fingerprint}; |
41
|
0
|
|
0
|
|
|
|
$self->{XCWS_uri} = $args->{uri} || '#TOKEN-'.($self+0); |
42
|
0
|
|
|
|
|
|
$self->{XCWS_name} = $args->{name}; |
43
|
0
|
|
|
|
|
|
$self; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub fromConfig($%) |
48
|
0
|
|
|
0
|
1
|
|
{ my ($class, $config, %args) = @_; |
49
|
0
|
|
0
|
|
|
|
$args{type} ||= XTP10_X509v3; |
50
|
|
|
|
|
|
|
|
51
|
0
|
0
|
|
|
|
|
return $class->new(%$config, %args) |
52
|
|
|
|
|
|
|
if ref $config eq 'HASH'; |
53
|
|
|
|
|
|
|
|
54
|
0
|
0
|
|
|
|
|
blessed $config |
55
|
|
|
|
|
|
|
or panic "token configuration requires HASH or OBJECT."; |
56
|
|
|
|
|
|
|
|
57
|
0
|
0
|
|
|
|
|
return $config |
58
|
|
|
|
|
|
|
if $config->isa(__PACKAGE__); |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
return $class->new(%args, certificate => $config) |
61
|
|
|
|
|
|
|
if ref $config =~ m/::X509/; # there are a few options here |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
panic "token configuration `$config' not recognized"; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
#----------------- |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
0
|
1
|
|
sub id() {shift->{XCWS_id}} |
69
|
0
|
|
|
0
|
1
|
|
sub type() {shift->{XCWS_type}} |
70
|
0
|
|
|
0
|
1
|
|
sub encoding() {shift->{XCWS_enc}} |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
0
|
1
|
|
sub fingerprint{shift->{XCWS_fp}} |
73
|
0
|
|
|
0
|
1
|
|
sub uri() {shift->{XCWS_uri}} |
74
|
0
|
|
|
0
|
0
|
|
sub name() {shift->{XCWS_name}} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
#----------------- |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
1; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
__END__ |