Bug 23091: DBRev 20.06.00.062
[koha.git] / Koha / AuthUtils.pm
blob3bf28ef73ad5a913a2537675d74167bb4e15bc13
1 package Koha::AuthUtils;
3 # Copyright 2013 Catalyst IT
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use Modern::Perl;
21 use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64);
22 use Encode qw( encode is_utf8 );
23 use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt
24 use List::MoreUtils qw/ any /;
25 use String::Random qw( random_string );
26 use Koha::Exceptions::Password;
28 use C4::Context;
30 use base 'Exporter';
32 our @EXPORT_OK = qw(hash_password get_script_name);
34 =head1 NAME
36 Koha::AuthUtils - utility routines for authentication
38 =head1 SYNOPSIS
40 use Koha::AuthUtils qw/hash_password/;
41 my $hash = hash_password($password);
43 =head1 DESCRIPTION
45 This module provides utility functions related to managing
46 user passwords.
48 =head1 FUNCTIONS
50 =head2 hash_password
52 my $hash = Koha::AuthUtils::hash_password($password, $settings);
54 =cut
56 # Using Bcrypt method for hashing. This can be changed to something else in future, if needed.
57 sub hash_password {
58 my $password = shift;
59 $password = Encode::encode( 'UTF-8', $password )
60 if Encode::is_utf8($password);
62 # Generate a salt if one is not passed
63 my $settings = shift;
64 unless( defined $settings ){ # if there are no settings, we need to create a salt and append settings
65 # Set the cost to 8 and append a NULL
66 $settings = '$2a$08$'.en_base64(generate_salt('weak', 16));
68 # Hash it
69 return bcrypt($password, $settings);
72 =head2 generate_salt
74 my $salt = Koha::Auth::generate_salt($strength, $length);
76 =over
78 =item strength
80 For general password salting a C<$strength> of C<weak> is recommend,
81 For generating a server-salt a C<$strength> of C<strong> is recommended
83 'strong' uses /dev/random which may block until sufficient entropy is achieved.
84 'weak' uses /dev/urandom and is non-blocking.
86 =item length
88 C<$length> is a positive integer which specifies the desired length of the returned string
90 =back
92 =cut
95 # the implementation of generate_salt is loosely based on Crypt::Random::Provider::File
96 sub generate_salt {
97 # strength is 'strong' or 'weak'
98 # length is number of bytes to read, positive integer
99 my ($strength, $length) = @_;
101 my $source;
103 if( $length < 1 ){
104 die "non-positive strength of '$strength' passed to Koha::AuthUtils::generate_salt\n";
107 if( $strength eq "strong" ){
108 $source = '/dev/random'; # blocking
109 } else {
110 unless( $strength eq 'weak' ){
111 warn "unsuppored strength of '$strength' passed to Koha::AuthUtils::generate_salt, defaulting to 'weak'\n";
113 $source = '/dev/urandom'; # non-blocking
116 sysopen SOURCE, $source, O_RDONLY
117 or die "failed to open source '$source' in Koha::AuthUtils::generate_salt\n";
119 # $bytes is the bytes just read
120 # $string is the concatenation of all the bytes read so far
121 my( $bytes, $string ) = ("", "");
123 # keep reading until we have $length bytes in $strength
124 while( length($string) < $length ){
125 # return the number of bytes read, 0 (EOF), or -1 (ERROR)
126 my $return = sysread SOURCE, $bytes, $length - length($string);
128 # if no bytes were read, keep reading (if using /dev/random it is possible there was insufficient entropy so this may block)
129 next unless $return;
130 if( $return == -1 ){
131 die "error while reading from $source in Koha::AuthUtils::generate_salt\n";
134 $string .= $bytes;
137 close SOURCE;
138 return $string;
141 =head2 is_password_valid
143 my ( $is_valid, $error ) = is_password_valid( $password, $category );
145 return $is_valid == 1 if the password match category's minimum password length and strength if provided, or general minPasswordLength and RequireStrongPassword conditions
146 otherwise return $is_valid == 0 and $error will contain the error ('too_short' or 'too_weak')
148 =cut
150 sub is_password_valid {
151 my ($password, $category) = @_;
152 if(!$category) {
153 Koha::Exceptions::Password::NoCategoryProvided->throw();
155 my $minPasswordLength = $category->effective_min_password_length;
156 $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
157 if ( length($password) < $minPasswordLength ) {
158 return ( 0, 'too_short' );
160 elsif ( $category->effective_require_strong_password ) {
161 return ( 0, 'too_weak' )
162 if $password !~ m|(?=.*\d)(?=.*[a-z])(?=.*[A-Z]).{$minPasswordLength,}|;
164 return ( 0, 'has_whitespaces' ) if $password =~ m[^\s|\s$];
165 return ( 1, undef );
168 =head2 generate_password
170 my password = generate_password($category);
172 Generate a password according to category's minimum password length and strength if provided, or to the minPasswordLength and RequireStrongPassword system preferences.
174 =cut
176 sub generate_password {
177 my ($category) = @_;
178 if(!$category) {
179 Koha::Exceptions::Password::NoCategoryProvided->throw();
181 my $minPasswordLength = $category->effective_min_password_length;
182 $minPasswordLength = 8 if not $minPasswordLength or $minPasswordLength < 8;
184 my ( $password, $is_valid );
185 do {
186 $password = random_string('.' x $minPasswordLength );
187 ( $is_valid, undef ) = is_password_valid( $password, $category );
188 } while not $is_valid;
189 return $password;
193 =head2 get_script_name
195 This returns the correct script name, for use in redirecting back to the correct page after showing
196 the login screen. It depends on details of the package Plack configuration, and should not be used
197 outside this context.
199 =cut
201 sub get_script_name {
202 # This is the method about.pl uses to detect Plack; now that two places use it, it MUST be
203 # right.
204 if ( ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) && $ENV{SCRIPT_NAME} =~ m,^/(intranet|opac)(.*), ) {
205 return '/cgi-bin/koha' . $2;
206 } else {
207 return $ENV{SCRIPT_NAME};
213 __END__
215 =head1 SEE ALSO
217 Crypt::Eksblowfish::Bcrypt(3)
219 =cut