Bug 21998: Throw exception on bad pattern

Signed-off-by: Josef Moravec <josef.moravec@gmail.com>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Nick Clemens <nick@bywatersolutions.com>

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;

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

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');
 };