File Coverage

blib/lib/OpenID/Lite/Provider/AssociationBuilder.pm
Criterion Covered Total %
statement 51 51 100.0
branch 14 24 58.3
condition 16 34 47.0
subroutine 9 9 100.0
pod 0 3 0.0
total 90 121 74.3


line stmt bran cond sub pod time code
1             package OpenID::Lite::Provider::AssociationBuilder;
2              
3 2     2   3124 use Any::Moose;
  2         42881  
  2         19  
4 2     2   2610 use Digest::SHA;
  2         4171  
  2         105  
5 2     2   1000 use String::Random;
  2         2998  
  2         178  
6 2     2   597 use OpenID::Lite::Association;
  2         7  
  2         44  
7 2     2   605 use OpenID::Lite::SignatureMethods;
  2         4  
  2         826  
8             with 'OpenID::Lite::Role::ErrorHandler';
9              
10             has 'server_secret' => (
11             is => 'ro',
12             isa => 'Str',
13             default => q{secret},
14             );
15              
16             has 'secret_lifetime' => (
17             is => 'ro',
18             isa => 'Int',
19             default => 86400,
20             );
21              
22             #has 'secret_gen_interval' => (
23             # is => 'ro',
24             # isa => 'Int',
25             # default => 86400,
26             #);
27             #
28             #has 'get_server_secret' => (
29             # is => 'ro',
30             # isa => 'CodeRef',
31             # default => sub {
32             # sub {
33             # my $sec_time = shift;
34             # my $secret = '';
35             # return $secret;
36             # }
37             # },
38             #);
39             #
40              
41             sub build_association {
42 12     12 0 4242 my $self = shift;
43 12         39 my %opts = @_;
44 12         18 my $type = $opts{type};
45 12   100     55 my $dumb = $opts{dumb} || 0;
46 12   33     65 my $lifetime = $opts{lifetime} || $self->secret_lifetime;
47              
48 12 50       48 my $signature_method
49             = OpenID::Lite::SignatureMethods->select_method($type)
50             or return $self->ERROR( sprintf q{Invalid assoc_type "%s"}, $type );
51              
52 12         25 my $now = time();
53             #my $sec_time = $now - ( $now % $self->secret_gen_interval );
54             #my $s_sec = $self->get_server_secret->($sec_time)
55             # || $self->server_secret;
56 12         29 my $s_sec = $self->server_secret;
57              
58 12         60 my $random = String::Random->new;
59 12         258 my $nonce = $random->randregex( sprintf '[a-zA-Z0-9]{%d}', 20 );
60 12 100       3533 $nonce = sprintf( q{STLS.%s}, $nonce ) if $dumb;
61              
62 12         47 my $handle = sprintf( q{%d:%s:%s}, $now, $type, $nonce );
63 12         52 $handle
64             .= ":"
65             . substr( $signature_method->hmac_hash_hex( $handle, $s_sec ), 0,
66             10 );
67 12 50       41 my $c_sec = $self->secret_of_handle( $handle, $dumb, 1 )
68             or return;
69              
70 12         162 my $assoc = OpenID::Lite::Association->new(
71             secret => $c_sec,
72             handle => $handle,
73             type => $type,
74             expires_in => $lifetime,
75             issued => $now
76             );
77 12         86 return $assoc;
78             }
79              
80             sub build_from_handle {
81 4     4 0 2414 my ( $self, $handle, $opts ) = @_;
82              
83 4   100     22 my $dumb = $opts->{dumb} || 0;
84 4   33     27 my $lifetime = $opts->{lifetime} || $self->secret_lifetime;
85 4         20 my ( $time, $type, $nonce, $nonce_sig80 ) = split( /:/, $handle );
86 4 50 33     49 return $self->ERROR(q{not found proper time,type,nonce and nonce_sig80})
      33        
      33        
87             unless $time =~ /^\d+$/ && $type && $nonce && $nonce_sig80;
88              
89 4 50       11 my $secret = $self->secret_of_handle( $handle, $dumb )
90             or return;
91              
92 4         72 return OpenID::Lite::Association->new(
93             secret => $secret,
94             handle => $handle,
95             type => $type,
96             issued => $time,
97             expires_in => $lifetime,
98             );
99              
100             }
101              
102             sub secret_of_handle {
103 20     20 0 2738 my ( $self, $handle, $dumb, $no_verify ) = @_;
104 20         78 my ( $time, $type, $nonce, $nonce_sig80 ) = split( /:/, $handle );
105 20 50 33     231 return $self->ERROR(q{not found proper time,type,nonce and nonce_sig80})
      33        
      33        
106             unless $time =~ /^\d+$/ && $type && $nonce && $nonce_sig80;
107 20 50 66     93 return $self->ERROR(q{nonce is invalid for dumb-mode})
108             if $dumb && $nonce !~ /^STLS\./;
109 20 50       64 my $signature_method
110             = OpenID::Lite::SignatureMethods->select_method($type)
111             or return $self->ERROR( sprintf q{Invalid assoc_type, "%s"}, $type );
112              
113             #my $sec_time = $time - ( $time % $self->secret_gen_interval );
114             #my $s_sec = $self->get_server_secret->($sec_time)
115             # || $self->server_secret;
116 20         48 my $s_sec = $self->server_secret;
117              
118 20 100       59 length($nonce) == ( $dumb ? 25 : 20 )
    50          
119             or return $self->ERROR(q{Invalid nonce length});
120 20 50       50 length($nonce_sig80) == 10
121             or return $self->ERROR(q{Invalid nonce_sig80 length});
122              
123 20 50 66     236 return $self->ERROR(q{Failed to verify nonce_sig80.})
124             unless $no_verify
125             || $nonce_sig80 eq substr(
126             $signature_method->hmac_hash_hex(
127             sprintf( q{%d:%s:%s}, $time, $type, $nonce ), $s_sec
128             ),
129             0, 10
130             );
131 20         65 return $signature_method->hmac_hash( $handle, $s_sec );
132             }
133              
134 2     2   960 no Any::Moose;
  2         5  
  2         12  
135             __PACKAGE__->meta->make_immutable;
136             1;
137