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 under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 3 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along
  19 # with Koha; if not, write to the Free Software Foundation, Inc.,
  20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  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     # or check a CSRF token
  38     my $result = $tokenizer->check_csrf({
  39         id => $id, secret => $secret, token => $token,
  40     });
  41
  42 =head1 DESCRIPTION
  43
  44     Designed for providing general tokens.
  45     Created due to the need for a nonblocking call to Bytes::Random::Secure
  46     when generating a CSRF token.
  47
  48 =cut
  49
  50 use Modern::Perl;
  51 use Bytes::Random::Secure ();
  52 use String::Random ();
  53 use WWW::CSRF ();
  54 use Digest::MD5 qw(md5_base64);
  55 use Encode qw( encode );
  56 use base qw(Class::Accessor);
  57 use constant HMAC_SHA1_LENGTH => 20;
  58 use constant CSRF_EXPIRY_HOURS => 8; # 8 hours instead of 7 days..
  59
  60 =head1 METHODS
  61
  62 =head2 new
  63
  64     Create object (via Class::Accessor).
  65
  66 =cut
  67
  68 sub new {
  69     my ( $class ) = @_;
  70     return $class->SUPER::new();
  71 }
  72
  73 =head2 generate
  74
  75     my $token = $tokenizer->generate({ length => 20 });
  76     my $csrf_token = $tokenizer->generate({
  77         type => 'CSRF', id => $id,
  78     });
  79
  80     Generate several types of tokens. Now includes CSRF.
  81     Room for future extension.
  82
  83 =cut
  84
  85 sub generate {
  86     my ( $self, $params ) = @_;
  87     if( $params->{type} && $params->{type} eq 'CSRF' ) {
  88         $self->{lasttoken} = _gen_csrf( {
  89             id     => Encode::encode( 'UTF-8', C4::Context->userenv->{id} . $params->{id} ),
  90             secret => md5_base64( Encode::encode( 'UTF-8', C4::Context->config('pass') ) ),
  91         });
  92     } else {
  93         $self->{lasttoken} = _gen_rand( $params );
  94     }
  95     return $self->{lasttoken};
  96 }
  97
  98 =head2 generate_csrf
  99
 100     Shortcut for: generate({ type => 'CSRF', ... })
 101
 102 =cut
 103
 104 sub generate_csrf {
 105     my ( $self, $params ) = @_;
 106     return unless $params->{id};
 107     return $self->generate({ %$params, type => 'CSRF' });
 108 }
 109
 110 =head2 check
 111
 112     my $result = $tokenizer->check({
 113         type => 'CSRF', id => $id, token => $token,
 114     });
 115
 116     Check several types of tokens. Now includes CSRF.
 117     Room for future extension.
 118
 119 =cut
 120
 121 sub check {
 122     my ( $self, $params ) = @_;
 123     if( $params->{type} && $params->{type} eq 'CSRF' ) {
 124         return _chk_csrf( $params );
 125     }
 126     return;
 127 }
 128
 129 =head2 check_csrf
 130
 131     Shortcut for: check({ type => 'CSRF', ... })
 132
 133 =cut
 134
 135 sub check_csrf {
 136     my ( $self, $params ) = @_;
 137     return $self->check({ %$params, type => 'CSRF' });
 138 }
 139
 140 # --- Internal routines ---
 141
 142 sub _gen_csrf {
 143
 144 # Since WWW::CSRF::generate_csrf_token does not use the NonBlocking
 145 # parameter of Bytes::Random::Secure, we are passing random bytes from
 146 # a non blocking source to WWW::CSRF via its Random parameter.
 147
 148     my ( $params ) = @_;
 149     return if !$params->{id} || !$params->{secret};
 150
 151
 152     my $randomizer = Bytes::Random::Secure->new( NonBlocking => 1 );
 153         # this is most fundamental: do not use /dev/random since it is
 154         # blocking, but use /dev/urandom !
 155     my $random = $randomizer->bytes( HMAC_SHA1_LENGTH );
 156     my $token = WWW::CSRF::generate_csrf_token(
 157         $params->{id}, $params->{secret}, { Random => $random },
 158     );
 159
 160     return $token;
 161 }
 162
 163 sub _chk_csrf {
 164     my ( $params ) = @_;
 165     return if !$params->{id} || !$params->{token};
 166
 167     my $id = Encode::encode( 'UTF-8', C4::Context->userenv->{id} . $params->{id} );
 168     my $secret = md5_base64( Encode::encode( 'UTF-8', C4::Context->config('pass') ) );
 169     my $csrf_status = WWW::CSRF::check_csrf_token(
 170         $id, $secret, $params->{token},
 171         { MaxAge => $params->{MaxAge} // ( CSRF_EXPIRY_HOURS * 3600 ) },
 172     );
 173     return $csrf_status == WWW::CSRF::CSRF_OK();
 174 }
 175
 176 sub _gen_rand {
 177     my ( $params ) = @_;
 178     my $length = $params->{length} || 1;
 179     $length = 1 unless $length > 0;
 180
 181     return String::Random::random_string( '.' x $length );
 182 }
 183
 184 =head1 AUTHOR
 185
 186     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 187
 188 =cut
 189
 190 1;