File Coverage

blib/lib/Mojo/JWT.pm
Criterion Covered Total %
statement 69 78 88.4
branch 23 36 63.8
condition 6 15 40.0
subroutine 10 11 90.9
pod 6 6 100.0
total 114 146 78.0


line stmt bran cond sub pod time code
1             package Mojo::JWT;
2              
3 1     1   180956 use Mojo::Base -base;
  1         2  
  1         6  
4              
5             our $VERSION = '0.07';
6             $VERSION = eval $VERSION;
7              
8 1     1   584 use Mojo::JSON qw/encode_json decode_json/;
  1         14153  
  1         57  
9 1     1   6 use MIME::Base64 qw/encode_base64url decode_base64url/;
  1         1  
  1         83  
10              
11 1     1   7 use Carp;
  1         1  
  1         1058  
12              
13             has header => sub { {} };
14             has algorithm => 'HS256';
15             has [qw/allow_none set_iat/] => 0;
16             has claims => sub { {} };
17             has [qw/expires not_before/];
18             has [qw/public secret/] => '';
19              
20             my $re_hs = qr/^HS(\d+)$/;
21             my $re_rs = qr/^RS(\d+)$/;
22              
23             sub decode {
24 10     10 1 1269 my ($self, $token, $peek) = @_;
25 10         35 $self->{token} = $token;
26              
27             # reset
28 10         41 $self->algorithm(undef);
29 10         101 delete $self->{$_} for qw/claims expires not_before header/;
30              
31 10         52 my ($hstring, $cstring, $signature) = split /\./, $token;
32 10         39 my $header = decode_json decode_base64url($hstring);
33 10         2050 my $claims = decode_json decode_base64url($cstring);
34 10         1224 $signature = decode_base64url $signature;
35              
36             # typ header is only recommended and is ignored
37             # https://tools.ietf.org/html/rfc7519#section-5.1
38 10         130 delete $header->{typ};
39             croak 'Required header field "alg" not specified'
40 10 50       43 unless my $algo = $self->algorithm(delete $header->{alg})->algorithm;
41 10         141 $self->header($header);
42              
43 10 50       77 $self->$peek($claims) if $peek;
44              
45             # check signature
46 10         30 my $payload = "$hstring.$cstring";
47 10 100       132 if ($algo eq 'none') {
    100          
    50          
48 1 50       6 croak 'Algorithm "none" is prohibited'
49             unless $self->allow_none;
50             } elsif ($algo =~ $re_rs) {
51 2 100       9 croak 'Failed RS validation'
52             unless $self->verify_rsa($1, $payload, $signature);
53             } elsif ($algo =~ $re_hs) {
54 7 100       27 croak 'Failed HS validation'
55             unless $signature eq $self->sign_hmac($1, $payload);
56             } else {
57 0         0 croak 'Unsupported signing algorithm';
58             }
59              
60             # check timing
61 8         127 my $now = $self->now;
62 8 50       33 if (defined(my $exp = $claims->{exp})) {
63 0 0       0 croak 'JWT has expired' if $now > $exp;
64 0         0 $self->expires($exp);
65             }
66 8 50       27 if (defined(my $nbf = $claims->{nbf})) {
67 0 0       0 croak 'JWT is not yet valid' if $now < $nbf;
68 0         0 $self->not_before($nbf);
69             }
70              
71 8         26 return $self->claims($claims)->claims;
72             }
73              
74             sub encode {
75 10     10 1 89616 my $self = shift;
76 10         36 delete $self->{token};
77              
78 10         36 my $claims = $self->claims;
79 10 100       78 if ($self->set_iat) { $claims->{iat} = $self->now }
  1         9  
80 10 50       92 if (defined(my $exp = $self->expires)) { $claims->{exp} = $exp }
  0         0  
81 10 50       68 if (defined(my $nbf = $self->not_before)) { $claims->{nbf} = $nbf }
  0         0  
82              
83 10         53 my $header = { %{ $self->header }, typ => 'JWT', alg => $self->algorithm };
  10         31  
84 10         108 my $hstring = encode_base64url encode_json($header);
85 10         1284 my $cstring = encode_base64url encode_json($claims);
86 10         641 my $payload = "$hstring.$cstring";
87 10         18 my $signature;
88 10         33 my $algo = $self->algorithm;
89 10 100       145 if ($algo eq 'none') {
    100          
    50          
90 1         3 $signature = '';
91             } elsif ($algo =~ $re_rs) {
92 2         13 $signature = $self->sign_rsa($1, $payload);
93             } elsif ($algo =~ $re_hs) {
94 7         24 $signature = $self->sign_hmac($1, $payload);
95             } else {
96 0         0 croak 'Unknown algorithm';
97             }
98              
99 9         142 return $self->{token} = "$payload." . encode_base64url $signature;
100             }
101              
102 7     7   18 sub now { time }
103              
104             sub sign_hmac {
105 14     14 1 62 my ($self, $size, $payload) = @_;
106 14         95 require Digest::SHA;
107 14   66     274 my $f = Digest::SHA->can("hmac_sha$size") || croak 'Unsupported HS signing algorithm';
108 13         53 return $f->($payload, $self->secret);
109             }
110              
111             sub sign_rsa {
112 2     2 1 14 my ($self, $size, $payload) = @_;
113 2         25 require Crypt::OpenSSL::RSA;
114 2   33     11 my $crypt = Crypt::OpenSSL::RSA->new_private_key($self->secret || croak 'private key (secret) not specified');
115 2   33     121 my $method = $crypt->can("use_sha${size}_hash") || croak 'Unsupported RS signing algorithm';
116 2         11 $crypt->$method;
117 2         1418 return $crypt->sign($payload);
118             }
119              
120 0     0 1 0 sub token { shift->{token} }
121              
122             sub verify_rsa {
123 2     2 1 10 my ($self, $size, $payload, $signature) = @_;
124 2         13 require Crypt::OpenSSL::RSA;
125 2   33     9 my $crypt = Crypt::OpenSSL::RSA->new_public_key($self->public || croak 'public key not specified');
126 2   33     883 my $method = $crypt->can("use_sha${size}_hash") || croak 'Unsupported RS verification algorithm';
127 2         10 $crypt->$method;
128 2         313 return $crypt->verify($payload, $signature);
129             }
130              
131             1;
132              
133             =head1 NAME
134              
135             Mojo::JWT - JSON Web Token the Mojo way
136              
137             =head1 SYNOPSIS
138              
139             my $jwt = Mojo::JWT->new(claims => {...}, secret => 's3cr3t')->encode;
140             my $claims = Mojo::JWT->new(secret => 's3cr3t')->decode($jwt);
141              
142             =head1 DESCRIPTION
143              
144             JSON Web Token is described in L.
145             L implements that standard with an API that should feel familiar to L users (though of course it is useful elsewhere).
146             Indeed, JWT is much like L except that the result is a url-safe text string rather than a cookie.
147              
148             In JWT, the primary payload is called the C, and a few claims are reserved, as seen in the IETF document.
149             The header and the claims are signed when stringified to guard against tampering.
150             Note that while signed, the data is not encrypted, so don't use it to send secrets over clear channels.
151              
152             =head1 ATTRIBUTES
153              
154             L inherits all of the attributes from L and implements the following new ones.
155              
156             =head2 algorithm
157              
158             The algorithm to be used to sign a JWT during encoding or else the algorithm that was used for the most recent decoding.
159             Defaults to C until a decode is performed.
160              
161             C is an acceptable encoding algorithm, however for it to be used to decode, L must be set.
162              
163             =head2 allow_none
164              
165             To prevent spoofing attacks, C must be explicitly set to a true value otherwise decoding a JWT which specifies the C algorithm will result in an exception.
166             The default is of course false.
167              
168             =head2 claims
169              
170             The payload to be encoded or else the claims from the most recent decoding.
171             This must be a hash reference, array references are not allowed as the top-level JWT claims.
172              
173             =head2 expires
174              
175             The epoch time value after which the JWT value should not be considered valid.
176             This value (if set and not undefined) will be used as the C key in the claims or was extracted from the claims during the most recent decoding.
177              
178             =head2 header
179              
180             You may set your own headers when encoding the JWT bypassing a hash reference to the L attribute. Please note that there are two default headers set. B is set to the value of L or 'HS256' and B is set to 'JWT'. These cannot be overridden.
181              
182             =head2 not_before
183              
184             The epoch time value before which the JWT value should not be considered valid.
185             This value (if set and not undefined) will be used as the C key in the claims or was extracted from the claims during the most recent decoding.
186              
187             =head2 public
188              
189             The public key to be used in decoding an asymmetrically signed JWT (eg. RSA).
190              
191             =head2 secret
192              
193             The symmetric secret (eg. HMAC) or else the private key used in encoding an asymmetrically signed JWT (eg. RSA).
194              
195             =head2 set_iat
196              
197             If true (false by default), then the C claim will be set to the value of L during L.
198              
199             =head1 METHODS
200              
201             L inherits all of the methods from L and implements the following new ones.
202              
203             =head2 decode
204              
205             my $claims = $jwt->decode($token);
206              
207             my $peek = sub { my ($jwt, $claims) = @_; ... };
208             my $claims = $jwt->decode($token, $peek);
209              
210             Decode and parse a JSON Web Token string and return the claims hashref.
211             Calling this function immediately sets the L to the passed in token.
212             It also sets L to C and unsets L, L and L.
213             These values are then set as part of the parsing process.
214              
215             Parsing occurs as follows
216              
217             =over
218              
219             =item *
220              
221             The L is extracted from the header and set, if not present or permissible an exception is thrown
222              
223             =item *
224              
225             If a C<$peek> callback is provided, it is called with the instance and claims as arguments
226              
227             =item *
228              
229             The signature is verified or an exception is thrown
230              
231             =item *
232              
233             The timing claims (L and L), if present, are evaluated, failures result in exceptions. On success the values are set in the relevant attributes
234              
235             =item *
236              
237             The L attribute is set and the claims are returned.
238              
239             =back
240              
241             Note that when the C<$peek> callback is invoked, the claims have not yet been verified.
242             This callback is most likely to be used to inspect the C or issuer claim to determine a secret or key for decoding.
243             The return value is ignored, changes should be made to the instances attributes directly.
244             Since the L has already been parsed, it is available via the instance attribute as well.
245              
246             =head2 encode
247              
248             my $token = $jwt->encode;
249              
250             Encode the data expressed in the instance attributes: L, L, L, L.
251             Note that if the timing attributes are given, they override existing keys in the L.
252             Calling C immediately clears the L and upon completion sets it to the result as well as returning it.
253              
254             Note also that due to Perl's hash randomization, repeated encoding is not guaranteed to result in the same encoded string.
255             However any encoded string will survive an encode/decode roundtrip.
256              
257             =head2 header
258              
259             my $header = $jwt->header;
260              
261             Returns a hash reference representing the JWT header, constructed from instance attributes (see L).
262              
263             =head2 now
264              
265             my $time = $jwt->now;
266              
267             Returns the current time, currently implemented as the core C
268              
269             =head2 sign_hmac
270              
271             my $signature = $jwt->sign_hmac($size, $payload);
272              
273             Returns the HMAC SHA signature for the given size and payload.
274             The L attribute is used as the symmetric key.
275             The result is not yet base64 encoded.
276             This method is provided mostly for the purposes of subclassing.
277              
278             =head2 sign_rsa
279              
280             my $signature = $jwt->sign_rsa($size, $payload);
281              
282             Returns the RSA signature for the given size and payload.
283             The L attribute is used as the private key.
284             The result is not yet base64 encoded.
285             This method is provided mostly for the purposes of subclassing.
286              
287             =head2 token
288              
289             The most recently encoded or decoded token.
290             Note that any attribute modifications are not taken into account until L is called again.
291              
292             =head2 verify_rsa
293              
294             my $bool = $jwt->verify_rsa($size, $payload, $signature);
295              
296             Returns true if the given RSA size algorithm validates the given payload and signature.
297             The L attribute is used as the public key.
298             This method is provided mostly for the purposes of subclassing.
299              
300             =head1 SEE ALSO
301              
302             =over
303              
304             =item L
305              
306             =item L
307              
308             =item L
309              
310             =back
311              
312             =head1 SOURCE REPOSITORY
313              
314             L
315              
316             =head1 AUTHOR
317              
318             Joel Berger, Ejoel.a.berger@gmail.comE
319              
320             =head1 CONTRIBUTORS
321              
322             Christopher Raa (mishanti1)
323              
324             =head1 COPYRIGHT AND LICENSE
325              
326             Copyright (C) 2015 by L and L.
327              
328             This library is free software; you can redistribute it and/or modify
329             it under the same terms as Perl itself.
330