decoded results from the CPAN

Crypt-JWT

      croak "$what: JWK has unknown ECDSA alg '$key->{alg}'";
    }
  }
}

sub _check_accepted {
  my ($what, $value, $check) = @_;
  return unless defined $check;
  my $r = ref $check;
  if    ($r eq 'Regexp') { croak "JWT: $what '$value' does not match accepted_$what" if $value !~ $check }
  elsif ($r eq 'ARRAY')  { my %ok = map { $_ => 1 } @$check;
                           croak "JWT: $what '$value' not in accepted_$what" unless $ok{$value} }
  elsif (!$r)            { croak "JWT: $what '$value' not accepted_$what" if $value ne $check }
  else                   { croak "JWT: accepted_$what must be Regexp, ARRAY ref, or Scalar (got $r)" }
}

sub _verify_header {
  my ($header, %args) = @_;

  # currently we only check "typ" header parameter
  my $check = $args{verify_typ};
  return if !defined $check;

  if (exists $header->{typ}) {
    if (ref $check eq 'Regexp') {
      my $value = $header->{typ};
      $value = "" if !defined $value;
      croak "JWT: typ header re check failed" unless $value =~ $check;
    }
    elsif (ref $check eq 'CODE') {
      croak "JWT: typ header code check failed" unless $check->($header->{typ});
    }
    elsif (!ref $check) {
      my $value = $header->{typ};
      croak "JWT: typ header scalar check failed" unless defined $value && $value eq $check;
    }
    else {
      croak "JWT: verify_typ must be Regexp, Scalar or CODE";
    }
  }
  else {
    croak "JWT: typ header required but missing"
  }

}

sub _check_numeric_date {
  my ($payload, $claim) = @_;
  my $value = $payload->{$claim};
  croak "JWT: $claim claim must be a NumericDate"
    if !defined($value) || ref($value) || "$value" !~ /\A(?:0|[1-9][0-9]*)(?:\.[0-9]+)?\z/;
}

