Koha/AuthUtils.pm

   1 package Koha::AuthUtils;
   2
   3 # Copyright 2013 Catalyst IT
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  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;
  27
  28 use C4::Context;
  29
  30 use base 'Exporter';
  31
  32 our @EXPORT_OK   = qw(hash_password get_script_name);
  33
  34 =head1 NAME
  35
  36 Koha::AuthUtils - utility routines for authentication
  37
  38 =head1 SYNOPSIS
  39
  40     use Koha::AuthUtils qw/hash_password/;
  41     my $hash = hash_password($password);
  42
  43 =head1 DESCRIPTION
  44
  45 This module provides utility functions related to managing
  46 user passwords.
  47
  48 =head1 FUNCTIONS
  49
  50 =head2 hash_password
  51
  52     my $hash = Koha::AuthUtils::hash_password($password, $settings);
  53
  54 Hash I<$password> using Bcrypt. Accepts an extra I<$settings> parameter for salt.
  55 If I<$settings> is not passed, a new salt is generated.
  56
  57 WARNING: If this method implementation is changed in the future, as of
  58 bug 28772 there's at least one DBRev that uses this code and should
  59 be taken care of.
  60
  61 =cut
  62
  63 sub hash_password {
  64     my $password = shift;
  65     $password = Encode::encode( 'UTF-8', $password )
  66       if Encode::is_utf8($password);
  67
  68     # Generate a salt if one is not passed
  69     my $settings = shift;
  70     unless( defined $settings ){ # if there are no settings, we need to create a salt and append settings
  71     # Set the cost to 8 and append a NULL
  72         $settings = '$2a$08$'.en_base64(generate_salt('weak', 16));
  73     }
  74     # Hash it
  75     return bcrypt($password, $settings);
  76 }
  77
  78 =head2 generate_salt
  79
  80     my $salt = Koha::Auth::generate_salt($strength, $length);
  81
  82 =over
  83
  84 =item strength
  85
  86 For general password salting a C<$strength> of C<weak> is recommend,
  87 For generating a server-salt a C<$strength> of C<strong> is recommended
  88
  89 'strong' uses /dev/random which may block until sufficient entropy is achieved.
  90 'weak' uses /dev/urandom and is non-blocking.
  91
  92 =item length
  93
  94 C<$length> is a positive integer which specifies the desired length of the returned string
  95
  96 =back
  97
  98 =cut
  99
 100
 101 # the implementation of generate_salt is loosely based on Crypt::Random::Provider::File
 102 sub generate_salt {
 103     # strength is 'strong' or 'weak'
 104     # length is number of bytes to read, positive integer
 105     my ($strength, $length) = @_;
 106
 107     my $source;
 108
 109     if( $length < 1 ){
 110         die "non-positive strength of '$strength' passed to Koha::AuthUtils::generate_salt\n";
 111     }
 112
 113     if( $strength eq "strong" ){
 114         $source = '/dev/random'; # blocking
 115     } else {
 116         unless( $strength eq 'weak' ){
 117             warn "unsuppored strength of '$strength' passed to Koha::AuthUtils::generate_salt, defaulting to 'weak'\n";
 118         }
 119         $source = '/dev/urandom'; # non-blocking
 120     }
 121
 122     sysopen SOURCE, $source, O_RDONLY
 123         or die "failed to open source '$source' in Koha::AuthUtils::generate_salt\n";
 124
 125     # $bytes is the bytes just read
 126     # $string is the concatenation of all the bytes read so far
 127     my( $bytes, $string ) = ("", "");
 128
 129     # keep reading until we have $length bytes in $strength
 130     while( length($string) < $length ){
 131         # return the number of bytes read, 0 (EOF), or -1 (ERROR)
 132         my $return = sysread SOURCE, $bytes, $length - length($string);
 133
 134         # if no bytes were read, keep reading (if using /dev/random it is possible there was insufficient entropy so this may block)
 135         next unless $return;
 136         if( $return == -1 ){
 137             die "error while reading from $source in Koha::AuthUtils::generate_salt\n";
 138         }
 139
 140         $string .= $bytes;
 141     }
 142
 143     close SOURCE;
 144     return $string;
 145 }
 146
 147 =head2 is_password_valid
 148
 149 my ( $is_valid, $error ) = is_password_valid( $password, $category );
 150
 151 return $is_valid == 1 if the password match category's minimum password length and strength if provided, or general minPasswordLength and RequireStrongPassword conditions
 152 otherwise return $is_valid == 0 and $error will contain the error ('too_short' or 'too_weak')
 153
 154 =cut
 155
 156 sub is_password_valid {
 157     my ($password, $category) = @_;
 158     if(!$category) {
 159         Koha::Exceptions::Password::NoCategoryProvided->throw();
 160     }
 161     my $minPasswordLength = $category->effective_min_password_length;
 162     $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
 163     if ( length($password) < $minPasswordLength ) {
 164         return ( 0, 'too_short' );
 165     }
 166     elsif ( $category->effective_require_strong_password ) {
 167         return ( 0, 'too_weak' )
 168           if $password !~ m|(?=.*\d)(?=.*[a-z])(?=.*[A-Z]).{$minPasswordLength,}|;
 169     }
 170     return ( 0, 'has_whitespaces' ) if $password =~ m[^\s|\s$];
 171     return ( 1, undef );
 172 }
 173
 174 =head2 generate_password
 175
 176 my password = generate_password($category);
 177
 178 Generate a password according to category's minimum password length and strength if provided, or to the minPasswordLength and RequireStrongPassword system preferences.
 179
 180 =cut
 181
 182 sub generate_password {
 183     my ($category) = @_;
 184     if(!$category) {
 185         Koha::Exceptions::Password::NoCategoryProvided->throw();
 186     }
 187     my $minPasswordLength = $category->effective_min_password_length;
 188     $minPasswordLength = 8 if not $minPasswordLength or $minPasswordLength < 8;
 189
 190     my ( $password, $is_valid );
 191     do {
 192         $password = random_string('.' x $minPasswordLength );
 193         ( $is_valid, undef ) = is_password_valid( $password, $category );
 194     } while not $is_valid;
 195     return $password;
 196 }
 197
 198
 199 =head2 get_script_name
 200
 201 This returns the correct script name, for use in redirecting back to the correct page after showing
 202 the login screen. It depends on details of the package Plack configuration, and should not be used
 203 outside this context.
 204
 205 =cut
 206
 207 sub get_script_name {
 208     # This is the method about.pl uses to detect Plack; now that two places use it, it MUST be
 209     # right.
 210     if ( ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) && $ENV{SCRIPT_NAME} =~ m,^/(intranet|opac)(.*), ) {
 211         return '/cgi-bin/koha' . $2;
 212     } else {
 213         return $ENV{SCRIPT_NAME};
 214     }
 215 }
 216
 217 1;
 218
 219 __END__
 220
 221 =head1 SEE ALSO
 222
 223 Crypt::Eksblowfish::Bcrypt(3)
 224
 225 =cut