File Coverage

blib/lib/Crypt/JWT.pm
Criterion Covered Total %
statement 508 571 88.9
branch 342 510 67.0
condition 102 208 49.0
subroutine 46 46 100.0
pod 2 2 100.0
total 1000 1337 74.7


line stmt bran cond sub pod time code
1             package Crypt::JWT;
2              
3 14     14   1444643 use strict;
  14         31  
  14         527  
4 14     14   149 use warnings;
  14         31  
  14         1123  
5              
6             our $VERSION = '0.038';
7              
8 14     14   120 use Exporter 'import';
  14         26  
  14         1378  
9             our %EXPORT_TAGS = ( all => [qw(decode_jwt encode_jwt)] );
10             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
11             our @EXPORT = qw();
12              
13 14     14   84 use Carp;
  14         85  
  14         1092  
14 14     14   6734 use Crypt::Misc qw(decode_b64u encode_b64u slow_eq);
  14         378880  
  14         1477  
15 14     14   112 use JSON qw(decode_json encode_json);
  14         25  
  14         102  
16 14     14   11238 use Crypt::PK::RSA;
  14         53079  
  14         780  
17 14     14   8655 use Crypt::PK::ECC;
  14         54976  
  14         941  
18 14     14   7557 use Crypt::PK::Ed25519;
  14         27946  
  14         893  
19 14     14   7416 use Crypt::PK::X25519;
  14         23370  
  14         828  
20 14     14   97 use Crypt::PRNG qw(random_bytes);
  14         24  
  14         742  
21 14     14   7423 use Crypt::KeyWrap ':all';
  14         69  
  14         3093  
22 14     14   106 use Crypt::AuthEnc::GCM qw(gcm_encrypt_authenticate gcm_decrypt_verify);
  14         58  
  14         878  
23 14     14   6989 use Crypt::Mac::HMAC qw(hmac);
  14         19580  
  14         986  
24 14     14   8847 use Compress::Raw::Zlib;
  14         88973  
  14         4573  
25 14     14   417 use Scalar::Util qw(looks_like_number);
  14         211  
  14         156814  
