koha-dev.rot13.org Git - srvgit/blob - 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     my $source_fh;
 126     sysopen $source_fh, $source, O_RDONLY
 127         or die "failed to open source '$source' in Koha::AuthUtils::generate_salt\n";
 128
 129     # $bytes is the bytes just read
 130     # $string is the concatenation of all the bytes read so far
 131     my( $bytes, $string ) = ("", "");
 132
 133     # keep reading until we have $length bytes in $strength
 134     while( length($string) < $length ){
 135         # return the number of bytes read, 0 (EOF), or -1 (ERROR)
 136         my $return = sysread $source_fh, $bytes, $length - length($string);
 137
 138         # if no bytes were read, keep reading (if using /dev/random it is possible there was insufficient entropy so this may block)
 139         next unless $return;
 140         if( $return == -1 ){
 141             die "error while reading from $source in Koha::AuthUtils::generate_salt\n";
 142         }
 143
 144         $string .= $bytes;
 145     }
 146
 147     close $source_fh;
 148     return $string;
 149 }
 150
 151 =head2 is_password_valid
 152
 153 my ( $is_valid, $error ) = is_password_valid( $password, $category );
 154
 155 return $is_valid == 1 if the password match category's minimum password length and strength if provided, or general minPasswordLength and RequireStrongPassword conditions
 156 otherwise return $is_valid == 0 and $error will contain the error ('too_short' or 'too_weak')
 157
 158 =cut
 159
 160 sub is_password_valid {
 161     my ($password, $category) = @_;
 162     if(!$category) {
 163         Koha::Exceptions::Password::NoCategoryProvided->throw();
 164     }
 165     my $minPasswordLength = $category->effective_min_password_length;
 166     $minPasswordLength = 3 if not $minPasswordLength or $minPasswordLength < 3;
 167     if ( length($password) < $minPasswordLength ) {
 168         return ( 0, 'too_short' );
 169     }
 170     elsif ( $category->effective_require_strong_password ) {
 171         return ( 0, 'too_weak' )
 172           if $password !~ m|(?=.*\d)(?=.*[a-z])(?=.*[A-Z]).{$minPasswordLength,}|;
 173     }
 174     return ( 0, 'has_whitespaces' ) if $password =~ m[^\s|\s$];
 175     return ( 1, undef );
 176 }
 177
 178 =head2 generate_password
 179
 180 my password = generate_password($category);
 181
 182 Generate a password according to category's minimum password length and strength if provided, or to the minPasswordLength and RequireStrongPassword system preferences.
 183
 184 =cut
 185
 186 sub generate_password {
 187     my ($category) = @_;
 188     if(!$category) {
 189         Koha::Exceptions::Password::NoCategoryProvided->throw();
 190     }
 191     my $minPasswordLength = $category->effective_min_password_length;
 192     $minPasswordLength = 8 if not $minPasswordLength or $minPasswordLength < 8;
 193
 194     my ( $password, $is_valid );
 195     do {
 196         $password = random_string('.' x $minPasswordLength );
 197         ( $is_valid, undef ) = is_password_valid( $password, $category );
 198     } while not $is_valid;
 199     return $password;
 200 }
 201
 202
 203 =head2 get_script_name
 204
 205 This returns the correct script name, for use in redirecting back to the correct page after showing
 206 the login screen. It depends on details of the package Plack configuration, and should not be used
 207 outside this context.
 208
 209 =cut
 210
 211 sub get_script_name {
 212     if ( ( C4::Context->psgi_env ) && $ENV{SCRIPT_NAME} && $ENV{SCRIPT_NAME} =~ m,^/(intranet|opac)(.*), ) {
 213         return '/cgi-bin/koha' . $2;
 214     } else {
 215         return $ENV{SCRIPT_NAME};
 216     }
 217 }
 218
 219 1;
 220
 221 __END__
 222
 223 =head1 SEE ALSO
 224
 225 Crypt::Eksblowfish::Bcrypt(3)
 226
 227 =cut