--- /dev/null
+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;
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..
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 {
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
use Modern::Perl;
use Test::More tests => 11;
+use Test::Exception;
use Time::HiRes qw|usleep|;
use C4::Context;
use Koha::Token;
};
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');
};