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