Attachment #86666 for bug #21998

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




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

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

Return to bug 21998

Lines 54-59 use String::Random (); Link Here

(-)a/Koha/Token.pm (-1 / +20 lines)
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

Line 0 Link Here

(-)a/Koha/Exceptions/Token.pm (+46 lines)
	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;

Lines 21-26 Link Here

(-)a/t/Token.t (-2 / +3 lines)
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	-