File Coverage

blib/lib/Mojo/JWT.pm

Criterion	Covered	Total	%
statement	99	112	88.3
branch	37	56	66.0
condition	8	15	53.3
subroutine	15	16	93.7
pod	7	7	100.0
total	166	206	80.5

package Mojo::JWT;

use Mojo::Base -base;

our $VERSION = '0.09';
$VERSION = eval $VERSION;

use Scalar::Util qw/blessed/;
use List::Util qw/first/;
use Mojo::JSON qw/encode_json decode_json/;
use MIME::Base64 qw/encode_base64url decode_base64url/;

use Carp;

my $isa = sub { blessed $_[0] && $_[0]->isa($_[1]) };

has header => sub { {} };
has algorithm => 'HS256';
has [qw/allow_none set_iat/] => 0;
has claims => sub { {} };
has jwks => sub { [] };
has [qw/expires not_before/];
has [qw/public secret/] => '';

my $re_hs = qr/^HS(\d+)$/;
my $re_rs = qr/^RS(\d+)$/;

sub add_jwkset {
  my ($self, $jwkset) = @_;
  if (ref $jwkset eq 'HASH') {
    push @{ $self->jwks }, @{ $jwkset->{keys} };
  }
  if (ref $jwkset eq 'ARRAY') {
    push @{ $self->jwks }, @{ $jwkset };
  }
  return $self;
}

sub decode {
  my ($self, $token, $peek) = @_;
  $self->{token} = $token;

  # reset
  $self->algorithm(undef);
  delete $self->{$_} for qw/claims expires not_before header/;

  my ($hstring, $cstring, $signature) = split /\./, $token;
  my $header = decode_json decode_base64url($hstring);
  my $claims = decode_json decode_base64url($cstring);
  $signature = decode_base64url $signature;

  # typ header is only recommended and is ignored
  # https://tools.ietf.org/html/rfc7519#section-5.1
  delete $header->{typ};
  croak 'Required header field "alg" not specified'
    unless my $algo = $self->algorithm(delete $header->{alg})->algorithm;
  $self->header($header);

  $self->_try_jwks($algo, $header);

  $self->$peek($claims) if $peek;

  # check signature
  my $payload = "$hstring.$cstring";
  if ($algo eq 'none') {
    croak 'Algorithm "none" is prohibited'
      unless $self->allow_none;
  } elsif ($algo =~ $re_rs) {
    croak 'Failed RS validation'
      unless $self->verify_rsa($1, $payload, $signature);
  } elsif ($algo =~ $re_hs) {
    croak 'Failed HS validation'
      unless $signature eq $self->sign_hmac($1, $payload);
  } else {
    croak 'Unsupported signing algorithm';
  }

  # check timing
  my $now = $self->now;
  if (defined(my $exp = $claims->{exp})) {
    croak 'JWT has expired' if $now > $exp;
    $self->expires($exp);
  }
  if (defined(my $nbf = $claims->{nbf})) {
    croak 'JWT is not yet valid' if $now < $nbf;
    $self->not_before($nbf);
  }

  return $self->claims($claims)->claims;
}

sub _try_jwks {
  my ($self, $algo, $header) = @_;
  return unless @{$self->jwks} && $header->{kid};

  # Check we have the JWK for this JWT
  my $jwk = first { exists $header->{kid} && $_->{kid} eq $header->{kid} } @{$self->jwks};
  return unless $jwk;

  if ($algo =~ /^RS/) {
    require Crypt::OpenSSL::Bignum;
    my $n = Crypt::OpenSSL::Bignum->new_from_bin(decode_base64url $jwk->{n});
    my $e = Crypt::OpenSSL::Bignum->new_from_bin(decode_base64url $jwk->{e});

    require Crypt::OpenSSL::RSA;
    my $pubkey = Crypt::OpenSSL::RSA->new_key_from_parameters($n, $e);
    $self->public($pubkey);
  } elsif ($algo =~ /^HS/) {
    $self->secret( decode_base64url $jwk->{k} )
  }
}

sub encode {
  my $self = shift;
  delete $self->{token};

  my $claims = $self->claims;
  if ($self->set_iat) { $claims->{iat} = $self->now }
  if (defined(my $exp = $self->expires))    { $claims->{exp} = $exp }
  if (defined(my $nbf = $self->not_before)) { $claims->{nbf} = $nbf }

  my $header  = { %{ $self->header }, typ => 'JWT', alg => $self->algorithm };
  my $hstring = encode_base64url encode_json($header);
  my $cstring = encode_base64url encode_json($claims);
  my $payload = "$hstring.$cstring";
  my $signature;
  my $algo = $self->algorithm;
  if ($algo eq 'none') {
    $signature = '';
  } elsif ($algo =~ $re_rs) {
    $signature = $self->sign_rsa($1, $payload);
  } elsif ($algo =~ $re_hs) {
    $signature = $self->sign_hmac($1, $payload);
  } else {
    croak 'Unknown algorithm';
  }

  return $self->{token} = "$payload." . encode_base64url $signature;
}

sub now { time }

sub sign_hmac {
  my ($self, $size, $payload) = @_;
  croak 'symmetric secret not specified' unless my $secret = $self->secret;
  require Digest::SHA;
  my $f = Digest::SHA->can("hmac_sha$size") || croak 'Unsupported HS signing algorithm';
  return $f->($payload, $secret);
}

sub sign_rsa {
  my ($self, $size, $payload) = @_;
  require Crypt::OpenSSL::RSA;
  my $crypt = Crypt::OpenSSL::RSA->new_private_key($self->secret || croak 'private key (secret) not specified');
  my $method = $crypt->can("use_sha${size}_hash") || croak 'Unsupported RS signing algorithm';
  $crypt->$method;
  return $crypt->sign($payload);
}

sub token { shift->{token} }

sub verify_rsa {
  my ($self, $size, $payload, $signature) = @_;
  require Crypt::OpenSSL::RSA;
  croak 'public key not specified' unless my $public = $self->public;
  my $crypt = $public->$isa('Crypt::OpenSSL::RSA') ? $public : Crypt::OpenSSL::RSA->new_public_key($public);
  my $method = $crypt->can("use_sha${size}_hash") || croak 'Unsupported RS verification algorithm';
  $crypt->$method;
  return $crypt->verify($payload, $signature);
}

1;

=head1 NAME

Mojo::JWT - JSON Web Token the Mojo way

=head1 SYNOPSIS

  my $jwt = Mojo::JWT->new(claims => {...}, secret => 's3cr3t')->encode;
  my $claims = Mojo::JWT->new(secret => 's3cr3t')->decode($jwt);

=head1 DESCRIPTION

JSON Web Token is described in L.
L implements that standard with an API that should feel familiar to L users (though of course it is useful elsewhere).
Indeed, JWT is much like L except that the result is a url-safe text string rather than a cookie.

In JWT, the primary payload is called the C, and a few claims are reserved, as seen in the IETF document.
The header and the claims are signed when stringified to guard against tampering.
Note that while signed, the data is not encrypted, so don't use it to send secrets over clear channels.

=head1 ATTRIBUTES

L inherits all of the attributes from L and implements the following new ones.

=head2 algorithm

The algorithm to be used to sign a JWT during encoding or else the algorithm that was used for the most recent decoding.
Defaults to C until a decode is performed.

C is an acceptable encoding algorithm, however for it to be used to decode, L must be set.

=head2 allow_none

To prevent spoofing attacks, C must be explicitly set to a true value otherwise decoding a JWT which specifies the C algorithm will result in an exception.
The default is of course false.

=head2 claims

The payload to be encoded or else the claims from the most recent decoding.
This must be a hash reference, array references are not allowed as the top-level JWT claims.

=head2 expires

The epoch time value after which the JWT value should not be considered valid.
This value (if set and not undefined) will be used as the C key in the claims or was extracted from the claims during the most recent decoding.

=head2 header

You may set your own headers when encoding the JWT bypassing a hash reference to the L attribute. Please note that there are two default headers set. B is set to the value of L or 'HS256' and B is set to 'JWT'. These cannot be overridden.

=head2 not_before

The epoch time value before which the JWT value should not be considered valid.
This value (if set and not undefined) will be used as the C key in the claims or was extracted from the claims during the most recent decoding.

