Bug 13321: Add missing Price TT plugin in orderreceive.tt
[koha.git] / Koha / AuthUtils.pm
bloba8b391d0d57cef2f176529dfc3475a521ebf94de
1 package Koha::AuthUtils;
3 # Copyright 2013 Catalyst IT
5 # This file is part of Koha.
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.
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.
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>.
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 /;
26 use base 'Exporter';
28 our @EXPORT_OK = qw(hash_password get_script_name);
30 =head1 NAME
32 Koha::AuthUtils - utility routines for authentication
34 =head1 SYNOPSIS
36 use Koha::AuthUtils qw/hash_password/;
37 my $hash = hash_password($password);
39 =head1 DESCRIPTION
41 This module provides utility functions related to managing
42 user passwords.
44 =head1 FUNCTIONS
46 =head2 hash_password
48 my $hash = Koha::AuthUtils::hash_password($password, $settings);
50 =cut
52 # Using Bcrypt method for hashing. This can be changed to something else in future, if needed.
53 sub hash_password {
54 my $password = shift;
55 $password = Encode::encode( 'UTF-8', $password )
56 if Encode::is_utf8($password);
58 # Generate a salt if one is not passed
59 my $settings = shift;
60 unless( defined $settings ){ # if there are no settings, we need to create a salt and append settings
61 # Set the cost to 8 and append a NULL
62 $settings = '$2a$08$'.en_base64(generate_salt('weak', 16));
64 # Encrypt it
65 return bcrypt($password, $settings);
68 =head2 generate_salt
70 my $salt = Koha::Auth::generate_salt($strength, $length);
72 =over
74 =item strength
76 For general password salting a C<$strength> of C<weak> is recommend,
77 For generating a server-salt a C<$strength> of C<strong> is recommended
79 'strong' uses /dev/random which may block until sufficient entropy is acheived.
80 'weak' uses /dev/urandom and is non-blocking.
82 =item length
84 C<$length> is a positive integer which specifies the desired length of the returned string
86 =back
88 =cut
91 # the implementation of generate_salt is loosely based on Crypt::Random::Provider::File
92 sub generate_salt {
93 # strength is 'strong' or 'weak'
94 # length is number of bytes to read, positive integer
95 my ($strength, $length) = @_;
97 my $source;
99 if( $length < 1 ){
100 die "non-positive strength of '$strength' passed to Koha::AuthUtils::generate_salt\n";
103 if( $strength eq "strong" ){
104 $source = '/dev/random'; # blocking
105 } else {
106 unless( $strength eq 'weak' ){
107 warn "unsuppored strength of '$strength' passed to Koha::AuthUtils::generate_salt, defaulting to 'weak'\n";
109 $source = '/dev/urandom'; # non-blocking
112 sysopen SOURCE, $source, O_RDONLY
113 or die "failed to open source '$source' in Koha::AuthUtils::generate_salt\n";
115 # $bytes is the bytes just read
116 # $string is the concatenation of all the bytes read so far
117 my( $bytes, $string ) = ("", "");
119 # keep reading until we have $length bytes in $strength
120 while( length($string) < $length ){
121 # return the number of bytes read, 0 (EOF), or -1 (ERROR)
122 my $return = sysread SOURCE, $bytes, $length - length($string);
124 # if no bytes were read, keep reading (if using /dev/random it is possible there was insufficient entropy so this may block)
125 next unless $return;
126 if( $return == -1 ){
127 die "error while reading from $source in Koha::AuthUtils::generate_salt\n";
130 $string .= $bytes;
133 close SOURCE;
134 return $string;
137 =head2 get_script_name
139 This returns the correct script name, for use in redirecting back to the correct page after showing
140 the login screen. It depends on details of the package Plack configuration, and should not be used
141 outside this context.
143 =cut
145 sub get_script_name {
146 # This is the method about.pl uses to detect Plack; now that two places use it, it MUST be
147 # right.
148 if ( ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) && $ENV{SCRIPT_NAME} =~ m,^/(intranet|opac)(.*), ) {
149 return '/cgi-bin/koha' . $2;
150 } else {
151 return $ENV{SCRIPT_NAME};
157 __END__
159 =head1 SEE ALSO
161 Crypt::Eksblowfish::Bcrypt(3)
163 =cut