26              
27             # DoS guards on decode
28             our $MAX_PBES2_ITER = 3_000_000; # max accepted PBES2 'p2c' (iteration count)
29             our $MAX_INFLATED_SIZE = 10 * 1024 * 1024; # max accepted size of payload after 'zip' inflation
30              
31             # Key-strength minimums. Values lower than the RFC 7518 strict requirement
32             # but high enough that the cryptographic security argument holds (see
33             # SECURITY CONSIDERATIONS in the POD). Tunable at startup if a deployer has
34             # a stronger or weaker policy.
35             our $MIN_HMAC_KEY_LEN = 4; # minimum HMAC key length (bytes) for HS256/HS384/HS512
36             our $MIN_RSA_BITS = 2048; # minimum RSA modulus size (bits) for RS*/PS*/RSA-OAEP*/RSA1_5
37              
38             # Compact-serialization token shape; precompiled to avoid rebuilding per decode_jwt() call.
39             my $TOKEN_RE_STRICT = qr/^([a-zA-Z0-9_-]+)=*\.([a-zA-Z0-9_-]*)=*\.([a-zA-Z0-9_-]*)=*(?:\.([a-zA-Z0-9_-]+)=*\.([a-zA-Z0-9_-]+)=*)?$/;
40             my $TOKEN_RE_PADDING = qr/^([a-zA-Z0-9_-]+=*)\.([a-zA-Z0-9_-]*=*)\.([a-zA-Z0-9_-]*=*)(?:\.([a-zA-Z0-9_-]+=*)\.([a-zA-Z0-9_-]+=*))?$/;
41              
42             # JWS: https://tools.ietf.org/html/rfc7515
43             # JWE: https://tools.ietf.org/html/rfc7516
44             # JWK: https://tools.ietf.org/html/rfc7517
45             # JWA: https://tools.ietf.org/html/rfc7518
46             # JWT: https://tools.ietf.org/html/rfc7519
47             # X25519/Ed25519 https://tools.ietf.org/html/rfc8037
48              
49             sub _prepare_rsa_key {
50 98     98   206 my ($key) = @_;
51 98 50       229 croak "JWT: undefined RSA key" unless defined $key;
52 98 100       438 croak "JWT: invalid RSA key (cannot be scalar)" unless ref $key;
53             # we need Crypt::PK::RSA object
54 97         165 my $pk;
55 97 100 66     355 if (ref($key) eq 'Crypt::PK::RSA') { $pk = $key }
  48 50       74  
    0          
56 49         305 elsif (ref($key) eq 'HASH' || ref($key) eq 'SCALAR') { $pk = Crypt::PK::RSA->new($key) }
57 0         0 elsif (ref($key) eq 'ARRAY') { $pk = Crypt::PK::RSA->new(@$key) }
58             else {
59             # handle also: Crypt::OpenSSL::RSA, Crypt::X509, Crypt::OpenSSL::X509
60 0         0 my $str;
61 0 0       0 if (ref($key) eq 'Crypt::OpenSSL::RSA') {
    0          
62             # https://metacpan.org/pod/Crypt::OpenSSL::RSA
63 0 0       0 $str = $key->is_private ? $key->get_private_key_string : $key->get_public_key_string;
64             }
65             elsif (ref($key) =~ /^Crypt::(X509|OpenSSL::X509)$/) {
66             # https://metacpan.org/pod/Crypt::X509
67             # https://metacpan.org/pod/Crypt::OpenSSL::X509
68 0         0 $str = $key->pubkey;
69             }
70 0 0 0     0 $pk = Crypt::PK::RSA->new(\$str) if defined $str && !ref($str);
71             }
72 97 50       16430 croak "JWT: invalid RSA key" unless $pk;
73             # RFC 7518 sec 3.3: "A key of size 2048 bits or larger MUST be used".
74             # Check via Crypt::PK::RSA->size which returns the modulus size in bytes.
75 97         451 my $bits = $pk->size * 8;
76 97 50       257 croak "JWT: RSA modulus too small ($bits bits, minimum $MIN_RSA_BITS)" if $bits < $MIN_RSA_BITS;
77 97         220 return $pk;
78             }
79              
80             sub _prepare_ecc_key {
81 21     21   47 my ($key) = @_;
82 21 50       96 croak "JWT: undefined ECC key" unless defined $key;
83 21 100       237 croak "JWT: invalid ECC key (cannot be scalar)" unless ref $key;
84             # we need Crypt::PK::ECC object
85 20 100       90 return $key if ref($key) eq 'Crypt::PK::ECC';
86 12 50 66     121 return Crypt::PK::ECC->new($key) if ref($key) eq 'HASH' || ref($key) eq 'SCALAR';
87 0 0       0 return Crypt::PK::ECC->new(@$key) if ref($key) eq 'ARRAY';
88 0         0 croak "JWT: invalid ECC key";
89             }
90              
91             sub _prepare_ed25519_key {
92 4     4   12 my ($key) = @_;
93 4 50       14 croak "JWT: undefined Ed25519 key" unless defined $key;
94 4 50       13 croak "JWT: invalid Ed25519 key (cannot be scalar)" unless ref $key;
95             # we need Crypt::PK::Ed25519 object
96 4 50       14 return $key if ref($key) eq 'Crypt::PK::Ed25519';
97 4 50 66     85 return Crypt::PK::Ed25519->new($key) if ref($key) eq 'HASH' || ref($key) eq 'SCALAR';
98 0 0       0 return Crypt::PK::Ed25519->new(@$key) if ref($key) eq 'ARRAY';
99 0         0 croak "JWT: invalid Ed25519 key";
100             }
101              
102             sub _prepare_ecdh_key {
103 60     60   159 my ($key) = @_;
104 60 50       221 croak "JWT: undefined ECDH key" unless defined $key;
105 60 50       181 croak "JWT: invalid ECDH key (cannot be scalar)" unless ref $key;
106              
107             # we need Crypt::PK::X25519 or Crypt::PK::ECC object
108 60 100       389 return $key if ref($key) =~ /^Crypt::PK::(ECC|X25519)$/;
109              
110 12 50 66     56 if (ref($key) eq 'HASH' || ref($key) eq 'SCALAR') {
111             #HACK: this is ugly
112 12   66     24 my $rv = eval { Crypt::PK::ECC->new($key) } || eval { Crypt::PK::X25519->new($key) };
113 12 50       89529 return $rv if defined $rv;
114             }
115 0 0       0 if (ref($key) eq 'ARRAY') {
116             #HACK: this is ugly
117 0   0     0 my $rv = eval { Crypt::PK::ECC->new(@$key) } || eval { Crypt::PK::X25519->new(@$key) };
118 0 0       0 return $rv if defined $rv;
119             }
120 0         0 croak "JWT: invalid ECDH key";
121             }
122              
123             sub _prepare_oct_key {
124 300     300   737 my ($key) = @_;
125 300 50       720 croak "JWT: undefined oct key" unless defined $key;
126 300 100 66     1266 if (ref $key eq 'HASH' && $key->{k} && $key->{kty} && $key->{kty} eq 'oct') {
    50 33        
      33        
127 15         99 return decode_b64u($key->{k});
128             }
129             elsif (!ref $key) {
130 285         1321 return $key;
131             }
132 0         0 croak "JWT: invalid oct key";
133             }
134              
135             sub _kid_lookup {
136 4     4   11 my ($kid, $kid_keys, $alg) = @_;
137 4 50 33     18 return undef if !defined $kid || !defined $alg;
138 4 100 66     18 $kid_keys = eval { decode_json($kid_keys) } if $kid_keys && !ref $kid_keys;
  2         16  
139 4 50       9 croak "JWT: kid_keys must be a HASHREF or a valid JSON/HASH" if ref $kid_keys ne 'HASH';
140 4         7 my $found;
141 4 50 33     22 if (exists $kid_keys->{keys} && ref $kid_keys->{keys} eq 'ARRAY') {
142             #FORMAT: { keys => [ {kid=>'A', kty=>?, ...}, {kid=>'B', kty=>?, ...} ] }
143 4         7 my @keys = @{$kid_keys->{keys}};
  4         9  
144              
145             # Sanity-check the keyset before lookup. Both checks defend against
146             # ambiguous keysets where the lookup result depends on iteration order
147             # (a possible alg-confusion vector).
148             # 1. Duplicate kids: a token's 'kid' header must resolve to one key.
149             # 2. Mixed symmetry: a keyset that contains BOTH symmetric (kty=oct)
150             # and asymmetric (RSA/EC/OKP) keys lets an attacker pick the type
151             # that suits a forged token.
152 4         7 my (%seen_kid, $has_oct, $has_asym);
153 4         10 for my $k (@keys) {
154 8 50       16 if (defined $k->{kid}) {
155 8 50       24 croak "JWT: kid_keys contains duplicate kid '$k->{kid}'" if $seen_kid{$k->{kid}}++;
156             }
157 8 50 50     21 $has_oct = 1 if ($k->{kty} || '') eq 'oct';
158 8 50 50     30 $has_asym = 1 if ($k->{kty} || '') =~ /^(RSA|EC|OKP)$/;
159             }
160 4 50 33     30 croak "JWT: kid_keys mixes symmetric (oct) and asymmetric keys" if $has_oct && $has_asym;
161              
162 4         10 for (@keys) {
163 8 100 33     55 if ($_->{kid} && $_->{kty} && $_->{kid} eq $kid) {
      66        
164 4         5 $found = $_;
165 4         15 last;
166             }
167             }
168             }
169             else {
170             #FORMAT: { hexadec1 => "----BEGIN CERTIFICATE-----...", hexadec2 => "----BEGIN CERTIFICATE-----..." }
171             #e.g. https://www.googleapis.com/oauth2/v1/certs
172 0 0 0     0 return \$kid_keys->{$kid} if $kid_keys->{$kid} && !ref $kid_keys->{$kid};
173             }
174 4 50       10 return undef if !$found;
175 4 50 33     30 return $found if $found->{kty} eq 'oct' && $alg =~ /^(HS|dir|PBES2-HS|A)/;
176 0 0 0     0 return $found if $found->{kty} eq 'OKP' && $alg =~ /^(EdDSA|ECDH-ES)/;
177 0 0 0     0 return $found if $found->{kty} eq 'EC' && $alg =~ /^(ES|EC)/;
178 0 0 0     0 return $found if $found->{kty} eq 'RSA' && $alg =~ /^(RS|PS)/;
179 0         0 croak "JWT: key type '$found->{kty}' cannot be used with alg '$alg'";
180             }
181              
182             sub _b64u_to_hash {
183 341     341   683 my $b64url = shift;
184 341 50       816 return undef unless $b64url;
185 341         1894 my $json = decode_b64u($b64url);
186 341 50       847 return undef unless $json;
187 341         561 my $hash = eval { decode_json($json) };
  341         2373  
188 341 50       1163 return undef unless ref $hash eq 'HASH';
189 341         707 return $hash;
190             }
191              
192             sub _add_claims {
193 29     29   85 my ($payload, %args) = @_;
194             #### claims (defined for JWS only)
195             # "exp" Expiration Time
196             # "nbf" Not Before
197             # "iat" Issued At
198             # "iss" Issuer
199             # "sub" Subject
200             # "aud" Audience
201             # "jti" JWT ID
202 29         44 my $now = time;
203 29 100       69 $payload->{iat} = $now if $args{auto_iat};
204 29 100       66 $payload->{exp} = $now + $args{relative_exp} if defined $args{relative_exp};
205 29 100       93 $payload->{nbf} = $now + $args{relative_nbf} if defined $args{relative_nbf};
206             }
207              
208             sub _check_jwk_constraints {
209             # RFC 7517 sections 4.2/4.3/4.4: enforce JWK metadata when the key is supplied as
210             # a JWK hash (either via 'key' directly or resolved via 'kid_keys'). For
211             # non-JWK key forms (Crypt::PK::* objects, scalar refs, bare HMAC scalars)
212             # there is no metadata to consult and we silently skip.
213 326     326   814 my ($key, $alg, $what) = @_; # $what is 'JWS' or 'JWE'
214 326 100       1134 return unless ref $key eq 'HASH';
215              
216             # 'alg' (sec 4.4): if present, must match. For JWS the same RSA/EC key can
217             # legitimately verify across different hash sizes within the same family
218             # (PS256 key verifying a PS384 token, ES512 key verifying an ES256 token,
219             # etc.) - see RFC 7520 examples. So JWS matches by family (HS/RS/PS/ES/
220             # EdDSA), while JWE - where a different alg means a different padding or
221             # wrap mechanism, not just a hash size - still requires exact match.
222 44 100       196 if (defined $key->{alg}) {
223 5         17 my $jwk_alg = $key->{alg};
224 5         9 my $ok;
225 5 100       17 if ($what eq 'JWS') {
226 2 50   4   13 my $fam_of = sub { $_[0] =~ /^(HS|RS|PS|ES|EdDSA)/ ? $1 : $_[0] };
  4         30  
227 2         8 $ok = $fam_of->($jwk_alg) eq $fam_of->($alg);
228             }
229             else {
230 3         8 $ok = $jwk_alg eq $alg;
231             }
232 5 50       17 croak "$what: JWK 'alg' ($jwk_alg) does not match token alg ($alg)" unless $ok;
233             }
234              
235             # 'use' (sec 4.2): 'sig' for JWS verify, 'enc' for JWE decrypt
236 44 100       145 my $expected_use = $what eq 'JWS' ? 'sig' : 'enc';
237 44 50 66     174 if (defined $key->{use} && $key->{use} ne $expected_use) {
238 0         0 croak "$what: JWK 'use' ($key->{use}) does not allow $expected_use op";
239             }
240              
241             # 'key_ops' (sec 4.3): if present, must include the operation we are about to do
242 44 50       135 if (ref $key->{key_ops} eq 'ARRAY') {
243 0 0       0 my @want = $what eq 'JWS' ? ('verify') : ('decrypt', 'unwrapKey', 'deriveKey', 'deriveBits');
244 0         0 my %ops = map { $_ => 1 } @{$key->{key_ops}};
  0         0  
  0         0  
245 0         0 my $found = 0;
246 0   0     0 $found ||= $ops{$_} for @want;
247 0 0       0 croak "$what: JWK 'key_ops' [@{$key->{key_ops}}] does not include any of: @want" unless $found;
  0         0  
248             }
249              
250             # EC self-consistency: an EC JWK's 'alg' implies a specific curve per
251             # RFC 7518 sec 3.4. If the JWK's 'crv' disagrees with what the 'alg'
252             # demands, the JWK is malformed and we refuse to use it. ES521 is
253             # accepted as a historical alias for ES512 (used in some older test
254             # vectors and implementations).
255 44 50 100     289 if (($key->{kty} || '') eq 'EC' && defined $key->{alg} && defined $key->{crv}) {
      66        
      33        
256 0         0 my %ec_curve_for = (
257             ES256 => 'P-256',
258             ES256K => 'secp256k1',
259             ES384 => 'P-384',
260             ES512 => 'P-521',
261             ES521 => 'P-521',
262             );
263 0 0       0 if (exists $ec_curve_for{$key->{alg}}) {
    0          
264             croak "$what: JWK alg/crv mismatch ($key->{alg} requires $ec_curve_for{$key->{alg}}, got $key->{crv})"
265 0 0       0 if $ec_curve_for{$key->{alg}} ne $key->{crv};
266             }
267             elsif ($key->{alg} =~ /^ES/) {
268 0         0 croak "$what: JWK has unknown ECDSA alg '$key->{alg}'";
269             }
270             }
271             }
272              
273             sub _check_accepted {
274 533     533   1662 my ($what, $value, $check) = @_;
275 533 100       1376 return unless defined $check;
276 18         38 my $r = ref $check;
277 18 50       67 if ($r eq 'Regexp') { croak "JWT: $what '$value' does not match accepted_$what" if $value !~ $check }
  3 100       540  
    100          
    50          
278 6         15 elsif ($r eq 'ARRAY') { my %ok = map { $_ => 1 } @$check;
  15         37  
279 6 100       646 croak "JWT: $what '$value' not in accepted_$what" unless $ok{$value} }
280 9 100       476 elsif (!$r) { croak "JWT: $what '$value' not accepted_$what" if $value ne $check }
281 0         0 else { croak "JWT: accepted_$what must be Regexp, ARRAY ref, or Scalar (got $r)" }
282             }
283              
284             sub _verify_header {
285 290     290   2058 my ($header, %args) = @_;
286              
287             # currently we only check "typ" header parameter
288 290         580 my $check = $args{verify_typ};
289 290 100       862 return if !defined $check;
290              
291 18 100       68 if (exists $header->{typ}) {
292 12 100       45 if (ref $check eq 'Regexp') {
    100          
    50          
293 4         28 my $value = $header->{typ};
294 4 50       12 $value = "" if !defined $value;
295 4 100       386 croak "JWT: typ header re check failed" unless $value =~ $check;
296             }
297             elsif (ref $check eq 'CODE') {
298 4 100       18 croak "JWT: typ header code check failed" unless $check->($header->{typ});
299             }
300             elsif (!ref $check) {
301 4         27 my $value = $header->{typ};
302 4 100 66     345 croak "JWT: typ header scalar check failed" unless defined $value && $value eq $check;
303             }
304             else {
305 0         0 croak "JWT: verify_typ must be Regexp, Scalar or CODE";
306             }
307             }
308             else {
309 6         1378 croak "JWT: typ header required but missing"
310             }
311              
312             }
313              
314             sub _check_numeric_date {
315 79     79   134 my ($payload, $claim) = @_;
316 79         100 my $value = $payload->{$claim};
317 79 100 33     842 croak "JWT: $claim claim must be a NumericDate"
      66        
318             if !defined($value) || ref($value) || "$value" !~ /\A(?:0|[1-9][0-9]*)(?:\.[0-9]+)?\z/;
319             }
320              
321             sub _verify_claims {
322 327     327   1238 my ($payload, %args) = @_;
323              
324 327 100       975 return if $args{ignore_claims};
325              
326 326 100       859 if (ref($payload) ne 'HASH') {
327             # https://github.com/DCIT/perl-Crypt-JWT/issues/31
328             # payload needs to be decoded into a HASH for checking any verify_XXXX
329 227         583 for my $claim (qw(exp nbf iat iss sub aud jti)) {
330 1577 100 100     3771 if (defined $args{"verify_$claim"} && $args{"verify_$claim"} != 0) {
331 2         408 croak "JWT: cannot check verify_$claim (payload not decoded JSON/HASH)";
332             }
333             }
334 225         613 return; # nothing to check
335             }
336              
337 99   100     359 my $leeway = $args{leeway} || 0;
338 99         159 my $now = time;
339              
340             ### exp
341 99 100 33     282 if(defined $payload->{exp}) {
    50          
342 58 100 100     180 if (!defined $args{verify_exp} || $args{verify_exp}==1) {
343 43         85 _check_numeric_date($payload, 'exp');
344 42 100       956 croak "JWT: exp claim check failed ($payload->{exp}/$leeway vs. $now)" if $payload->{exp} + $leeway <= $now;
345             }
346             }
347             elsif ($args{verify_exp} && $args{verify_exp}==1) {
348 0         0 croak "JWT: exp claim required but missing"
349             }
350              
351             ### nbf
352 91 100 33     293 if(defined $payload->{nbf}) {
    50          
353 32 100 100     56 if (!defined $args{verify_nbf} || $args{verify_nbf}==1) {
354 31         49 _check_numeric_date($payload, 'nbf');
355 30 100       407 croak "JWT: nbf claim check failed ($payload->{nbf}/$leeway vs. $now)" if $payload->{nbf} - $leeway > $now;
356             }
357             }
358             elsif ($args{verify_nbf} && $args{verify_nbf}==1) {
359 0         0 croak "JWT: nbf claim required but missing"
360             }
361              
362             ### iat
363 87 100       174 if (exists $args{verify_iat}) { #default (non existing verify_iat) == no iat check
364 6 50 0     23 if(defined $payload->{iat}) {
    0          
365 6 100 100     19 if (!defined $args{verify_iat} || $args{verify_iat}==1) {
366 5         9 _check_numeric_date($payload, 'iat');
367 4 100       228 croak "JWT: iat claim check failed ($payload->{iat}/$leeway vs. $now)" if $payload->{iat} - $leeway > $now;
368             }
369             }
370             elsif ($args{verify_iat} && $args{verify_iat}==1) {
371 0         0 croak "JWT: iat claim required but missing"
372             }
373             }
374              
375             ### aud
376 84 100       171 if (defined $args{verify_aud}) {
377 23         32 my $check = $args{verify_aud};
378 23 100       29 if (exists $payload->{aud}) {
379 22         24 my $match = 0;
380             # aud claim is a bit special as it can be either a string or an array of strings
381 22 100       56 my @aud_list = ref $payload->{aud} eq 'ARRAY' ? @{$payload->{aud}} : ( $payload->{aud} );
  6         13  
382 22         33 for my $value (@aud_list) {
383 28 100       58 if (ref $check eq 'Regexp') {
    100          
    50          
384 10 100       23 $value = "" if !defined $value;
385 10 100       58 $match = 1 if $value =~ $check;
386             }
387             elsif (ref $check eq 'CODE') {
388 9 100       18 $match = 1 if $check->($value);
389             }
390             elsif (!ref $check) {
391 9 100 66     30 $match = 1 if defined $value && $value eq $check;
392             }
393             }
394 22 100       1040 croak "JWT: aud claim check failed" if !$match;
395             }
396             else {
397 1         109 croak "JWT: aud claim required but missing"
398             }
399             }
400              
401             ### iss, sub, jti
402 76         163 foreach my $claim (qw(iss sub jti)) {
403 216         361 my $check = $args{"verify_$claim"};
404 216 100       482 next unless (defined $check);
405              
406 30 100       41 if (exists $payload->{$claim}) {
407 27 100       44 if (ref $check eq 'Regexp') {
    100          
    50          
408 9         13 my $value = $payload->{$claim};
409 9 50       19 $value = "" if !defined $value;
410 9 100       588 croak "JWT: $claim claim re check failed" unless $value =~ $check;
411             }
412             elsif (ref $check eq 'CODE') {
413 9 100       13 croak "JWT: $claim claim code check failed" unless $check->($payload->{$claim});
414             }
415             elsif (!ref $check) {
416 9         11 my $value = $payload->{$claim};
417 9 100 66     377 croak "JWT: $claim claim scalar check failed" unless defined $value && $value eq $check;
418             }
419             else {
420 0         0 croak "JWT: verify_$claim must be Regexp, Scalar or CODE";
421             }
422             }
423             else {
424 3         375 croak "JWT: $claim claim required but missing"
425             }
426             }
427              
428             }
429              
430             sub _payload_zip {
431 4     4   11 my ($payload, $header, $z) = @_;
432 4 100       18 my @zip = ref $z eq 'ARRAY' ? @$z : ($z);
433 4 50       11 if ($zip[0] eq 'deflate') {
434 4 100       11 my $level = defined $zip[1] ? $zip[1] : 6;
435 4         13 $header->{zip} = "DEF";
436 4         18 my $d = Compress::Raw::Zlib::Deflate->new(-Bufsize => 1024, -WindowBits => -&MAX_WBITS(), -AppendOutput => 1, -Level => $level );
437 4         3038 my $output = '';
438 4 50       78 $d->deflate($payload, $output) == Z_OK or croak "JWT: deflate failed";
439 4 50       200 $d->flush($output) == Z_OK or croak "JWT: deflate/flush failed";
440 4 50       25 croak "JWT: deflate/output failed" unless $output;
441 4         284 $payload = $output;
442             }
443             else {
444 0         0 croak "JWT: unknown zip method '$zip[0]'";
445             }
446 4         22 return $payload;
447             }
448              
449             sub _payload_unzip {
450 16     16   36 my ($payload, $z) = @_;
451 16 50       44 if ($z eq "DEF") {
452 16         77 my $d = Compress::Raw::Zlib::Inflate->new(
453             -Bufsize => $MAX_INFLATED_SIZE,
454             -WindowBits => -&MAX_WBITS(),
455             -LimitOutput => 1,
456             );
457 16         7314 my $output = '';
458 16         491 my $status = $d->inflate($payload, $output);
459 16 50       88 croak "JWT: inflated payload exceeds limit ($MAX_INFLATED_SIZE bytes)" if $status == Z_BUF_ERROR;
460 16 50       249 croak "JWT: inflate failed (status=$status)" if $status != Z_STREAM_END;
461 16         187 $payload = $output;
462             }
463             else {
464 0         0 croak "JWT: unknown zip method '$z'";
465             }
466 16         44 return $payload;
467             }
468              
469             sub _payload_enc {
470 159     159   375 my ($payload) = @_;
471 159 100       665 if (ref($payload) =~ /^(HASH|ARRAY)$/) {
472 31         420 $payload = JSON->new->utf8->canonical->encode($payload);
473             }
474             else {
475 128 50       588 utf8::downgrade($payload, 1) or croak "JWT: payload cannot contain wide character";
476             }
477 159         454 return $payload;
478             }
479              
480             sub _payload_dec {
481 327     327   1115 my ($payload, $decode_payload) = @_;
482 327 100 100     1050 return $payload if defined $decode_payload && $decode_payload == 0;
483 244         391 my $de = $payload;
484 244         427 $de = eval { decode_json($de) };
  244         2745  
485 244 100       538 if ($decode_payload) {
486 14 50       39 croak "JWT: payload not a valid JSON" unless $de;
487 14         33 return $de;
488             }
489             else {
490 230 100       701 return defined $de ? $de : $payload;
491             }
492             }
493              
494             sub _encrypt_jwe_cek {
495 117     117   282 my ($key, $hdr) = @_;
496 117         302 my $alg = $hdr->{alg};
497 117         229 my $enc = $hdr->{enc};
498              
499 117 100       315 if ($alg eq 'dir') {
500 12         37 return (_prepare_oct_key($key), '');
501             }
502              
503 105         212 my $cek;
504             my $ecek;
505 105 100       646 if ($enc =~ /^A(128|192|256)GCM/) {
    50          
506 57         524 $cek = random_bytes($1/8);
507             }
508             elsif ($enc =~ /^A(128|192|256)CBC/) {
509 48         389 $cek = random_bytes(2*$1/8);
510             }
511              
512 105 100       3238 if ($alg =~ /^A(128|192|256)KW$/) {
    100          
    100          
    100          
    100          
    50          
513             # RFC 7518 sec 4.4 wraps via "AES Key Wrap algorithm specified in RFC 3394"
514 18         58 $ecek = aes_key_wrap(_prepare_oct_key($key), $cek, 'AES', 0);
515 18         112 return ($cek, $ecek);
516             }
517             elsif ($alg =~ /^A(128|192|256)GCMKW$/) {
518 18         32 my ($t, $i);
519 18         53 ($ecek, $t, $i) = gcm_key_wrap(_prepare_oct_key($key), $cek);
520 18         95 $hdr->{tag} = encode_b64u($t);
521 18         57 $hdr->{iv} = encode_b64u($i);
522 18         71 return ($cek, $ecek);
523             }
524             elsif ($alg =~ /^PBES2-HS(512|384|256)\+A(128|192|256)KW$/) {
525 26 50 33     320 my $len = looks_like_number($hdr->{p2s}) && $hdr->{p2s} >= 8 && $hdr->{p2s} <= 9999 ? $hdr->{p2s} : 16;
526 26         93 my $salt = random_bytes($len);
527 26 50       319 my $iter = looks_like_number($hdr->{p2c}) ? $hdr->{p2c} : 5000;
528 26         121 $ecek = pbes2_key_wrap(_prepare_oct_key($key), $cek, $alg, $salt, $iter);
529 26         215 $hdr->{p2s} = encode_b64u($salt);
530 26         81 $hdr->{p2c} = $iter;
531 26         186 return ($cek, $ecek);
532             }
533             elsif ($alg =~ /^RSA(-OAEP|-OAEP-256|1_5)$/) {
534 18         51 $key = _prepare_rsa_key($key);
535 18         73 $ecek = rsa_key_wrap($key, $cek, $alg);
536 18         73 return ($cek, $ecek);
537             }
538             elsif ($alg =~ /^ECDH-ES\+A(128|192|256)KW$/) {
539 19         81 $key = _prepare_ecdh_key($key);
540 19         157 ($ecek, $hdr->{epk}) = ecdhaes_key_wrap($key, $cek, $alg, $hdr->{apu}, $hdr->{apv});
541 19         4857 return ($cek, $ecek);
542             }
543             elsif ($alg eq 'ECDH-ES') {
544 6         28 $key = _prepare_ecdh_key($key);
545 6         53 ($cek, $hdr->{epk}) = ecdh_key_wrap($key, $enc, $hdr->{apu}, $hdr->{apv});
546 6         1418 return ($cek, '');
547             }
548 0         0 croak "JWE: unknown alg '$alg'";
549             }
550              
551             sub _decrypt_jwe_cek {
552 191     191   480 my ($ecek, $key, $hdr) = @_;
553 191         402 my $alg = $hdr->{alg};
554 191         392 my $enc = $hdr->{enc};
555              
556 191 100       1836 if ($alg eq 'dir') {
    100          
    100          
    100          
    100          
    100          
    50          
557 18         55 return _prepare_oct_key($key);
558             }
559             elsif ($alg =~ /^A(128|192|256)KW$/) {
560 26         89 return aes_key_unwrap(_prepare_oct_key($key), $ecek, 'AES', 0);
561             }
562             elsif ($alg =~ /^A(128|192|256)GCMKW$/) {
563 22         62 return gcm_key_unwrap(_prepare_oct_key($key), $ecek, decode_b64u($hdr->{tag}), decode_b64u($hdr->{iv}));
564             }
565             elsif ($alg =~ /^PBES2-HS(512|384|256)\+A(128|192|256)KW$/) {
566 49         118 my $p2c = $hdr->{p2c};
567 49 50 33     480 croak "JWE: invalid p2c" unless looks_like_number($p2c) && $p2c >= 1 && $p2c <= $MAX_PBES2_ITER;
      33        
568 49         184 return pbes2_key_unwrap(_prepare_oct_key($key), $ecek, $alg, decode_b64u($hdr->{p2s}), $p2c);
569             }
570             elsif ($alg =~ /^RSA(-OAEP|-OAEP-256|1_5)$/) {
571 41         111 $key = _prepare_rsa_key($key);
572 41         184 return rsa_key_unwrap($key, $ecek, $alg);
573             }
574             elsif ($alg =~ /^ECDH-ES\+A(128|192|256)KW$/) {
575 23         106 $key = _prepare_ecdh_key($key);
576 23         226 return ecdhaes_key_unwrap($key, $ecek, $alg, $hdr->{epk}, $hdr->{apu}, $hdr->{apv});
577             }
578             elsif ($alg eq 'ECDH-ES') {
579 12         62 $key = _prepare_ecdh_key($key);
580 12         107 return ecdh_key_unwrap($key, $enc, $hdr->{epk}, $hdr->{apu}, $hdr->{apv});
581             }
582 0         0 croak "JWE: unknown alg '$alg'";
583             }
584              
585             sub _encrypt_jwe_payload {
586 117     117   386 my ($cek, $enc, $b64u_header, $b64u_aad, $payload) = @_;
587 117 50       299 my $aad = defined $b64u_aad ? "$b64u_header.$b64u_aad" : $b64u_header;
588 117 100       914 if ($enc =~ /^A(128|192|256)GCM$/) {
    50          
589             # https://tools.ietf.org/html/rfc7518#section-5.3
590 63         284 my $len1 = $1/8;
591 63         144 my $len2 = length($cek);
592 63 50       200 croak "JWE: wrong AES key length ($len1 vs. $len2) for $enc" unless $len1 == $len2;
593 63         299 my $iv = random_bytes(12); # for AESGCM always 12 (96 bits)
594 63         1784 my ($ct, $tag) = gcm_encrypt_authenticate('AES', $cek, $iv, $aad, $payload);
595 63         331 return ($ct, $iv, $tag);
596             }
597             elsif ($enc =~ /^A(128|192|256)CBC-HS(256|384|512)$/) {
598             # https://tools.ietf.org/html/rfc7518#section-5.2
599 54         411 my ($size, $hash) = ($1/8, "SHA$2");
600 54         134 my $key_len = length($cek) / 2;
601 54         140 my $mac_key = substr($cek, 0, $key_len);
602 54         139 my $aes_key = substr($cek, $key_len, $key_len);
603 54 50       148 croak "JWE: wrong AES key length ($key_len vs. $size)" unless $key_len == $size;
604 54         237 my $iv = random_bytes(16); # for AES always 16
605 54         1436 my $m = Crypt::Mode::CBC->new('AES');
606 54         322 my $ct = $m->encrypt($payload, $aes_key, $iv);
607 54         1280 my $aad_len = length($aad);
608             # RFC 7518 5.2.2.1: AL = AAD length in bits as 64-bit big-endian.
609             # Split aad_len*8 into two 32-bit halves; both intermediate values
610             # stay within 32-bit range, so this is safe on 32-bit Perl too.
611 54         145 my $al_hi = $aad_len >> 29;
612 54         123 my $al_lo = ($aad_len & 0x1FFFFFFF) << 3;
613 54         224 my $mac_input = $aad . $iv . $ct . pack('N2', $al_hi, $al_lo);
614 54         792 my $mac = hmac($hash, $mac_key, $mac_input);
615 54         124 my $sig_len = length($mac) / 2;
616 54         119 my $sig = substr($mac, 0, $sig_len);
617 54         618 return ($ct, $iv, $sig);
618             }
619 0         0 croak "JWE: unsupported enc '$enc'";
620             }
621              
622             sub _decrypt_jwe_payload {
623 191     191   660 my ($cek, $enc, $aad, $ct, $iv, $tag) = @_;
624 191 100       1509 if ($enc =~ /^A(128|192|256)GCM$/) {
    50          
625             # https://tools.ietf.org/html/rfc7518#section-5.3
626 103         449 my $len1 = $1/8;
627 103         201 my $len2 = length($cek);
628 103 50       315 croak "JWE: wrong AES key length ($len1 vs. $len2) for $enc" unless $len1 == $len2;
629 103         1374 return gcm_decrypt_verify('AES', $cek, $iv, $aad, $ct, $tag);
630             }
631             elsif ($enc =~ /^A(128|192|256)CBC-HS(256|384|512)$/) {
632             # https://tools.ietf.org/html/rfc7518#section-5.2
633 88         567 my ($size, $hash) = ($1/8, "SHA$2");
634 88         225 my $key_len = length($cek) / 2;
635 88         217 my $mac_key = substr($cek, 0, $key_len);
636 88         194 my $aes_key = substr($cek, $key_len, $key_len);
637 88 50       241 croak "JWE: wrong AES key length ($key_len vs. $size)" unless $key_len == $size;
638 88         143 my $aad_len = length($aad); # AAD == original encoded header
639             # RFC 7518 5.2.2.1: AL = AAD length in bits as 64-bit big-endian.
640             # Split aad_len*8 into two 32-bit halves; both intermediate values
641             # stay within 32-bit range, so this is safe on 32-bit Perl too.
642 88         174 my $al_hi = $aad_len >> 29;
643 88         165 my $al_lo = ($aad_len & 0x1FFFFFFF) << 3;
644 88         309 my $mac_input = $aad . $iv . $ct . pack('N2', $al_hi, $al_lo);
645 88         1196 my $mac = hmac($hash, $mac_key, $mac_input);
646 88         206 my $sig_len = length($mac) / 2;
647 88         177 my $sig = substr($mac, 0, $sig_len);
648 88 50       393 croak "JWE: tag mismatch" unless slow_eq($sig, $tag);
649 88         735 my $m = Crypt::Mode::CBC->new('AES');
650 88         470 my $pt = $m->decrypt($ct, $aes_key, $iv);
651 88         2666 return $pt;
652             }
653 0         0 croak "JWE: unsupported enc '$enc'";
654             }
655              
656             sub _encode_jwe {
657 117     117   465 my %args = @_;
658 117         260 my $payload = $args{payload};
659 117         229 my $alg = $args{alg};
660 117         218 my $enc = $args{enc};
661 117 100       340 my $header = $args{extra_headers} ? \%{$args{extra_headers}} : {};
  3         10  
662 117 50       394 croak "JWE: missing 'enc'" if !defined $enc;
663 117 50       375 croak "JWE: missing 'payload'" if !defined $payload;
664             # add claims to payload
665 117 100       406 _add_claims($payload, %args) if ref $payload eq 'HASH';
666             # serialize payload
667 117         382 $payload = _payload_enc($payload);
668             # compress payload
669 117 100       370 $payload = _payload_zip($payload, $header, $args{zip}) if $args{zip}; # may set some header items
670             # prepare header
671 117         350 $header->{alg} = $alg;
672 117         252 $header->{enc} = $enc;
673             # key
674 117 50       353 croak "JWE: missing 'key'" if !$args{key};
675 117 50       350 my $key = defined $args{keypass} ? [$args{key}, $args{keypass}] : $args{key};
676             # prepare cek
677 117         417 my ($cek, $ecek) = _encrypt_jwe_cek($key, $header); # adds some header items
678             # encode header
679 117         893 my $json_header = encode_json($header);
680 117         469 my $b64u_header = encode_b64u($json_header);
681 117 50       432 my $b64u_aad = defined $args{aad} ? encode_b64u($args{aad}) : undef;
682             # encrypt payload
683 117         382 my ($ct, $iv, $tag) = _encrypt_jwe_payload($cek, $enc, $b64u_header, $b64u_aad, $payload);
684             # return token parts
685 117         1649 return ( $b64u_header,
686             encode_b64u($ecek),
687             encode_b64u($iv),
688             encode_b64u($ct),
689             encode_b64u($tag),
690             $b64u_aad);
691             }
692              
693             sub _decode_jwe {
694 197     197   1703 my ($b64u_header, $b64u_ecek, $b64u_iv, $b64u_ct, $b64u_tag, $b64u_aad, $unprotected, $shared_unprotected, %args) = @_;
695 197         691 my $header = _b64u_to_hash($b64u_header);
696 197         694 my $ecek = decode_b64u($b64u_ecek);
697 197         560 my $ct = decode_b64u($b64u_ct);
698 197         583 my $iv = decode_b64u($b64u_iv);
699 197         487 my $tag = decode_b64u($b64u_tag);
700 197 50 33     938 croak "JWE: invalid header part" if $b64u_header && !$header;
701 197 50 66     707 croak "JWE: invalid ecek part" if $b64u_ecek && !$ecek;
702 197 50 33     656 croak "JWE: invalid ct part" if $b64u_ct && !$ct;
703 197 50 33     659 croak "JWE: invalid iv part" if $b64u_iv && !$iv;
704 197 50 33     754 croak "JWE: invalid tag part" if $b64u_tag && !$tag;
705              
706 197         297 my $key;
707 197 100       473 if (exists $args{key}) {
    50          
708 195 50       570 $key = defined $args{keypass} ? [$args{key}, $args{keypass}] : $args{key};
709             }
710             elsif (exists $args{kid_keys}) {
711             # BEWARE: stricter approach since 0.023
712             # when 'kid_keys' specified it croaks if header doesn't contain 'kid' value or if 'kid' wasn't found in 'kid_keys'
713 2         8 my $k = _kid_lookup($header->{kid}, $args{kid_keys}, $header->{alg});
714 2 50       7 croak "JWE: kid_keys lookup failed" if !defined $k;
715 2         7 $key = $k;
716             }
717 197 50       504 croak "JWE: missing key" if !defined $key;
718              
719 197         1002 _check_accepted('alg', $header->{alg}, $args{accepted_alg});
720 194         751 _check_accepted('enc', $header->{enc}, $args{accepted_enc});
721             # For 'dir' the JWK is used directly as the CEK, so its 'alg' field (when
722             # present) names the content-encryption algorithm (the JWE 'enc'), not
723             # 'dir' itself. RFC 7518 sec 3.4.2 / common JWK convention.
724 191 100 100     991 my $effective_alg = defined $header->{alg} && $header->{alg} eq 'dir' ? $header->{enc} : $header->{alg};
725 191         635 _check_jwk_constraints($key, $effective_alg, 'JWE');
726              
727             # SECURITY INVARIANT: merge order matters. The protected header (%$header)
728             # MUST come last so its values win over the unprotected/shared-unprotected
729             # ones (which travel outside the AEAD and are attacker-mutable). Crypto-
730             # critical fields - 'alg', 'enc', 'epk', 'p2c', 'p2s', 'iv', 'tag', 'zip',
731             # 'apu', 'apv' - are read from this merged hash by _decrypt_jwe_cek and
732             # below; flipping the order, or letting _decrypt_jwe_cek run against an
733             # attacker-controlled header, breaks the JWE security model.
734 191         1251 $header = { %$shared_unprotected, %$unprotected, %$header };
735 191         700 my $cek = _decrypt_jwe_cek($ecek, $key, $header);
736 191 50       666 my $aad = defined $b64u_aad ? "$b64u_header.$b64u_aad" : $b64u_header;
737 191         851 my $payload = _decrypt_jwe_payload($cek, $header->{enc}, $aad, $ct, $iv, $tag);
738 191 100       665 $payload = _payload_unzip($payload, $header->{zip}) if $header->{zip};
739 191         851 $payload = _payload_dec($payload, $args{decode_payload});
740 191         1079 _verify_claims($payload, %args); # croaks on error
741 191         737 _verify_header($header, %args); # croaks on error
742 185         1223 return ($header, $payload);
743             }
744              
745             sub _sign_jws {
746 42     42   99 my ($b64u_header, $b64u_payload, $alg, $key) = @_;
747 42 100       87 return '' if $alg eq 'none'; # no integrity
748 40         44 my $sig;
749 40         88 my $data = "$b64u_header.$b64u_payload";
750 40 100       227 if ($alg =~ /^HS(256|384|512)$/) { # HMAC integrity
    100          
    100          
    100          
    50          
751 26         75 $key = _prepare_oct_key($key);
752 26 50       57 croak "JWS: HMAC key shorter than minimum ($MIN_HMAC_KEY_LEN bytes)" if length($key) < $MIN_HMAC_KEY_LEN;
753 26         313 $sig = hmac("SHA$1", $key, $data);
754             }
755             elsif ($alg =~ /^RS(256|384|512)/) { # RSA+PKCS1-V1_5 signatures
756 5         18 my $pk = _prepare_rsa_key($key);
757 5         45685 $sig = $pk->sign_message($data, "SHA$1", 'v1.5');
758             }
759             elsif ($alg =~ /^PS(256|384|512)/) { # RSA+PSS signatures
760 3         15 my $hash = "SHA$1";
761 3         13 my $hashlen = $1/8;
762 3         13 my $pk = _prepare_rsa_key($key);
763 3         28536 $sig = $pk->sign_message($data, $hash, 'pss', $hashlen);
764             }
765             elsif ($alg =~ /^ES(256|256K|384|512)$/) { # ECDSA signatures
766 4         24 my $hash = {ES256 => 'SHA256', ES256K => 'SHA256', ES384 => 'SHA384', ES512 => 'SHA512'}->{$alg};
767 4         20 my $pk = _prepare_ecc_key($key);
768 4         40142 $sig = $pk->sign_message_rfc7518($data, $hash);
769             }
770             elsif ($alg eq 'EdDSA') { # Ed25519 signatures
771 2         10 my $pk = _prepare_ed25519_key($key);
772 2         14176 $sig = $pk->sign_message($data);
773             }
774 40         263 return encode_b64u($sig);
775             }
776              
777             sub _verify_jws {
778 135     135   399 my ($b64u_header, $b64u_payload, $b64u_sig, $alg, $key) = @_;
779 135         453 my $sig = decode_b64u($b64u_sig);
780 135 50 33     565 croak "JWS: invalid sig part" if $b64u_sig && !$sig;
781 135         296 my $data = "$b64u_header.$b64u_payload";
782              
783 135 50       869 if ($alg eq 'none' ) { # no integrity
    100          
    100          
    100          
    100          
    50          
784 0         0 return 1;
785             }
786             elsif ($alg =~ /^HS(256|384|512)$/) { # HMAC integrity
787 85         171 $key = _prepare_oct_key($key);
788 85 50       171 croak "JWS: HMAC key shorter than minimum ($MIN_HMAC_KEY_LEN bytes)" if length($key) < $MIN_HMAC_KEY_LEN;
789 85 50       1456 return 1 if slow_eq($sig, hmac("SHA$1", $key, $data));
790             }
791             elsif ($alg =~ /^RS(256|384|512)/) { # RSA+PKCS1-V1_5 signatures
792 24         87 my $hash = "SHA$1";
793 24         73 my $pk = _prepare_rsa_key($key);
794 23 50       8812 return 1 if $pk->verify_message($sig, $data, $hash, 'v1.5');
795             }
796             elsif ($alg =~ /^PS(256|384|512)/) { # RSA+PSS signatures
797 7         27 my $hash = "SHA$1";
798 7         52 my $hashlen = $1/8;
799 7         25 my $pk = _prepare_rsa_key($key);
800 7 50       3901 return 1 if $pk->verify_message($sig, $data, $hash, 'pss', $hashlen);
801             }
802             elsif ($alg =~ /^ES(256|256K|384|512)$/) { # ECDSA signatures
803 17         105 my $hash = {ES256 => 'SHA256', ES256K => 'SHA256', ES384 => 'SHA384', ES512 => 'SHA512'}->{$alg};
804 17         79 my $pk = _prepare_ecc_key($key);
805 16 100       187282 return 1 if $pk->verify_message_rfc7518($sig, $data, $hash);
806             }
807             elsif ($alg eq 'EdDSA') { # Ed25519 signatures
808 2         10 my $pk = _prepare_ed25519_key($key);
809 2 50       15146 return 1 if $pk->verify_message($sig, $data);
810             }
811 2         10 return 0;
812             }
813              
814             sub _encode_jws {
815 43     43   128 my %args = @_;
816 43         78 my $payload = $args{payload};
817 43         70 my $alg = $args{alg};
818 43 100       113 my $header = $args{extra_headers} ? \%{$args{extra_headers}} : {};
  3         7  
819 43 50       143 croak "JWS: missing 'payload'" if !defined $payload;
820 43 100 100     254 croak "JWS: alg 'none' not allowed" if $alg eq 'none' && !$args{allow_none};
821             # add claims to payload
822 42 100       146 _add_claims($payload, %args) if ref $payload eq 'HASH';
823             # serialize payload
824 42         119 $payload = _payload_enc($payload);
825             # compress payload
826 42 100       109 $payload = _payload_zip($payload, $header, $args{zip}) if $args{zip}; # may set some header items
827             # encode payload
828 42         158 my $b64u_payload = encode_b64u($payload);
829             # prepare header
830 42         104 $header->{alg} = $alg;
831             # encode header
832 42         177 my $json_header = encode_json($header);
833 42         95 my $b64u_header = encode_b64u($json_header);
834             # key
835 42 50 66     192 croak "JWS: missing 'key'" if !$args{key} && $alg ne 'none';
836 42 50       110 my $key = defined $args{keypass} ? [$args{key}, $args{keypass}] : $args{key};
837             # sign header
838 42         109 my $b64u_signature = _sign_jws($b64u_header, $b64u_payload, $alg, $key);
839 42         256 return ($b64u_header, $b64u_payload, $b64u_signature);
840             }
841              
842             sub _decode_jws {
843 144     144   936 my ($b64u_header, $b64u_payload, $b64u_sig, $unprotected_header, %args) = @_;
844 144         405 my $header = _b64u_to_hash($b64u_header);
845 144 50 33     1817 croak "JWS: invalid header part" if $b64u_header && !$header;
846 144 100       352 $unprotected_header = {} if ref $unprotected_header ne 'HASH';
847              
848 144 100       343 if (!$args{ignore_signature}) {
849 143         283 my $alg = $header->{alg};
850 143 50       268 croak "JWS: missing header 'alg'" unless $alg;
851 143 100 100     573 croak "JWS: alg 'none' not allowed" if $alg eq 'none' && !$args{allow_none};
852 142 50 66     354 croak "JWS: alg 'none' expects no signature" if $alg eq 'none' && defined $b64u_sig && length($b64u_sig) > 0;
      66        
853              
854 142         1286 _check_accepted('alg', $alg, $args{accepted_alg});
855              
856 139 100       351 if ($alg ne 'none') {
857 135         198 my $key;
858 135 100       287 if (exists $args{key}) {
    100          
    50          
859 132 50       283 $key = defined $args{keypass} ? [$args{key}, $args{keypass}] : $args{key};
860             }
861             elsif (exists $args{kid_keys}) {
862             # BEWARE: stricter approach since 0.023
863             # when 'kid_keys' specified it croaks if header doesn't contain 'kid' value or if 'kid' wasn't found in 'kid_keys'
864 2 50       5 my $kid = exists $header->{kid} ? $header->{kid} : $unprotected_header->{kid};
865 2         5 my $k = _kid_lookup($kid, $args{kid_keys}, $alg);
866 2 50       5 croak "JWS: kid_keys lookup failed" if !defined $k;
867 2         3 $key = $k;
868             }
869             elsif ($args{key_from_jwk_header}) {
870             # BEWARE: stricter approach since 0.023
871             # - header 'jwk' is by default ignored (unless given: key_from_jwk_header => 1)
872             # - only RSA/ECDSA public keys are accepted
873 1         2 my $k = $header->{jwk};
874 1 50 33     8 croak "JWS: jwk header does not contain a key" if !defined $k || ref($k) ne 'HASH' || !defined $k->{kty};
      33        
875 1 50 33     20 croak "JWS: jwk header allowed only for RSA/ECDSA" if $alg !~ /^(RS|PS|ES)/ || $k->{kty} !~ /^(RSA|EC)$/;
876 1 50 33     56 croak "JWS: jwk header must be a public key" if $k->{d} || $k->{p} || $k->{q} || $k->{dp} || $k->{dq} || $k->{qi};
      33        
      33        
      33        
      33        
877 1         23 $key = $k;
878             }
879 135 50       274 croak "JWS: missing key" if !defined $key;
880 135         346 _check_jwk_constraints($key, $alg, 'JWS');
881              
882 135         317 my $valid = _verify_jws($b64u_header, $b64u_payload, $b64u_sig, $alg, $key);
883 133 100       809 croak "JWS: invalid signature" if !$valid;
884             }
885             }
886 136         444 my $payload = decode_b64u($b64u_payload);
887 136 50 66     464 croak "JWS: invalid payload part" if $b64u_payload && !$payload;
888 136 100       331 $payload = _payload_unzip($payload, $header->{zip}) if $header->{zip};
889 136         470 $payload = _payload_dec($payload, $args{decode_payload});
890 136         630 _verify_claims($payload, %args); # croaks on error
891 99         505 $header = { %$unprotected_header, %$header }; # merge headers
892 99         374 _verify_header($header, %args); # croaks on error
893 93         404 return ($header, $payload);
894             }
895              
896             sub encode_jwt {
897 160     160 1 894832 my %args = @_;
898              
899 160 50       777 croak "JWT: missing 'alg'" unless $args{alg};
900 160   50     793 my $ser = $args{serialization} || 'compact';
901 160 100       1766 if ($args{alg} =~ /^(none|EdDSA|(HS|RS|PS)(256|384|512)|ES(256|256K|384|512))$/) {
    50          
902             ###JWS
903 43         161 my ($b64u_header, $b64u_payload, $b64u_signature) = _encode_jws(%args);
904 42 50       137 if ($ser eq 'compact') { # https://tools.ietf.org/html/rfc7515#section-7.1
    0          
905 42 50       109 croak "JWT: cannot use 'unprotected_headers' with compact serialization" if defined $args{unprotected_headers};
906 42         214 return "$b64u_header.$b64u_payload.$b64u_signature";
907             }
908             elsif ($ser eq 'flattened') { # https://tools.ietf.org/html/rfc7515#section-7.2.2
909 0         0 my $token = { protected => $b64u_header, payload => $b64u_payload, signature => $b64u_signature };
910 0 0       0 $token->{header} = \%{$args{unprotected_headers}} if ref $args{unprotected_headers} eq 'HASH';
  0         0  
911 0         0 return encode_json($token);
912             }
913             else {
914 0         0 croak "JWT: unsupported JWS serialization '$ser'";
915             }
916             }
917             elsif ($args{alg} =~ /^(dir|A(128|192|256)KW|A(128|192|256)GCMKW|PBES2-(HS256\+A128KW|HS384\+A192KW|HS512\+A256KW)|RSA-OAEP|RSA-OAEP-256|RSA1_5|ECDH-ES\+A(128|192|256)KW|ECDH-ES)$/) {
918             ### JWE
919 117         540 my ($b64u_header, $b64u_ecek, $b64u_iv, $b64u_ct, $b64u_tag, $b64u_aad) = _encode_jwe(%args);
920 117 50       584 if ($ser eq 'compact') { # https://tools.ietf.org/html/rfc7516#section-7.1
    0          
921 117 50       414 croak "JWT: cannot use 'aad' with compact serialization" if defined $args{aad};
922 117 50       358 croak "JWT: cannot use 'unprotected_headers' with compact serialization" if defined $args{unprotected_headers};
923 117 50       299 croak "JWT: cannot use 'shared_unprotected_headers' with compact serialization" if defined $args{shared_unprotected_headers};
924 117         808 return "$b64u_header.$b64u_ecek.$b64u_iv.$b64u_ct.$b64u_tag";
925             }
926             elsif ($ser eq 'flattened') { # https://tools.ietf.org/html/rfc7516#section-7.2.2
927 0         0 my $token = {
928             protected => $b64u_header,
929             encrypted_key => $b64u_ecek,
930             iv => $b64u_iv,
931             ciphertext => $b64u_ct,
932             tag => $b64u_tag,
933             };
934             # header: JWE Per-Recipient Unprotected Header when the JWE Per-Recipient Unprotected Header
935 0 0       0 $token->{header} = \%{$args{unprotected_headers}} if ref $args{unprotected_headers} eq 'HASH';
  0         0  
936             # unprotected: JWE Shared Unprotected Header
937 0 0       0 $token->{unprotected} = \%{$args{shared_unprotected_headers}} if ref $args{shared_unprotected_headers} eq 'HASH';
  0         0  
938             # aad: Additional Authenticated Data (AAD)
939 0 0       0 $token->{aad} = $b64u_aad if defined $b64u_aad;
940 0         0 return encode_json($token);
941             }
942             else {
943 0         0 croak "JWT: unsupported JWE serialization '$ser'";
944             }
945             }
946             else {
947 0         0 croak "JWT: unexpected alg '$args{alg}'";
948             }
949             }
950              
951             sub decode_jwt {
952 341     341 1 2341320 my %args = @_;
953 341         726 my ($header, $payload);
954              
955 341 50       1209 if (!$args{token}) {
956 0         0 croak "JWT: missing token";
957             }
958 341 100       1019 my $token_re = $args{tolerate_padding} ? $TOKEN_RE_PADDING : $TOKEN_RE_STRICT;
959 341 100       4846 if ($args{token} =~ $token_re) {
    50          
960 335 100 66     2092 if (defined($5) && length($5) > 0) {
961             # JWE token (5 segments)
962 195         1115 ($header, $payload) = _decode_jwe($1, $2, $3, $4, $5, undef, {}, {}, %args);
963             }
964             else {
965             # JWS token (3 segments)
966 140         1427 ($header, $payload) = _decode_jws($1, $2, $3, {}, %args);
967             }
968             }
969             elsif ($args{token} =~ /^\s*\{.*?\}\s*$/s) {
970 6         93 my $hash = decode_json($args{token});
971 6 100 66     56 if (defined $hash->{payload} && $hash->{protected}) {
    50 33        
972             # Flattened JWS JSON Serialization
973 4         29 ($header, $payload) = _decode_jws($hash->{protected}, $hash->{payload}, $hash->{signature}, $hash->{header}, %args);
974             }
975             elsif ($hash->{ciphertext} && $hash->{protected}) {
976             # Flattened JWE JSON Serialization
977 2         18 ($header, $payload) = _decode_jwe($hash->{protected}, $hash->{encrypted_key}, $hash->{iv}, $hash->{ciphertext}, $hash->{tag}, $hash->{aad}, $hash->{header}, $hash->{unprotected}, %args);
978             }
979             else {
980 0         0 croak "JWT: unsupported JWS/JWT JSON Serialization";
981             }
982             }
983             else {
984 0         0 croak "JWT: invalid token format";
985             }
986 278 100       1429 return ($header, $payload) if $args{decode_header};
987 245         1472 return $payload;
988             }
989              
990             1;
991              
992             #### URLs
993             # https://metacpan.org/pod/JSON::WebToken
994             # https://metacpan.org/pod/Mojo::JWT
995             # https://bitbucket.org/b_c/jose4j/wiki/JWE%20Examples
996             # https://bitbucket.org/b_c/jose4j/wiki/JWS%20Examples
997             # https://github.com/dvsekhvalnov/jose-jwt/tree/master/JWT/jwe
998             # https://github.com/progrium/ruby-jwt
999             # https://github.com/jpadilla/pyjwt/
1000              
1001             =pod
1002              
1003             =head1 NAME
1004              
1005             Crypt::JWT - JSON Web Token (JWT, JWS, JWE) as defined by RFC7519, RFC7515, RFC7516
1006              
1007             =head1 SYNOPSIS
1008              
1009             # encoding
1010             use Crypt::JWT qw(encode_jwt);
1011             my $jws_token = encode_jwt(payload=>$data, alg=>'HS256', key=>'secret');
1012             my $jwe_token = encode_jwt(payload=>$data, alg=>'PBES2-HS256+A128KW', enc=>'A128GCM', key=>'secret');
1013              
1014             # decoding
1015             use Crypt::JWT qw(decode_jwt);
1016             my $data1 = decode_jwt(token=>$jws_token, key=>'secret');
1017             my $data2 = decode_jwt(token=>$jwe_token, key=>'secret');
1018              
1019             =head1 DESCRIPTION
1020              
1021             Implements B - L.
1022             The implementation covers not only B - L,
1023             but also B - L.
1024              
1025             The module implements all algorithms defined in L - B.
1026              
1027             This module supports B and B serialization. General (multi-recipient) JSON serialization is not supported.
1028              
1029             =head1 EXPORT
1030              
1031             Nothing is exported by default.
1032              
1033             You can export selected functions:
1034              
1035             use Crypt::JWT qw(decode_jwt encode_jwt);
1036              
1037             Or all of them at once:
1038              
1039             use Crypt::JWT ':all';
1040              
1041             =head1 FUNCTIONS
1042              
1043             =head2 decode_jwt
1044              
1045             my $data = decode_jwt(%named_args);
1046             my ($header, $data) = decode_jwt(%named_args, decode_header=>1);
1047              
1048             Returns the decoded payload (in scalar context) or the decoded header
1049             followed by the decoded payload (when C 1>). Croaks
1050             on any verification, decryption, or claim-check failure.
1051              
1052             Named arguments:
1053              
1054             =over
1055              
1056             =item token
1057              
1058             Mandatory. The serialized JWS or JWE token as a string. Both compact
1059             (C<.>-separated, 3 segments for JWS / 5 for JWE) and flattened JSON
1060             serialization are accepted.
1061              
1062             ### JWS compact (3 segments)
1063             $t = "eyJhbGciOiJIUzI1NiJ9.dGVzdA.ujBihtLSr66CEWqN74SpLUkv28lra_CeHnxLmLNp4Jo";
1064             my $data = decode_jwt(token=>$t, key=>$k);
1065              
1066             ### JWE compact (5 segments)
1067             $t = "eyJlbmMiOiJBMTI4R0NNIiwiYWxnIjoiQTEyOEtXIn0.UusxEbzhGkORxTRq0xkFKhvzPrXb9smw.VGfOuq0Fxt6TsdqLZUpnxw.JajIQQ.pkKZ7MHS0XjyGmRsqgom6w";
1068             my $data = decode_jwt(token=>$t, key=>$k);
1069              
1070             =item key
1071              
1072             A key used for token decryption (JWE) or token signature validation (JWS).
1073             The value depends on the C token header value.
1074              
1075             B B how the C argument is shaped matters.
1076              
1077             =over
1078              
1079             =item *
1080              
1081             A bare scalar (e.g. C<'secret'>) is always interpreted as a raw octet
1082             string (HMAC secret, AES key, etc.).
1083              
1084             =item *
1085              
1086             PEM, DER, and JWK-JSON key material B be passed as a SCALAR ref
1087             (C<\$pem>) or as an appropriate key object - never as a bare string.
1088              
1089             =item *
1090              
1091             If a public-key string is mistakenly passed as a bare scalar and
1092             C is not set, an attacker who flips the token's C to
1093             C can forge a signature using the public-key bytes as the HMAC
1094             secret (the so-called "alg confusion" attack).
1095              
1096             =item *
1097              
1098             For defense in depth, B pin the algorithm with C.
1099              
1100             =back
1101              
1102             Overview of supported keys:
1103              
1104             JWS alg header key value
1105             ------------------ ----------------------------------
1106             none no key required
1107             HS256 string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1108             HS384 same as HS256
1109             HS512 same as HS256
1110             RS256 public RSA key, perl HASH ref with JWK key structure,
1111             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1112             object: Crypt::PK::RSA, Crypt::OpenSSL::RSA, Crypt::X509 or Crypt::OpenSSL::X509
1113             RS384 public RSA key, see RS256
1114             RS512 public RSA key, see RS256
1115             PS256 public RSA key, see RS256
1116             PS384 public RSA key, see RS256
1117             PS512 public RSA key, see RS256
1118             ES256 public ECC key, perl HASH ref with JWK key structure,
1119             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1120             an instance of Crypt::PK::ECC
1121             ES256K public ECC key, see ES256
1122             ES384 public ECC key, see ES256
1123             ES512 public ECC key, see ES256
1124             EdDSA public Ed25519 key
1125              
1126             JWE alg header key value
1127             ------------------ ----------------------------------
1128             dir string (raw octets) or perl HASH ref with JWK, kty=>'oct', length depends on 'enc' algorithm
1129             A128KW string (raw octets) 16 bytes (or perl HASH ref with JWK, kty=>'oct')
1130             A192KW string (raw octets) 24 bytes (or perl HASH ref with JWK, kty=>'oct')
1131             A256KW string (raw octets) 32 bytes (or perl HASH ref with JWK, kty=>'oct')
1132             A128GCMKW string (raw octets) 16 bytes (or perl HASH ref with JWK, kty=>'oct')
1133             A192GCMKW string (raw octets) 24 bytes (or perl HASH ref with JWK, kty=>'oct')
1134             A256GCMKW string (raw octets) 32 bytes (or perl HASH ref with JWK, kty=>'oct')
1135             PBES2-HS256+A128KW string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1136             PBES2-HS384+A192KW string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1137             PBES2-HS512+A256KW string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1138             RSA-OAEP private RSA key, perl HASH ref with JWK key structure,
1139             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1140             an instance of Crypt::PK::RSA or Crypt::OpenSSL::RSA
1141             RSA-OAEP-256 private RSA key, see RSA-OAEP
1142             RSA1_5 private RSA key, see RSA-OAEP
1143             ECDH-ES private ECC or X25519 key, perl HASH ref with JWK key structure,
1144             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1145             an instance of Crypt::PK::ECC
1146             ECDH-ES+A128KW private ECC or X25519 key, see ECDH-ES
1147             ECDH-ES+A192KW private ECC or X25519 key, see ECDH-ES
1148             ECDH-ES+A256KW private ECC or X25519 key, see ECDH-ES
1149              
1150             Example using the key from C token header:
1151              
1152             my $data = decode_jwt(token=>$t, key_from_jwk_header=>1);
1153             my ($header, $data) = decode_jwt(token=>$t, decode_header=>1, key_from_jwk_header=>1);
1154              
1155             Examples with raw octet keys:
1156              
1157             #string
1158             my $data = decode_jwt(token=>$t, key=>'secretkey');
1159             #binary key
1160             my $data = decode_jwt(token=>$t, key=>pack("H*", "788A6E38F36B7596EF6A669E94"));
1161             #perl HASH ref with JWK structure (key type 'oct')
1162             my $data = decode_jwt(token=>$t, key=>{kty=>'oct', k=>"GawgguFyGrWKav7AX4VKUg"});
1163              
1164             Examples with RSA keys:
1165              
1166             my $pem_key_string = <<'EOF';
1167             -----BEGIN PRIVATE KEY-----
1168             MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQCoVm/Sl5r+Ofky
1169             jioRSZK26GW6WyjyfWKddsSi13/NOtCn0rRErSF/u3QrgGMpWFqKohqbi1VVC+SZ
1170             ...
1171             8c1vm2YFafgdkSk9Qd1oU2Fv1aOQy4VovOFzJ3CcR+2r7cbRfcpLGnintHtp9yek
1172             02p+d5g4OChfFNDhDtnIqjvY
1173             -----END PRIVATE KEY-----
1174             EOF
1175              
1176             my $jwk_key_json_string = '{"kty":"RSA","n":"0vx7agoebG...L6tSoc_BJECP","e":"AQAB"}';
1177              
1178             #a reference to SCALAR string with PEM or DER or JSON/JWK data,
1179             my $data = decode_jwt(token=>$t, key=>\$pem_key_string);
1180             my $data = decode_jwt(token=>$t, key=>\$der_key_string);
1181             my $data = decode_jwt(token=>$t, key=>\$jwk_key_json_string);
1182              
1183             #instance of Crypt::PK::RSA
1184             my $data = decode_jwt(token=>$t, key=>Crypt::PK::RSA->new('keyfile.pem'));
1185             my $data = decode_jwt(token=>$t, key=>Crypt::PK::RSA->new(\$pem_key_string));
1186              
1187             #instance of Crypt::OpenSSL::RSA
1188             my $data = decode_jwt(token=>$t, key=>Crypt::OpenSSL::RSA->new_private_key($pem_key_string));
1189              
1190             #instance of Crypt::X509 (public key only)
1191             my $data = decode_jwt(token=>$t, key=>Crypt::X509->new(cert=>$cert));
1192              
1193             #instance of Crypt::OpenSSL::X509 (public key only)
1194             my $data = decode_jwt(token=>$t, key=>Crypt::OpenSSL::X509->new_from_file('cert.pem'));
1195             my $data = decode_jwt(token=>$t, key=>Crypt::OpenSSL::X509->new_from_string($cert));
1196              
1197             #perl HASH ref with JWK structure (key type 'RSA')
1198             my $rsa_priv = {
1199             kty => "RSA",
1200             n => "0vx7agoebGcQSuuPiLJXZpt...eZu0fM4lFd2NcRwr3XPksINHaQ-G_xBniIqbw0Ls1jF44-csFCur-kEgU8awapJzKnqDKgw",
1201             e => "AQAB",
1202             d => "X4cTteJY_gn4FYPsXB8rdXi...FLN5EEaG6RoVH-HLKD9Mdx5ooGURknhnrRwUkC7h5fJLMWbFAKLWY2v7B6NqSzUvx0_YSf",
1203             p => "83i-7IvMGXoMXCskv73TKr8...Z27zvoj6pbUQyLPBQxtPnwD20-60eTmD2ujMt5PoMrm8RmNhVWtjjMmMjOpSicFHjXOuVI",
1204             q => "3dfOR9cuYq-0S-mkFLzgItg...q3hWeMuG0ouqnb3obLyuqjVZQ1dIrdgTnCdYzBcOW5r37AFXjift_NGiovonzhKpoVVS78",
1205             dp => "G4sPXkc6Ya9y8oJW9_ILj4...zi_H7TkS8x5SdX3oE0oiYwxIiemTAu0UOa5pgFGyJ4c8t2VF40XRugKTP8akhFo5tA77Qe",
1206             dq => "s9lAH9fggBsoFR8Oac2R_E...T2kGOhvIllTE1efA6huUvMfBcpn8lqW6vzzYY5SSF7pMd_agI3G8IbpBUb0JiraRNUfLhc",
1207             qi => "GyM_p6JrXySiz1toFgKbWV...4ypu9bMWx3QJBfm0FoYzUIZEVEcOqwmRN81oDAaaBk0KWGDjJHDdDmFW3AN7I-pux_mHZG",
1208             };
1209             my $data = decode_jwt(token=>$t, key=>$rsa_priv);
1210              
1211             Examples with ECC keys:
1212              
1213             my $pem_key_string = <<'EOF';
1214             -----BEGIN EC PRIVATE KEY-----
1215             MHcCAQEEIBG1c3z52T8XwMsahGVdOZWgKCQJfv+l7djuJjgetdbDoAoGCCqGSM49
1216             AwEHoUQDQgAEoBUyo8CQAFPeYPvv78ylh5MwFZjTCLQeb042TjiMJxG+9DLFmRSM
1217             lBQ9T/RsLLc+PmpB1+7yPAR+oR5gZn3kJQ==
1218             -----END EC PRIVATE KEY-----
1219             EOF
1220              
1221             my $jwk_key_json_string = '{"kty":"EC","crv":"P-256","x":"MKB..7D4","y":"4Et..FyM"}';
1222              
1223             #a reference to SCALAR string with PEM or DER or JSON/JWK data,
1224             my $data = decode_jwt(token=>$t, key=>\$pem_key_string);
1225             my $data = decode_jwt(token=>$t, key=>\$der_key_string);
1226             my $data = decode_jwt(token=>$t, key=>\$jwk_key_json_string);
1227              
1228             #instance of Crypt::PK::ECC
1229             my $data = decode_jwt(token=>$t, key=>Crypt::PK::ECC->new('keyfile.pem'));
1230             my $data = decode_jwt(token=>$t, key=>Crypt::PK::ECC->new(\$pem_key_string));
1231              
1232             #perl HASH ref with JWK structure (key type 'EC')
1233             my $ecc_priv = {
1234             kty => "EC",
1235             crv => "P-256",
1236             x => "MKBCTNIcKUSDii11ySs3526iDZ8AiTo7Tu6KPAqv7D4",
1237             y => "4Etl6SRW2YiLUrN5vfvVHuhp7x8PxltmWWlbbM4IFyM",
1238             d => "870MB6gfuTJ4HtUnUvYMyJpr5eUZNP4Bk43bVdj3eAE",
1239             };
1240             my $data = decode_jwt(token=>$t, key=>$ecc_priv);
1241              
1242             =item keypass
1243              
1244             Optional. When the C parameter is an encrypted private RSA or ECC
1245             key (PEM/DER), this parameter holds the password used to decrypt it.
1246              
1247             =item kid_keys
1248              
1249             This parameter can be either a JWK Set JSON string (see RFC7517) or a perl HASH ref with JWK Set structure like this:
1250              
1251             my $keylist = {
1252             keys => [
1253             { kid=>"key1", kty=>"oct", k=>"GawgguFyGrWKav7AX4VKUg" },
1254             { kid=>"key2", kty=>"oct", k=>"ulxLGy4XqhbpkR5ObGh1gX" },
1255             ]
1256             };
1257             my $payload = decode_jwt(token=>$t, kid_keys=>$keylist);
1258              
1259             You can use L to generate a JWK for RSA:
1260              
1261             my $pubkey = Crypt::PK::RSA->new('rs256-4096-public.pem');
1262             my $jwk_hash = $pubkey->export_key_jwk('public', 1);
1263             $jwk_hash->{kid} = 'key1';
1264             my $keylist = {
1265             keys => [
1266             $jwk_hash,
1267             ]
1268             };
1269              
1270             The structure described above is used e.g. by L
1271              
1272             use Mojo::UserAgent;
1273             my $ua = Mojo::UserAgent->new;
1274             my $google_keys = $ua->get('https://www.googleapis.com/oauth2/v2/certs')->result->json;
1275             my $payload = decode_jwt(token => $t, kid_keys => $google_keys);
1276              
1277             B An alternative structure (used e.g. by L) is also accepted:
1278              
1279             use LWP::Simple;
1280             my $google_certs = get('https://www.googleapis.com/oauth2/v1/certs');
1281             my $payload = decode_jwt(token => $t, kid_keys => $google_certs);
1282              
1283             When the token header contains a C item, the corresponding key is looked up in the C list and used for token
1284             decoding (you do not need to pass the explicit key via the C parameter). Add a C header on the encode side via L.
1285              
1286             B When C is specified, decoding croaks if the token header does not contain a C value or
1287             if the C was not found in C.
1288              
1289             =item key_from_jwk_header
1290              
1291             B
1292              
1293             C<1> - use C header value for validating JWS signature if neither C nor C specified, B
1294              
1295             C<0> (default) - ignore C header value when validating JWS signature
1296              
1297             Keep in mind that enabling C requires the C header to exist and to be a valid RSA/ECDSA public key (otherwise it croaks).
1298              
1299             =item allow_none
1300              
1301             C<1> - accept JWS tokens with C 'alg' header value (which means that token has no signature), B
1302              
1303             C<0> (default) - do not allow JWS with C 'alg' header value
1304              
1305             =item ignore_signature
1306              
1307             C<1> - do not check signature on JWS tokens, B
1308              
1309             C<0> (default) - check signature on JWS tokens
1310              
1311             =item accepted_alg
1312              
1313             B B strongly recommended. Pinning C to
1314             the algorithm (or family) you actually expect prevents "alg confusion"
1315             attacks where a forged token swaps the C header to a different family
1316             - see the SECURITY note under C.
1317              
1318             Accepted value types:
1319              
1320             =over
1321              
1322             =item *
1323              
1324             C (default) - accept all C algorithms except C (for accepting C use C)
1325              
1326             =item *
1327              
1328             Scalar string - the single accepted C name
1329              
1330             =item *
1331              
1332             ARRAY ref - list of accepted C names
1333              
1334             =item *
1335              
1336             C - the C value must match this regexp
1337              
1338             =back
1339              
1340             Example:
1341              
1342             my $payload = decode_jwt(token=>$t, key=>$k, accepted_alg=>'HS256');
1343             my $payload = decode_jwt(token=>$t, key=>$k, accepted_alg=>['HS256','HS384']);
1344             my $payload = decode_jwt(token=>$t, key=>$k, accepted_alg=>qr/^HS(256|384|512)$/);
1345              
1346             B Any other argument type (HASH ref,
1347             CODE ref, GLOB ref, etc.) now croaks at decode time; previously such typos
1348             silently became no-ops on the JWE side.
1349              
1350             =item accepted_enc
1351              
1352             JWE only. Restricts which content-encryption algorithms are accepted.
1353              
1354             Accepted value types (same shape as L):
1355              
1356             =over
1357              
1358             =item *
1359              
1360             C (default) - accept all C algorithms
1361              
1362             =item *
1363              
1364             Scalar string - the single accepted C name
1365              
1366             =item *
1367              
1368             ARRAY ref - list of accepted C names
1369              
1370             =item *
1371              
1372             C - the C value must match this regexp
1373              
1374             =back
1375              
1376             Example:
1377              
1378             my $payload = decode_jwt(token=>$t, key=>$k, accepted_enc=>'A192GCM');
1379             my $payload = decode_jwt(token=>$t, key=>$k, accepted_enc=>['A192GCM','A256GCM']);
1380             my $payload = decode_jwt(token=>$t, key=>$k, accepted_enc=>qr/^A(128|192|256)GCM$/);
1381              
1382             =item decode_payload
1383              
1384             C<0> - do not decode payload, return it as a raw string (octets).
1385              
1386             C<1> - decode payload from JSON string, return it as perl hash ref (or array ref) - decode_json failure means fatal error (croak).
1387              
1388             C (default) - if possible decode payload from JSON string, if decode_json fails return payload as a raw string (octets).
1389              
1390             =item decode_header
1391              
1392             C<0> (default) - C returns just the decoded payload (scalar
1393             context).
1394              
1395             C<1> - C returns C<($header, $payload)>; useful when you need
1396             to inspect the JWT header (e.g. C, C, C).
1397              
1398             my $payload = decode_jwt(token=>$t, key=>$k);
1399             my ($header, $payload) = decode_jwt(token=>$t, key=>$k, decode_header=>1);
1400              
1401             =item verify_iss
1402              
1403             B If C is specified and the
1404             C (Issuer) claim is completely missing, verification fails.
1405              
1406             C - subroutine (with 'iss' claim value passed as argument) should return C otherwise verification fails
1407              
1408             C - 'iss' claim value has to match given regexp otherwise verification fails
1409              
1410             C - 'iss' claim value has to be equal to given string. B
1411              
1412             C (default) - do not verify 'iss' claim
1413              
1414             =item verify_aud
1415              
1416             B If C is specified and the
1417             C (Audience) claim is completely missing, verification fails.
1418              
1419             C - subroutine (with 'aud' claim value passed as argument) should return C otherwise verification fails
1420              
1421             C - 'aud' claim value has to match given regexp otherwise verification fails
1422              
1423             C - 'aud' claim value has to be equal to given string. B
1424              
1425             C (default) - do not verify 'aud' claim
1426              
1427             B The C claim may also be an array of strings. The
1428             check succeeds if at least one array element matches; the configured check
1429             (CODE, Regexp, Scalar) is applied individually to each element.
1430              
1431             =item verify_sub
1432              
1433             B If C is specified and the
1434             C (Subject) claim is completely missing, verification fails.
1435              
1436             C - subroutine (with 'sub' claim value passed as argument) should return C otherwise verification fails
1437              
1438             C - 'sub' claim value has to match given regexp otherwise verification fails
1439              
1440             C - 'sub' claim value has to be equal to given string. B
1441              
1442             C (default) - do not verify 'sub' claim
1443              
1444             =item verify_jti
1445              
1446             B If C is specified and the
1447             C (JWT ID) claim is completely missing, verification fails.
1448              
1449             C - subroutine (with 'jti' claim value passed as argument) should return C otherwise verification fails
1450              
1451             C - 'jti' claim value has to match given regexp otherwise verification fails
1452              
1453             C - 'jti' claim value has to be equal to given string. B
1454              
1455             C (default) - do not verify 'jti' claim
1456              
1457             =item verify_iat
1458              
1459             B C is asymmetric with C/C.
1460             Omitting the key entirely (the true default) means "no iat check".
1461             Passing C undef> is B the same as omitting it - it
1462             explicitly enables the present-but-must-be-valid check below.
1463              
1464             C - "validate-if-present" mode: if the payload contains an 'iat'
1465             claim it must not be in the future (modulo C), otherwise
1466             verification croaks; if 'iat' is absent, no error is raised. Useful when
1467             you want to honor an issuer's 'iat' when they provide one but not insist
1468             on it being there.
1469              
1470             C<0> - ignore 'iat' claim (same as omitting the key)
1471              
1472             C<1> - require valid 'iat' claim: payload must contain 'iat' and it must
1473             not be in the future (modulo C); croaks otherwise.
1474              
1475             If the C key is not passed at all, no iat check is performed
1476             regardless of whether the payload contains an 'iat' claim.
1477              
1478             =item verify_nbf
1479              
1480             C (default) - Not Before 'nbf' claim must be valid if present
1481              
1482             C<0> - ignore 'nbf' claim
1483              
1484             C<1> - require valid 'nbf' claim
1485              
1486             =item verify_exp
1487              
1488             C (default) - Expiration Time 'exp' claim must be valid if present
1489              
1490             C<0> - ignore 'exp' claim
1491              
1492             C<1> - require valid 'exp' claim
1493              
1494             =item leeway
1495              
1496             Tolerance in seconds related to C, C and C. Default is C<0>.
1497              
1498             =item ignore_claims
1499              
1500             C<1> - do not check claims (iat, exp, nbf, iss, aud, sub, jti), B
1501              
1502             C<0> (default) - check claims
1503              
1504             =item verify_typ
1505              
1506             B
1507              
1508             C - subroutine (with 'typ' header parameter value passed as argument) should return C otherwise verification fails
1509              
1510             C - 'typ' header parameter value has to match given regexp otherwise verification fails
1511              
1512             C - 'typ' header parameter value has to be equal to given string
1513              
1514             C (default) - do not verify 'typ' header parameter
1515              
1516             =item tolerate_padding
1517              
1518             B (semantics clarified B). Both modes accept tokens whose segments include trailing C<=> Base64 padding
1519             characters (which are not produced by spec-compliant encoders); they differ
1520             only in what gets fed to the signature check.
1521              
1522             C<0> (default) - strip C<=> padding from each segment B computing
1523             the signature input. Compatible with the strict RFC 7515 producer (no
1524             padding signed). If the producer signed the I form, signature
1525             verification will fail in this mode.
1526              
1527             C<1> - keep C<=> padding as part of the signature input. Required to verify
1528             tokens produced by libraries (some Java implementations) that include
1529             padding in the bytes that were signed.
1530              
1531             =back
1532              
1533             =head2 encode_jwt
1534              
1535             my $token = encode_jwt(%named_args);
1536              
1537             Returns the encoded JWT as a string - either compact serialization (the
1538             default; three or five C<.>-separated segments) or flattened JSON
1539             serialization (when C 'flattened'>; a JSON object).
1540             Croaks on bad arguments or unsupported algorithm combinations.
1541              
1542             Named arguments:
1543              
1544             =over
1545              
1546             =item payload
1547              
1548             Mandatory. Accepts a string (raw bytes), a HASH ref, or an ARRAY ref.
1549             HASH ref and ARRAY ref payloads are serialized as JSON strings; string
1550             payloads are passed through verbatim.
1551              
1552             my $token = encode_jwt(payload=>"any raw data", key=>$k, alg=>'HS256');
1553             my $token = encode_jwt(payload=>{a=>1, b=>2}, key=>$k, alg=>'HS256');
1554             my $token = encode_jwt(payload=>[11,22,33,44], key=>$k, alg=>'HS256');
1555              
1556             =item alg
1557              
1558             The 'alg' header value is mandatory for both JWE and JWS tokens.
1559              
1560             Supported JWE 'alg' algorithms:
1561              
1562             dir
1563             A128KW
1564             A192KW
1565             A256KW
1566             A128GCMKW
1567             A192GCMKW
1568             A256GCMKW
1569             PBES2-HS256+A128KW
1570             PBES2-HS384+A192KW
1571             PBES2-HS512+A256KW
1572             RSA-OAEP
1573             RSA-OAEP-256
1574             RSA1_5
1575             ECDH-ES+A128KW
1576             ECDH-ES+A192KW
1577             ECDH-ES+A256KW
1578             ECDH-ES
1579              
1580             Supported JWS algorithms:
1581              
1582             none ... no integrity (NOTE: disabled by default)
1583             HS256 ... HMAC+SHA256 integrity
1584             HS384 ... HMAC+SHA384 integrity
1585             HS512 ... HMAC+SHA512 integrity
1586             RS256 ... RSA+PKCS1-V1_5 + SHA256 signature
1587             RS384 ... RSA+PKCS1-V1_5 + SHA384 signature
1588             RS512 ... RSA+PKCS1-V1_5 + SHA512 signature
1589             PS256 ... RSA+PSS + SHA256 signature
1590             PS384 ... RSA+PSS + SHA384 signature
1591             PS512 ... RSA+PSS + SHA512 signature
1592             ES256 ... ECDSA + SHA256 signature
1593             ES256K ... ECDSA + SHA256 signature
1594             ES384 ... ECDSA + SHA384 signature
1595             ES512 ... ECDSA + SHA512 signature
1596             EdDSA ... Ed25519 signature
1597              
1598             =item enc
1599              
1600             The 'enc' header is mandatory for JWE tokens.
1601              
1602             Supported 'enc' algorithms:
1603              
1604             A128GCM
1605             A192GCM
1606             A256GCM
1607             A128CBC-HS256
1608             A192CBC-HS384
1609             A256CBC-HS512
1610              
1611             =item key
1612              
1613             A key used for token encryption (JWE) or token signing (JWS). The value depends on C token header value.
1614              
1615             JWS alg header key value
1616             ------------------ ----------------------------------
1617             none no key required
1618             HS256 string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1619             HS384 same as HS256
1620             HS512 same as HS256
1621             RS256 private RSA key, perl HASH ref with JWK key structure,
1622             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1623             object: Crypt::PK::RSA, Crypt::OpenSSL::RSA, Crypt::X509 or Crypt::OpenSSL::X509
1624             RS384 private RSA key, see RS256
1625             RS512 private RSA key, see RS256
1626             PS256 private RSA key, see RS256
1627             PS384 private RSA key, see RS256
1628             PS512 private RSA key, see RS256
1629             ES256 private ECC key, perl HASH ref with JWK key structure,
1630             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1631             an instance of Crypt::PK::ECC
1632             ES256K private ECC key, see ES256
1633             ES384 private ECC key, see ES256
1634             ES512 private ECC key, see ES256
1635             EdDSA private Ed25519 key
1636              
1637             JWE alg header key value
1638             ------------------ ----------------------------------
1639             dir string (raw octets) or perl HASH ref with JWK, kty=>'oct', length depends on 'enc' algorithm
1640             A128KW string (raw octets) 16 bytes (or perl HASH ref with JWK, kty=>'oct')
1641             A192KW string (raw octets) 24 bytes (or perl HASH ref with JWK, kty=>'oct')
1642             A256KW string (raw octets) 32 bytes (or perl HASH ref with JWK, kty=>'oct')
1643             A128GCMKW string (raw octets) 16 bytes (or perl HASH ref with JWK, kty=>'oct')
1644             A192GCMKW string (raw octets) 24 bytes (or perl HASH ref with JWK, kty=>'oct')
1645             A256GCMKW string (raw octets) 32 bytes (or perl HASH ref with JWK, kty=>'oct')
1646             PBES2-HS256+A128KW string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1647             PBES2-HS384+A192KW string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1648             PBES2-HS512+A256KW string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
1649             RSA-OAEP public RSA key, perl HASH ref with JWK key structure,
1650             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1651             an instance of Crypt::PK::RSA or Crypt::OpenSSL::RSA
1652             RSA-OAEP-256 public RSA key, see RSA-OAEP
1653             RSA1_5 public RSA key, see RSA-OAEP
1654             ECDH-ES public ECC or X25519 key, perl HASH ref with JWK key structure,
1655             a reference to SCALAR string with PEM or DER or JSON/JWK data,
1656             an instance of Crypt::PK::ECC
1657             ECDH-ES+A128KW public ECC or X25519 key, see ECDH-ES
1658             ECDH-ES+A192KW public ECC or X25519 key, see ECDH-ES
1659             ECDH-ES+A256KW public ECC or X25519 key, see ECDH-ES
1660              
1661             =item keypass
1662              
1663             Optional. When the C parameter is an encrypted private RSA or ECC
1664             key (PEM/DER), this parameter holds the password used to decrypt it.
1665              
1666             =item allow_none
1667              
1668             C<1> - allow JWS with C 'alg' header value (which means that token has no signature), B
1669              
1670             C<0> (default) - do not allow JWS with C 'alg' header value
1671              
1672             =item extra_headers
1673              
1674             This optional parameter may contain a HASH ref with items that will be added to JWT header.
1675              
1676             If you want to use PBES2-based 'alg' like C you can set PBES2 salt len (p2s) in bytes and
1677             iteration count (p2c) via C like this:
1678              
1679             my $token = encode_jwt(payload=>$p, key=>$k, alg=>'PBES2-HS512+A256KW', extra_headers=>{p2c=>8000, p2s=>32});
1680             #NOTE: handling of p2s header is a special case, in the end it is replaced with the generated salt
1681              
1682             You can also use this to specify a C value (see L):
1683              
1684             my $token = encode_jwt(payload=>$p, key=>$k, alg=>'RS256', extra_headers=>{kid=>'key1'});
1685              
1686             =item unprotected_headers
1687              
1688             A HASH ref with additional integrity-unprotected headers (JWS and JWE).
1689             Not available for C serialization.
1690              
1691             =item shared_unprotected_headers
1692              
1693             A HASH ref with additional integrity-unprotected headers (JWE only).
1694             Not available for C serialization.
1695              
1696             =item aad
1697              
1698             Additional Authenticated Data: a scalar of arbitrary bytes that is
1699             authenticated but not encrypted (JWE only).
1700             Not available for C serialization.
1701              
1702             =item serialization
1703              
1704             Specify serialization method: C (default) for Compact JWS/JWE serialization or C for Flattened JWS/JWE JSON serialization.
1705              
1706             General JSON serialization is not supported yet.
1707              
1708             =item zip
1709              
1710             Compression method, currently 'deflate' is the only one supported. C (default) means no compression.
1711              
1712             my $token = encode_jwt(payload=>$p, key=>$k, alg=>'HS256', zip=>'deflate');
1713             #or define compression level
1714             my $token = encode_jwt(payload=>$p, key=>$k, alg=>'HS256', zip=>['deflate', 9]);
1715              
1716             =item auto_iat
1717              
1718             C<1> - set the C (Issued At) claim to the current time (epoch
1719             seconds since 1970) at the moment of token encoding.
1720              
1721             C<0> (default) - do not set the C claim.
1722              
1723             B takes effect only when the C argument is a HASH ref;
1724             silently ignored for string/ARRAY-ref payloads. Same applies to
1725             C and C.
1726              
1727             =item relative_exp
1728              
1729             Set the C (Expiration Time) claim to current time + C
1730             value (in seconds). See note under C about HASH-ref payloads.
1731              
1732             =item relative_nbf
1733              
1734             Set the C (Not Before) claim to current time + C
1735             value (in seconds). See note under C about HASH-ref payloads.
1736              
1737             =back
1738              
1739             =head1 SECURITY CONSIDERATIONS
1740              
1741             =head2 Configuration knobs
1742              
1743             The library exposes four tunable package variables. Set them once at
1744             program startup (typically in a C block) before any
1745             C/C call.
1746              
1747             =over
1748              
1749             =item C<$Crypt::JWT::MAX_PBES2_ITER> (default C<3_000_000>)
1750              
1751             Maximum accepted PBES2 C (iteration count) on decode. Caps CPU time
1752             spent on PBKDF2 for an attacker-controlled token. B
1753              
1754             =item C<$Crypt::JWT::MAX_INFLATED_SIZE> (default C<10 * 1024 * 1024>)
1755              
1756             Maximum size (in bytes) of a payload after C inflation. Caps
1757             memory blow-up from "zip-bomb" tokens. B
1758              
1759             =item C<$Crypt::JWT::MIN_HMAC_KEY_LEN> (default C<4>)
1760              
1761             Minimum HMAC key length (bytes) for HS256/384/512. See L
1762             minimums> below for the rationale and recommended override values.
1763             B
1764              
1765             =item C<$Crypt::JWT::MIN_RSA_BITS> (default C<2048>)
1766              
1767             Minimum RSA modulus size (bits). Applies to all RSA-based algorithms
1768             (RS256/384/512, PS256/384/512, RSA-OAEP, RSA-OAEP-256, RSA1_5).
1769             B
1770              
1771             =back
1772              
1773             =head2 Key-strength minimums
1774              
1775             The library enforces the following minimums; tokens that try to sign or
1776             verify with weaker keys are rejected with a croak. Both knobs are package
1777             variables and can be tuned at startup if a deployer has a stricter or
1778             looser policy.
1779              
1780             =over
1781              
1782             =item *
1783              
1784             BnE:> minimum length B<4 bytes> (overridable via
1785             C<$Crypt::JWT::MIN_HMAC_KEY_LEN>). Applies to C and
1786             C on the HS256 / HS384 / HS512 paths. Tokens that try to sign
1787             or verify with a shorter key are rejected with a croak.
1788              
1789             B this default is intentionally B than RFC 7518
1790             section 3.2, which requires the key to be at least the size of the hash
1791             output (32 / 48 / 64 bytes for HS256 / HS384 / HS512). The 4-byte floor is
1792             a backward-compatibility compromise - the library has long accepted short
1793             keys and many existing deployments rely on that - that just blocks the
1794             most trivially weak keys (single characters, two-letter strings) while
1795             leaving the policy decision in the deployer's hands.
1796             Cryptographically, HMAC security is bounded by the entropy of the key:
1797             16 random bytes (128 bits) is the smallest size that gives a comfortable
1798             security margin against brute-force key recovery; below that you start
1799             losing real security.
1800              
1801             =item *
1802              
1803             B minimum B<2048 bits> (overridable via
1804             C<$Crypt::JWT::MIN_RSA_BITS>). Applies to RS256/384/512, PS256/384/512,
1805             RSA-OAEP, RSA-OAEP-256, and RSA1_5 - both signing/encryption and
1806             verification/decryption. RSA keys with smaller moduli are rejected. This
1807             matches RFC 7518 section 3.3: "A key of size 2048 bits or larger MUST be
1808             used with these algorithms".
1809              
1810             =back
1811              
1812             =head1 SEE ALSO
1813              
1814             L, L, L, L, L, L
1815              
1816             =head1 LICENSE
1817              
1818             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
1819              
1820             =head1 COPYRIGHT
1821              
1822             Copyright (c) 2015-2026 DCIT, a.s. L / Karel Miko