Bug 18958: Make hold_fill_targets specific to reserves
[koha.git] / Koha / Token.pm
bloba3f226d74c5b0fb1094457f6f9c37f276617598f
1 package Koha::Token;
3 # Created as wrapper for CSRF tokens, but designed for more general use
5 # Copyright 2016 Rijksmuseum
7 # This file is part of Koha.
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.
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.
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>.
22 =head1 NAME
24 Koha::Token - Tokenizer
26 =head1 SYNOPSIS
28 use Koha::Token;
29 my $tokenizer = Koha::Token->new;
30 my $token = $tokenizer->generate({ length => 20 });
32 # safely generate a CSRF token (nonblocking)
33 my $csrf_token = $tokenizer->generate({
34 type => 'CSRF', id => $id, secret => $secret,
35 });
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 });
43 =head1 DESCRIPTION
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.
49 =cut
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..
62 =head1 METHODS
64 =head2 new
66 Create object (via Class::Accessor).
68 =cut
70 sub new {
71 my ( $class ) = @_;
72 return $class->SUPER::new();
75 =head2 generate
77 my $token = $tokenizer->generate({ length => 20 });
78 my $csrf_token = $tokenizer->generate({
79 type => 'CSRF', id => $id, secret => $secret,
80 });
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.
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,}.
98 =cut
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 );
107 return $self->{lasttoken};
110 =head2 generate_csrf
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.
116 =cut
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' });
125 =head2 check
127 my $result = $tokenizer->check({
128 type => 'CSRF', id => $id, token => $token,
131 Check several types of tokens. Now includes CSRF.
132 Room for future extension.
134 =cut
136 sub check {
137 my ( $self, $params ) = @_;
138 if( $params->{type} && $params->{type} eq 'CSRF' ) {
139 return _chk_csrf( $params );
141 return;
144 =head2 check_csrf
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.
150 =cut
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' });
159 # --- Internal routines ---
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};
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;
175 sub _gen_csrf {
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.
181 my ( $params ) = @_;
182 return if !$params->{id} || !$params->{secret};
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 },
193 return $token;
196 sub _chk_csrf {
197 my ( $params ) = @_;
198 return if !$params->{id} || !$params->{secret} || !$params->{token};
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 ) },
206 return $csrf_status == WWW::CSRF::CSRF_OK();
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
215 my $token;
216 eval {
217 $token = String::Random::random_regex( $pattern );
219 Koha::Exceptions::Token::BadPattern->throw($@) if $@;
220 return $token;
223 =head1 AUTHOR
225 Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
227 =cut