Bug 20256: DBIC schema
[koha.git] / Koha / Token.pm
1 package Koha::Token;
2
3 # Created as wrapper for CSRF and JWT 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 Mojo::JWT;
56 use Digest::MD5 qw( md5_base64 );
57 use Encode;
58 use C4::Context;
59 use Koha::Exceptions::Token;
60 use base qw(Class::Accessor);
61 use constant HMAC_SHA1_LENGTH => 20;
62 use constant CSRF_EXPIRY_HOURS => 8; # 8 hours instead of 7 days..
63 use constant DEFA_SESSION_ID => 0;
64 use constant DEFA_SESSION_USERID => 'anonymous';
65
66 =head1 METHODS
67
68 =head2 new
69
70     Create object (via Class::Accessor).
71
72 =cut
73
74 sub new {
75     my ( $class ) = @_;
76     return $class->SUPER::new();
77 }
78
79 =head2 generate
80
81     my $token = $tokenizer->generate({ length => 20 });
82     my $csrf_token = $tokenizer->generate({
83         type => 'CSRF', id => $id, secret => $secret,
84     });
85     my $jwt = $tokenizer->generate({
86         type => 'JWT, id => $id, secret => $secret,
87     });
88
89     Generate several types of tokens. Now includes CSRF.
90     For non-CSRF tokens an optional pattern parameter overrides length.
91     Room for future extension.
92
93     Pattern parameter could be write down using this subset of regular expressions:
94     \w    Alphanumeric + "_".
95     \d    Digits.
96     \W    Printable characters other than those in \w.
97     \D    Printable characters other than those in \d.
98     .     Printable characters.
99     []    Character classes.
100     {}    Repetition.
101     *     Same as {0,}.
102     ?     Same as {0,1}.
103     +     Same as {1,}.
104
105 =cut
106
107 sub generate {
108     my ( $self, $params ) = @_;
109     if( $params->{type} && $params->{type} eq 'CSRF' ) {
110         $self->{lasttoken} = _gen_csrf( $params );
111     } elsif( $params->{type} && $params->{type} eq 'JWT' ) {
112         $self->{lasttoken} = _gen_jwt( $params );
113     } else {
114         $self->{lasttoken} = _gen_rand( $params );
115     }
116     return $self->{lasttoken};
117 }
118
119 =head2 generate_csrf
120
121     Like: generate({ type => 'CSRF', ... })
122     Note: id defaults to userid from context, secret to database password.
123     session_id is mandatory; it is combined with id.
124
125 =cut
126
127 sub generate_csrf {
128     my ( $self, $params ) = @_;
129     return if !$params->{session_id};
130     $params = _add_default_csrf_params( $params );
131     return $self->generate({ %$params, type => 'CSRF' });
132 }
133
134 =head2 generate_jwt
135
136     Like: generate({ type => 'JWT', ... })
137     Note that JWT is designed to encode a structure but here we are actually only allowing a value
138     that will be store in the key 'id'.
139
140 =cut
141
142 sub generate_jwt {
143     my ( $self, $params ) = @_;
144     return if !$params->{id};
145     $params = _add_default_jwt_params( $params );
146     return $self->generate({ %$params, type => 'JWT' });
147 }
148
149 =head2 check
150
151     my $result = $tokenizer->check({
152         type => 'CSRF', id => $id, token => $token,
153     });
154
155     Check several types of tokens. Now includes CSRF.
156     Room for future extension.
157
158 =cut
159
160 sub check {
161     my ( $self, $params ) = @_;
162     if( $params->{type} && $params->{type} eq 'CSRF' ) {
163         return _chk_csrf( $params );
164     }
165     elsif( $params->{type} && $params->{type} eq 'JWT' ) {
166         return _chk_jwt( $params );
167     }
168     return;
169 }
170
171 =head2 check_csrf
172
173     Like: check({ type => 'CSRF', ... })
174     Note: id defaults to userid from context, secret to database password.
175     session_id is mandatory; it is combined with id.
176
177 =cut
178
179 sub check_csrf {
180     my ( $self, $params ) = @_;
181     return if !$params->{session_id};
182     $params = _add_default_csrf_params( $params );
183     return $self->check({ %$params, type => 'CSRF' });
184 }
185
186 =head2 check_jwt
187
188     Like: check({ type => 'JWT', id => $id, token => $token })
189
190     Will return true if the token contains the passed id
191
192 =cut
193
194 sub check_jwt {
195     my ( $self, $params ) = @_;
196     $params = _add_default_jwt_params( $params );
197     return $self->check({ %$params, type => 'JWT' });
198 }
199
200 =head2 decode_jwt
201
202     $tokenizer->decode_jwt({ type => 'JWT', token => $token })
203
204     Will return the value of the id stored in the token.
205
206 =cut
207 sub decode_jwt {
208     my ( $self, $params ) = @_;
209     $params = _add_default_jwt_params( $params );
210     return _decode_jwt( $params );
211 }
212
213 # --- Internal routines ---
214
215 sub _add_default_csrf_params {
216     my ( $params ) = @_;
217     $params->{session_id} //= DEFA_SESSION_ID;
218     my $userenv = C4::Context->userenv // { id => DEFA_SESSION_USERID };
219     $params->{id} //= Encode::encode( 'UTF-8', $userenv->{id} );
220     $params->{id} .= '_' . $params->{session_id};
221
222     my $pw = C4::Context->config('pass');
223     $params->{secret} //= md5_base64( Encode::encode( 'UTF-8', $pw ) ),
224     return $params;
225 }
226
227 sub _gen_csrf {
228
229 # Since WWW::CSRF::generate_csrf_token does not use the NonBlocking
230 # parameter of Bytes::Random::Secure, we are passing random bytes from
231 # a non blocking source to WWW::CSRF via its Random parameter.
232
233     my ( $params ) = @_;
234     return if !$params->{id} || !$params->{secret};
235
236
237     my $randomizer = Bytes::Random::Secure->new( NonBlocking => 1 );
238         # this is most fundamental: do not use /dev/random since it is
239         # blocking, but use /dev/urandom !
240     my $random = $randomizer->bytes( HMAC_SHA1_LENGTH );
241     my $token = WWW::CSRF::generate_csrf_token(
242         $params->{id}, $params->{secret}, { Random => $random },
243     );
244
245     return $token;
246 }
247
248 sub _chk_csrf {
249     my ( $params ) = @_;
250     return if !$params->{id} || !$params->{secret} || !$params->{token};
251
252     my $csrf_status = WWW::CSRF::check_csrf_token(
253         $params->{id},
254         $params->{secret},
255         $params->{token},
256         { MaxAge => $params->{MaxAge} // ( CSRF_EXPIRY_HOURS * 3600 ) },
257     );
258     return $csrf_status == WWW::CSRF::CSRF_OK();
259 }
260
261 sub _gen_rand {
262     my ( $params ) = @_;
263     my $length = $params->{length} || 1;
264     $length = 1 unless $length > 0;
265     my $pattern = $params->{pattern} // '.{'.$length.'}'; # pattern overrides length parameter
266
267     my $token;
268     eval {
269         $token = String::Random::random_regex( $pattern );
270     };
271     Koha::Exceptions::Token::BadPattern->throw($@) if $@;
272     return $token;
273 }
274
275 sub _add_default_jwt_params {
276     my ( $params ) = @_;
277     my $pw = C4::Context->config('pass');
278     $params->{secret} //= md5_base64( Encode::encode( 'UTF-8', $pw ) ),
279     return $params;
280 }
281
282 sub _gen_jwt {
283     my ( $params ) = @_;
284     return if !$params->{id} || !$params->{secret};
285
286     return Mojo::JWT->new(
287         claims => { id => $params->{id} },
288         secret => $params->{secret}
289     )->encode;
290 }
291
292 sub _chk_jwt {
293     my ( $params ) = @_;
294     return if !$params->{id} || !$params->{secret} || !$params->{token};
295
296     my $claims = Mojo::JWT->new(secret => $params->{secret})->decode($params->{token});
297
298     return 1 if exists $claims->{id} && $claims->{id} == $params->{id};
299 }
300
301 sub _decode_jwt {
302     my ( $params ) = @_;
303     return if !$params->{token} || !$params->{secret};
304
305     my $claims = Mojo::JWT->new(secret => $params->{secret})->decode($params->{token});
306
307     return $claims->{id};
308 }
309
310 =head1 AUTHOR
311
312     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
313
314 =cut
315
316 1;