sub _verify_claims {
  my ($payload, %args) = @_;

  return if $args{ignore_claims};

  if (ref($payload) ne 'HASH') {
    # https://github.com/DCIT/perl-Crypt-JWT/issues/31
    # payload needs to be decoded into a HASH for checking any verify_XXXX
    for my $claim (qw(exp nbf iat iss sub aud jti)) {
      if (defined $args{"verify_$claim"} && $args{"verify_$claim"} != 0) {
        croak "JWT: cannot check verify_$claim (payload not decoded JSON/HASH)";
      }
    }
    return; # nothing to check
  }

  my $leeway = $args{leeway} || 0;
  my $now = time;

  ### exp
  if(defined $payload->{exp}) {
    if (!defined $args{verify_exp} || $args{verify_exp}==1) {
      _check_numeric_date($payload, 'exp');
      croak "JWT: exp claim check failed ($payload->{exp}/$leeway vs. $now)" if $payload->{exp} + $leeway <= $now;
    }
  }
  elsif ($args{verify_exp} && $args{verify_exp}==1) {
    croak "JWT: exp claim required but missing"
  }

  ### nbf
  if(defined $payload->{nbf}) {
    if (!defined $args{verify_nbf} || $args{verify_nbf}==1) {
      _check_numeric_date($payload, 'nbf');
      croak "JWT: nbf claim check failed ($payload->{nbf}/$leeway vs. $now)" if $payload->{nbf} - $leeway > $now;
    }
  }
  elsif ($args{verify_nbf} && $args{verify_nbf}==1) {
    croak "JWT: nbf claim required but missing"
  }

  ### iat
  if (exists $args{verify_iat}) { #default (non existing verify_iat) == no iat check
    if(defined $payload->{iat}) {
      if (!defined $args{verify_iat} || $args{verify_iat}==1) {
        _check_numeric_date($payload, 'iat');
        croak "JWT: iat claim check failed ($payload->{iat}/$leeway vs. $now)" if $payload->{iat} - $leeway > $now;
      }
    }
    elsif ($args{verify_iat} && $args{verify_iat}==1) {
      croak "JWT: iat claim required but missing"
    }
  }

  ### aud
  if (defined $args{verify_aud}) {
    my $check = $args{verify_aud};
    if (exists $payload->{aud}) {
      my $match = 0;
      # aud claim is a bit special as it can be either a string or an array of strings
      my @aud_list = ref $payload->{aud} eq 'ARRAY' ? @{$payload->{aud}} : ( $payload->{aud} );
      for my $value (@aud_list) {
        if (ref $check eq 'Regexp') {
          $value = "" if !defined $value;
          $match = 1 if $value =~ $check;
        }
        elsif (ref $check eq 'CODE') {
          $match = 1 if $check->($value);
        }
        elsif (!ref $check) {
          $match = 1 if defined $value && $value eq $check;

lib/Crypt/JWT.pm view on Meta::CPAN

}

1;

#### URLs
# https://metacpan.org/pod/JSON::WebToken
# https://metacpan.org/pod/Mojo::JWT
# https://bitbucket.org/b_c/jose4j/wiki/JWE%20Examples
# https://bitbucket.org/b_c/jose4j/wiki/JWS%20Examples
# https://github.com/dvsekhvalnov/jose-jwt/tree/master/JWT/jwe
# https://github.com/progrium/ruby-jwt
# https://github.com/jpadilla/pyjwt/

=pod

=head1 NAME

Crypt::JWT - JSON Web Token (JWT, JWS, JWE) as defined by RFC7519, RFC7515, RFC7516

=head1 SYNOPSIS

   # encoding
   use Crypt::JWT qw(encode_jwt);
   my $jws_token = encode_jwt(payload=>$data, alg=>'HS256', key=>'secret');
   my $jwe_token = encode_jwt(payload=>$data, alg=>'PBES2-HS256+A128KW', enc=>'A128GCM', key=>'secret');

   # decoding
   use Crypt::JWT qw(decode_jwt);
   my $data1 = decode_jwt(token=>$jws_token, key=>'secret');
   my $data2 = decode_jwt(token=>$jwe_token, key=>'secret');

=head1 DESCRIPTION

Implements B<JSON Web Token (JWT)> - L<https://tools.ietf.org/html/rfc7519>.
The implementation covers not only B<JSON Web Signature (JWS)> - L<https://tools.ietf.org/html/rfc7515>,
but also B<JSON Web Encryption (JWE)> - L<https://tools.ietf.org/html/rfc7516>.

The module implements all algorithms defined in L<https://tools.ietf.org/html/rfc7518> - B<JSON Web Algorithms (JWA)>.

This module supports B<Compact JWS/JWE> and B<Flattened JWS/JWE JSON> serialization. General (multi-recipient) JSON serialization is not supported.

=head1 EXPORT

Nothing is exported by default.

You can export selected functions:

  use Crypt::JWT qw(decode_jwt encode_jwt);

Or all of them at once:

  use Crypt::JWT ':all';

=head1 FUNCTIONS

=head2 decode_jwt

 my $data              = decode_jwt(%named_args);
 my ($header, $data)   = decode_jwt(%named_args, decode_header=>1);

Returns the decoded payload (in scalar context) or the decoded header
followed by the decoded payload (when C<decode_header =E<gt> 1>). Croaks
on any verification, decryption, or claim-check failure.

Named arguments:

=over

=item token

Mandatory. The serialized JWS or JWE token as a string. Both compact
(C<.>-separated, 3 segments for JWS / 5 for JWE) and flattened JSON
serialization are accepted.

 ### JWS compact (3 segments)
 $t = "eyJhbGciOiJIUzI1NiJ9.dGVzdA.ujBihtLSr66CEWqN74SpLUkv28lra_CeHnxLmLNp4Jo";
 my $data = decode_jwt(token=>$t, key=>$k);

 ### JWE compact (5 segments)
 $t = "eyJlbmMiOiJBMTI4R0NNIiwiYWxnIjoiQTEyOEtXIn0.UusxEbzhGkORxTRq0xkFKhvzPrXb9smw.VGfOuq0Fxt6TsdqLZUpnxw.JajIQQ.pkKZ7MHS0XjyGmRsqgom6w";
 my $data = decode_jwt(token=>$t, key=>$k);

=item key

A key used for token decryption (JWE) or token signature validation (JWS).
The value depends on the C<alg> token header value.

B<Since: 0.038> B<SECURITY:> how the C<key> argument is shaped matters.

=over

=item *

A bare scalar (e.g. C<'secret'>) is always interpreted as a raw octet
string (HMAC secret, AES key, etc.).

=item *

PEM, DER, and JWK-JSON key material B<must> be passed as a SCALAR ref
(C<\$pem>) or as an appropriate key object - never as a bare string.

=item *

If a public-key string is mistakenly passed as a bare scalar and
C<accepted_alg> is not set, an attacker who flips the token's C<alg> to
C<HS*> can forge a signature using the public-key bytes as the HMAC
secret (the so-called "alg confusion" attack).

=item *

For defense in depth, B<always> pin the algorithm with C<accepted_alg>.

=back

Overview of supported keys:

 JWS alg header      key value
 ------------------  ----------------------------------
 none                no key required
 HS256               string (raw octets) of any length (or perl HASH ref with JWK, kty=>'oct')
 HS384               same as HS256
 HS512               same as HS256

lib/Crypt/JWT.pm view on Meta::CPAN

ARRAY ref - list of accepted C<alg> names

=item *

C<Regexp> - the C<alg> value must match this regexp

=back

Example:

  my $payload = decode_jwt(token=>$t, key=>$k, accepted_alg=>'HS256');
  my $payload = decode_jwt(token=>$t, key=>$k, accepted_alg=>['HS256','HS384']);
  my $payload = decode_jwt(token=>$t, key=>$k, accepted_alg=>qr/^HS(256|384|512)$/);

B<INCOMPATIBLE CHANGE Since: 0.038> Any other argument type (HASH ref,
CODE ref, GLOB ref, etc.) now croaks at decode time; previously such typos
silently became no-ops on the JWE side.

=item accepted_enc

JWE only. Restricts which content-encryption algorithms are accepted.

Accepted value types (same shape as L</accepted_alg>):

=over

=item *

C<undef> (default) - accept all C<enc> algorithms

=item *

Scalar string - the single accepted C<enc> name

=item *

ARRAY ref - list of accepted C<enc> names

=item *

C<Regexp> - the C<enc> value must match this regexp

=back

Example:

  my $payload = decode_jwt(token=>$t, key=>$k, accepted_enc=>'A192GCM');
  my $payload = decode_jwt(token=>$t, key=>$k, accepted_enc=>['A192GCM','A256GCM']);
  my $payload = decode_jwt(token=>$t, key=>$k, accepted_enc=>qr/^A(128|192|256)GCM$/);

=item decode_payload

C<0> - do not decode payload, return it as a raw string (octets).

C<1> - decode payload from JSON string, return it as perl hash ref (or array ref) - decode_json failure means fatal error (croak).

C<undef> (default) - if possible decode payload from JSON string, if decode_json fails return payload as a raw string (octets).

=item decode_header

C<0> (default) - C<decode_jwt> returns just the decoded payload (scalar
context).

C<1> - C<decode_jwt> returns C<($header, $payload)>; useful when you need
to inspect the JWT header (e.g. C<alg>, C<kid>, C<typ>).

 my $payload            = decode_jwt(token=>$t, key=>$k);
 my ($header, $payload) = decode_jwt(token=>$t, key=>$k, decode_header=>1);

=item verify_iss

B<INCOMPATIBLE CHANGE Since: 0.024> If C<verify_iss> is specified and the
C<iss> (Issuer) claim is completely missing, verification fails.

C<CODE ref> - subroutine (with 'iss' claim value passed as argument) should return C<true> otherwise verification fails

C<Regexp ref> - 'iss' claim value has to match given regexp otherwise verification fails

C<Scalar> - 'iss' claim value has to be equal to given string. B<Since: 0.029>

C<undef> (default) - do not verify 'iss' claim

=item verify_aud

B<INCOMPATIBLE CHANGE Since: 0.024> If C<verify_aud> is specified and the
C<aud> (Audience) claim is completely missing, verification fails.

C<CODE ref> - subroutine (with 'aud' claim value passed as argument) should return C<true> otherwise verification fails

C<Regexp ref> - 'aud' claim value has to match given regexp otherwise verification fails

C<Scalar> - 'aud' claim value has to be equal to given string. B<Since: 0.029>

C<undef> (default) - do not verify 'aud' claim

B<Since: 0.036> The C<aud> claim may also be an array of strings. The
check succeeds if at least one array element matches; the configured check
(CODE, Regexp, Scalar) is applied individually to each element.

=item verify_sub

B<INCOMPATIBLE CHANGE Since: 0.024> If C<verify_sub> is specified and the
C<sub> (Subject) claim is completely missing, verification fails.

C<CODE ref> - subroutine (with 'sub' claim value passed as argument) should return C<true> otherwise verification fails

C<Regexp ref> - 'sub' claim value has to match given regexp otherwise verification fails

C<Scalar> - 'sub' claim value has to be equal to given string. B<Since: 0.029>

C<undef> (default) - do not verify 'sub' claim

=item verify_jti

B<INCOMPATIBLE CHANGE Since: 0.024> If C<verify_jti> is specified and the
C<jti> (JWT ID) claim is completely missing, verification fails.

C<CODE ref> - subroutine (with 'jti' claim value passed as argument) should return C<true> otherwise verification fails

C<Regexp ref> - 'jti' claim value has to match given regexp otherwise verification fails

( run in 0.949 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )