Koha/Token.pm

   1 package Koha::Token;
   2
   3 # Created as wrapper for CSRF tokens, but designed for more general use
   4
   5 # Copyright 2016 Rijksmuseum
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22 =head1 NAME
  23
  24 Koha::Token - Tokenizer
  25
  26 =head1 SYNOPSIS
  27
  28     use Koha::Token;
  29     my $tokenizer = Koha::Token->new;
  30     my $token = $tokenizer->generate({ length => 20 });
  31
  32     # safely generate a CSRF token (nonblocking)
  33     my $csrf_token = $tokenizer->generate({
  34         type => 'CSRF', id => $id, secret => $secret,
  35     });
  36
  37     # generate/check CSRF token with defaults and session id
  38     my $csrf_token = $tokenizer->generate_csrf({ session_id => $x });
  39     my $result = $tokenizer->check_csrf({
  40         session_id => $x, token => $token,
  41     });
  42
  43 =head1 DESCRIPTION
  44
  45     Designed for providing general tokens.
  46     Created due to the need for a nonblocking call to Bytes::Random::Secure
  47     when generating a CSRF token.
  48
  49 =cut
  50
  51 use Modern::Perl;
  52 use Bytes::Random::Secure ();
  53 use String::Random ();
  54 use WWW::CSRF ();
  55 use Digest::MD5 qw(md5_base64);
  56 use Encode qw( encode );
  57 use Koha::Exceptions::Token;
  58 use base qw(Class::Accessor);
  59 use constant HMAC_SHA1_LENGTH => 20;
  60 use constant CSRF_EXPIRY_HOURS => 8; # 8 hours instead of 7 days..
  61
  62 =head1 METHODS
  63
  64 =head2 new
  65
  66     Create object (via Class::Accessor).
  67
  68 =cut
  69
  70 sub new {
  71     my ( $class ) = @_;
  72     return $class->SUPER::new();
  73 }
  74
  75 =head2 generate
  76
  77     my $token = $tokenizer->generate({ length => 20 });
  78     my $csrf_token = $tokenizer->generate({
  79         type => 'CSRF', id => $id, secret => $secret,
  80     });
  81
  82     Generate several types of tokens. Now includes CSRF.
  83     For non-CSRF tokens an optional pattern parameter overrides length.
  84     Room for future extension.
  85
  86     Pattern parameter could be write down using this subset of regular expressions:
  87     \w    Alphanumeric + "_".
  88     \d    Digits.
  89     \W    Printable characters other than those in \w.
  90     \D    Printable characters other than those in \d.
  91     .     Printable characters.
  92     []    Character classes.
  93     {}    Repetition.
  94     *     Same as {0,}.
  95     ?     Same as {0,1}.
  96     +     Same as {1,}.
  97
  98 =cut
  99
 100 sub generate {
 101     my ( $self, $params ) = @_;
 102     if( $params->{type} && $params->{type} eq 'CSRF' ) {
 103         $self->{lasttoken} = _gen_csrf( $params );
 104     } else {
 105         $self->{lasttoken} = _gen_rand( $params );
 106     }
 107     return $self->{lasttoken};
 108 }
 109
 110 =head2 generate_csrf
 111
 112     Like: generate({ type => 'CSRF', ... })
 113     Note: id defaults to userid from context, secret to database password.
 114     session_id is mandatory; it is combined with id.
 115
 116 =cut
 117
 118 sub generate_csrf {
 119     my ( $self, $params ) = @_;
 120     return if !$params->{session_id};
 121     $params = _add_default_csrf_params( $params );
 122     return $self->generate({ %$params, type => 'CSRF' });
 123 }
 124
 125 =head2 check
 126
 127     my $result = $tokenizer->check({
 128         type => 'CSRF', id => $id, token => $token,
 129     });
 130
 131     Check several types of tokens. Now includes CSRF.
 132     Room for future extension.
 133
 134 =cut
 135
 136 sub check {
 137     my ( $self, $params ) = @_;
 138     if( $params->{type} && $params->{type} eq 'CSRF' ) {
 139         return _chk_csrf( $params );
 140     }
 141     return;
 142 }
 143
 144 =head2 check_csrf
 145
 146     Like: check({ type => 'CSRF', ... })
 147     Note: id defaults to userid from context, secret to database password.
 148     session_id is mandatory; it is combined with id.
 149
 150 =cut
 151
 152 sub check_csrf {
 153     my ( $self, $params ) = @_;
 154     return if !$params->{session_id};
 155     $params = _add_default_csrf_params( $params );
 156     return $self->check({ %$params, type => 'CSRF' });
 157 }
 158
 159 # --- Internal routines ---
 160
 161 sub _add_default_csrf_params {
 162     my ( $params ) = @_;
 163     $params->{session_id} //= '';
 164     if( !$params->{id} ) {
 165         $params->{id} = Encode::encode( 'UTF-8', C4::Context->userenv->{id} . $params->{session_id} );
 166     } else {
 167         $params->{id} .= $params->{session_id};
 168     }
 169     $params->{id} //= Encode::encode( 'UTF-8', C4::Context->userenv->{id} );
 170     my $pw = C4::Context->config('pass');
 171     $params->{secret} //= md5_base64( Encode::encode( 'UTF-8', $pw ) ),
 172     return $params;
 173 }
 174
 175 sub _gen_csrf {
 176
 177 # Since WWW::CSRF::generate_csrf_token does not use the NonBlocking
 178 # parameter of Bytes::Random::Secure, we are passing random bytes from
 179 # a non blocking source to WWW::CSRF via its Random parameter.
 180
 181     my ( $params ) = @_;
 182     return if !$params->{id} || !$params->{secret};
 183
 184
 185     my $randomizer = Bytes::Random::Secure->new( NonBlocking => 1 );
 186         # this is most fundamental: do not use /dev/random since it is
 187         # blocking, but use /dev/urandom !
 188     my $random = $randomizer->bytes( HMAC_SHA1_LENGTH );
 189     my $token = WWW::CSRF::generate_csrf_token(
 190         $params->{id}, $params->{secret}, { Random => $random },
 191     );
 192
 193     return $token;
 194 }
 195
 196 sub _chk_csrf {
 197     my ( $params ) = @_;
 198     return if !$params->{id} || !$params->{secret} || !$params->{token};
 199
 200     my $csrf_status = WWW::CSRF::check_csrf_token(
 201         $params->{id},
 202         $params->{secret},
 203         $params->{token},
 204         { MaxAge => $params->{MaxAge} // ( CSRF_EXPIRY_HOURS * 3600 ) },
 205     );
 206     return $csrf_status == WWW::CSRF::CSRF_OK();
 207 }
 208
 209 sub _gen_rand {
 210     my ( $params ) = @_;
 211     my $length = $params->{length} || 1;
 212     $length = 1 unless $length > 0;
 213     my $pattern = $params->{pattern} // '.{'.$length.'}'; # pattern overrides length parameter
 214
 215     my $token;
 216     eval {
 217         $token = String::Random::random_regex( $pattern );
 218     };
 219     Koha::Exceptions::Token::BadPattern->throw($@) if $@;
 220     return $token;
 221 }
 222
 223 =head1 AUTHOR
 224
 225     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 226
 227 =cut
 228
 229 1;