View | Details | Raw Unified | Return to bug 21998
Collapse All | Expand All

(-)a/Koha/Exceptions/Token.pm (+46 lines)
Line 0 Link Here
1
package Koha::Exceptions::Token;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 3 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use Modern::Perl;
19
20
use Exception::Class (
21
    'Koha::Exceptions::Token' => {
22
        description => 'Something went wrong!',
23
    },
24
    'Koha::Exceptions::Token::BadPattern' => {
25
        isa => 'Koha::Exceptions::Token',
26
        description => 'Bad pattern for random token generation'
27
    },
28
);
29
30
=head1 NAME
31
32
Koha::Exceptions::Token - Base class for Token exceptions
33
34
=head1 Exceptions
35
36
=head2 Koha::Exceptions::Token
37
38
Generic Token exception
39
40
=head2 Koha::Exceptions::Token::BadPattern
41
42
Exception to be used when an non-valid pattern is entered for generation random token.
43
44
=cut
45
46
1;
(-)a/Koha/Token.pm (-1 / +20 lines)
Lines 54-59 use String::Random (); Link Here
54
use WWW::CSRF ();
54
use WWW::CSRF ();
55
use Digest::MD5 qw(md5_base64);
55
use Digest::MD5 qw(md5_base64);
56
use Encode qw( encode );
56
use Encode qw( encode );
57
use Koha::Exceptions::Token;
57
use base qw(Class::Accessor);
58
use base qw(Class::Accessor);
58
use constant HMAC_SHA1_LENGTH => 20;
59
use constant HMAC_SHA1_LENGTH => 20;
59
use constant CSRF_EXPIRY_HOURS => 8; # 8 hours instead of 7 days..
60
use constant CSRF_EXPIRY_HOURS => 8; # 8 hours instead of 7 days..
Lines 82-87 sub new { Link Here
82
    For non-CSRF tokens an optional pattern parameter overrides length.
83
    For non-CSRF tokens an optional pattern parameter overrides length.
83
    Room for future extension.
84
    Room for future extension.
84
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
85
=cut
98
=cut
86
99
87
sub generate {
100
sub generate {
Lines 198-204 sub _gen_rand { Link Here
198
    my $length = $params->{length} || 1;
211
    my $length = $params->{length} || 1;
199
    $length = 1 unless $length > 0;
212
    $length = 1 unless $length > 0;
200
    my $pattern = $params->{pattern} // '.{'.$length.'}'; # pattern overrides length parameter
213
    my $pattern = $params->{pattern} // '.{'.$length.'}'; # pattern overrides length parameter
201
    return String::Random::random_regex( $pattern );
214
215
    my $token;
216
    eval {
217
        $token = String::Random::random_regex( $pattern );
218
    };
219
    Koha::Exceptions::Token::BadPattern->throw($@) if $@;
220
    return $token;
202
}
221
}
203
222
204
=head1 AUTHOR
223
=head1 AUTHOR
(-)a/t/Token.t (-2 / +3 lines)
Lines 21-26 Link Here
21
21
22
use Modern::Perl;
22
use Modern::Perl;
23
use Test::More tests => 11;
23
use Test::More tests => 11;
24
use Test::Exception;
24
use Time::HiRes qw|usleep|;
25
use Time::HiRes qw|usleep|;
25
use C4::Context;
26
use C4::Context;
26
use Koha::Token;
27
use Koha::Token;
Lines 91-101 subtest 'Same logged in user with another session (cookie CGISESSID)' => sub { Link Here
91
};
92
};
92
93
93
subtest 'Pattern parameter' => sub {
94
subtest 'Pattern parameter' => sub {
94
    plan tests => 4;
95
    plan tests => 5;
95
    my $id = $tokenizer->generate({ pattern => '\d\d', length => 8 });
96
    my $id = $tokenizer->generate({ pattern => '\d\d', length => 8 });
96
    is( length($id), 2, 'Pattern overrides length' );
97
    is( length($id), 2, 'Pattern overrides length' );
97
    ok( $id =~ /\d{2}/, 'Two digits found' );
98
    ok( $id =~ /\d{2}/, 'Two digits found' );
98
    $id = $tokenizer->generate({ pattern => '[A-Z]{10}' });
99
    $id = $tokenizer->generate({ pattern => '[A-Z]{10}' });
99
    is( length($id), 10, 'Check length again' );
100
    is( length($id), 10, 'Check length again' );
100
    ok( $id !~ /[^A-Z]/, 'Only uppercase letters' );
101
    ok( $id !~ /[^A-Z]/, 'Only uppercase letters' );
102
    throws_ok( sub { $tokenizer->generate({ pattern => 'abc[', }) }, 'Koha::Exceptions::Token::BadPattern', 'Exception should be thrown when wrong pattern is used');
101
};
103
};
102
- 

Return to bug 21998