=head2 public

The public key to be used in decoding an asymmetrically signed JWT (eg. RSA).

=head2 secret

The symmetric secret (eg. HMAC) or else the private key used in encoding an asymmetrically signed JWT (eg. RSA).

=head2 set_iat

If true (false by default), then the C claim will be set to the value of L during L.

=head2 jwks

An arrayref of JWK objects used by C to verify the input token when matching with the JWTs C field.

    my $jwks = Mojo::UserAgent->new->get('https://example.com/oidc/jwks.json')->result->json('/keys');
    my $jwt = Mojo::JWT->new(jwks => $jwks);
    $jwk->decode($token);

=head1 METHODS

L inherits all of the methods from L and implements the following new ones.

=head2 add_jwkset

    my $jwkset = Mojo::UserAgent->new->get('https://example.com/oidc/jwks.json')->result->json;
    my $jwt = Mojo::JWT->new->add_jwkset($jwksset);
    $jwk->decode($token);

Helper for appending a jwkset to the L.
Accepts a hashref with a C field that is an arrayref of jwks and also an arrayref directly.
Appends the JWKs to L.
Returns the instance.

=head2 decode

  my $claims = $jwt->decode($token);

  my $peek = sub { my ($jwt, $claims) = @_; ... };
  my $claims = $jwt->decode($token, $peek);

Decode and parse a JSON Web Token string and return the claims hashref.
Calling this function immediately sets the L to the passed in token.
It also sets L to C and unsets L, L and L.
These values are then set as part of the parsing process.

Parsing occurs as follows

=over

=item *

The L is extracted from the header and set, if not present or permissible an exception is thrown

=item *

Any JWKs in C are checked against the headers and if one is found then it is set in L or L as appropriate to the L

=item *

If a C<$peek> callback is provided, it is called with the instance and claims as arguments

=item *

The signature is verified or an exception is thrown

=item *

The timing claims (L and L), if present, are evaluated, failures result in exceptions. On success the values are set in the relevant attributes

=item *

The L attribute is set and the claims are returned.

=back

Note that when the C<$peek> callback is invoked, the claims have not yet been verified.
This callback is most likely to be used to inspect the C or issuer claim to determine a secret or key for decoding.
The return value is ignored, changes should be made to the instances attributes directly.
Since the L has already been parsed, it is available via the instance attribute as well.

=head2 encode

  my $token = $jwt->encode;

Encode the data expressed in the instance attributes: L, L, L, L.
Note that if the timing attributes are given, they override existing keys in the L.
Calling C immediately clears the L and upon completion sets it to the result as well as returning it.

Note also that due to Perl's hash randomization, repeated encoding is not guaranteed to result in the same encoded string.
However any encoded string will survive an encode/decode roundtrip.

=head2 header

  my $header = $jwt->header;

Returns a hash reference representing the JWT header, constructed from instance attributes (see L).

=head2 now

  my $time = $jwt->now;

Returns the current time, currently implemented as the core C function.

=head2 sign_hmac

  my $signature = $jwt->sign_hmac($size, $payload);

Returns the HMAC SHA signature for the given size and payload.
The L attribute is used as the symmetric key.
The result is not yet base64 encoded.
This method is provided mostly for the purposes of subclassing.

=head2 sign_rsa

  my $signature = $jwt->sign_rsa($size, $payload);

Returns the RSA signature for the given size and payload.
The L attribute is used as the private key.
The result is not yet base64 encoded.
This method is provided mostly for the purposes of subclassing.

=head2 token

The most recently encoded or decoded token.
Note that any attribute modifications are not taken into account until L is called again.

=head2 verify_rsa

  my $bool = $jwt->verify_rsa($size, $payload, $signature);

Returns true if the given RSA size algorithm validates the given payload and signature.
The L attribute is used as the public key.
This method is provided mostly for the purposes of subclassing.

=head1 SEE ALSO

=over

=item L

=item L

=item L

=back

=head1 SOURCE REPOSITORY

L

=head1 AUTHOR

Joel Berger, [e-mail]

=head1 CONTRIBUTORS

Christopher Raa (mishanti1)

Cameron Daniel (ccakes)

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015 by L and L.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.