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