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