@@ -, +, @@ --- Koha/Exceptions/Token.pm | 46 ++++++++++++++++++++++++++++++++++++++++ Koha/Token.pm | 21 +++++++++++++++++- t/Token.t | 4 +++- 3 files changed, 69 insertions(+), 2 deletions(-) create mode 100644 Koha/Exceptions/Token.pm --- a/Koha/Exceptions/Token.pm +++ a/Koha/Exceptions/Token.pm @@ -0,0 +1,46 @@ +package Koha::Exceptions::Token; + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use Exception::Class ( + 'Koha::Exceptions::Token' => { + description => 'Something went wrong!', + }, + 'Koha::Exceptions::Token::BadPattern' => { + isa => 'Koha::Exceptions::Token', + description => 'Bad pattern for random token generation' + }, +); + +=head1 NAME + +Koha::Exceptions::Token - Base class for Token exceptions + +=head1 Exceptions + +=head2 Koha::Exceptions::Token + +Generic Token exception + +=head2 Koha::Exceptions::Token::BadPattern + +Exception to be used when an non-valid pattern is entered for generation random token. + +=cut + +1; --- a/Koha/Token.pm +++ a/Koha/Token.pm @@ -54,6 +54,7 @@ use String::Random (); use WWW::CSRF (); use Digest::MD5 qw(md5_base64); use Encode qw( encode ); +use Koha::Exceptions::Token; use base qw(Class::Accessor); use constant HMAC_SHA1_LENGTH => 20; use constant CSRF_EXPIRY_HOURS => 8; # 8 hours instead of 7 days.. @@ -82,6 +83,18 @@ sub new { For non-CSRF tokens an optional pattern parameter overrides length. Room for future extension. + Pattern parameter could be write down using this subset of regular expressions: + \w Alphanumeric + "_". + \d Digits. + \W Printable characters other than those in \w. + \D Printable characters other than those in \d. + . Printable characters. + [] Character classes. + {} Repetition. + * Same as {0,}. + ? Same as {0,1}. + + Same as {1,}. + =cut sub generate { @@ -198,7 +211,13 @@ sub _gen_rand { my $length = $params->{length} || 1; $length = 1 unless $length > 0; my $pattern = $params->{pattern} // '.{'.$length.'}'; # pattern overrides length parameter - return String::Random::random_regex( $pattern ); + + my $token; + eval { + $token = String::Random::random_regex( $pattern ); + }; + Koha::Exceptions::Token::BadPattern->throw($@) if $@; + return $token; } =head1 AUTHOR --- a/t/Token.t +++ a/t/Token.t @@ -21,6 +21,7 @@ use Modern::Perl; use Test::More tests => 11; +use Test::Exception; use Time::HiRes qw|usleep|; use C4::Context; use Koha::Token; @@ -91,11 +92,12 @@ subtest 'Same logged in user with another session (cookie CGISESSID)' => sub { }; subtest 'Pattern parameter' => sub { - plan tests => 4; + plan tests => 5; my $id = $tokenizer->generate({ pattern => '\d\d', length => 8 }); is( length($id), 2, 'Pattern overrides length' ); ok( $id =~ /\d{2}/, 'Two digits found' ); $id = $tokenizer->generate({ pattern => '[A-Z]{10}' }); is( length($id), 10, 'Check length again' ); ok( $id !~ /[^A-Z]/, 'Only uppercase letters' ); + throws_ok( sub { $tokenizer->generate({ pattern => 'abc[', }) }, 'Koha::Exceptions::Token::BadPattern', 'Exception should be thrown when wrong pattern is used'); }; --