C4/Auth_with_ldap.pm

   1 # -*- tab-width: 8 -*-
   2 # NOTE: This file uses 8-character tabs; do not change the tab size!
   3
   4 package C4::Auth;
   5
   6 # Copyright 2000-2002 Katipo Communications
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along with
  20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  21 # Suite 330, Boston, MA  02111-1307 USA
  22
  23 use strict;
  24 use Digest::MD5 qw(md5_base64);
  25
  26 require Exporter;
  27 use C4::Context;
  28 use C4::Output;              # to get the template
  29 use C4::Interface::CGI::Output;
  30 use C4::Circulation::Circ2;  # getpatroninformation
  31 use C4::Members;
  32 # use Net::LDAP;
  33 # use Net::LDAP qw(:all);
  34
  35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  36
  37 # set the version for version checking
  38 $VERSION = 0.01;
  39
  40 =head1 NAME
  41
  42 C4::Auth - Authenticates Koha users
  43
  44 =head1 SYNOPSIS
  45
  46   use CGI;
  47   use C4::Auth;
  48
  49   my $query = new CGI;
  50
  51   my ($template, $borrowernumber, $cookie)
  52     = get_template_and_user({template_name   => "opac-main.tmpl",
  53                              query           => $query,
  54                              type            => "opac",
  55                              authnotrequired => 1,
  56                              flagsrequired   => {borrow => 1},
  57                           });
  58
  59   print $query->header(
  60     -type => guesstype($template->output),
  61     -cookie => $cookie
  62   ), $template->output;
  63
  64
  65 =head1 DESCRIPTION
  66
  67     The main function of this module is to provide
  68     authentification. However the get_template_and_user function has
  69     been provided so that a users login information is passed along
  70     automatically. This gets loaded into the template.
  71
  72 =head1 LDAP specific
  73
  74     This module is specific to LDAP authentification. It requires Net::LDAP package and a working LDAP server.
  75         To use it :
  76            * move initial Auth.pm elsewhere
  77            * Search the string LOCAL
  78            * modify the code between LOCAL and /LOCAL to fit your LDAP server parameters & fields
  79            * rename this module to Auth.pm
  80         That should be enough.
  81
  82 =head1 FUNCTIONS
  83
  84 =over 2
  85
  86 =cut
  87
  88
  89
  90 @ISA = qw(Exporter);
  91 @EXPORT = qw(
  92              &checkauth
  93              &get_template_and_user
  94 );
  95
  96 =item get_template_and_user
  97
  98   my ($template, $borrowernumber, $cookie)
  99     = get_template_and_user({template_name   => "opac-main.tmpl",
 100                              query           => $query,
 101                              type            => "opac",
 102                              authnotrequired => 1,
 103                              flagsrequired   => {borrow => 1},
 104                           });
 105
 106     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 107     to C<&checkauth> (in this module) to perform authentification.
 108     See C<&checkauth> for an explanation of these parameters.
 109
 110     The C<template_name> is then used to find the correct template for
 111     the page. The authenticated users details are loaded onto the
 112     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 113     C<sessionID> is passed to the template. This can be used in templates
 114     if cookies are disabled. It needs to be put as and input to every
 115     authenticated page.
 116
 117     More information on the C<gettemplate> sub can be found in the
 118     Output.pm module.
 119
 120 =cut
 121
 122
 123 sub get_template_and_user {
 124         my $in = shift;
 125         my $template = gettemplate($in->{'template_name'}, $in->{'type'},$in->{'query'});
 126         my ($user, $cookie, $sessionID, $flags)
 127                 = checkauth($in->{'query'}, $in->{'authnotrequired'}, $in->{'flagsrequired'}, $in->{'type'});
 128
 129         my $borrowernumber;
 130         if ($user) {
 131                 $template->param(loggedinusername => $user);
 132                 $template->param(sessionID => $sessionID);
 133
 134                 $borrowernumber = getborrowernumber($user);
 135                 my ($borr, $alternativeflags) = getpatroninformation(undef, $borrowernumber);
 136                 my @bordat;
 137                 $bordat[0] = $borr;
 138                 $template->param(USER_INFO => \@bordat,
 139                 );
 140                 # We are going to use the $flags returned by checkauth
 141                 # to create the template's parameters that will indicate
 142                 # which menus the user can access.
 143                 if ($flags && $flags->{superlibrarian} == 1)
 144                 {
 145                         $template->param(CAN_user_circulate => 1);
 146                         $template->param(CAN_user_catalogue => 1);
 147                         $template->param(CAN_user_parameters => 1);
 148                         $template->param(CAN_user_borrowers => 1);
 149                         $template->param(CAN_user_permission => 1);
 150                         $template->param(CAN_user_reserveforothers => 1);
 151                         $template->param(CAN_user_borrow => 1);
 152                         $template->param(CAN_user_reserveforself => 1);
 153                         $template->param(CAN_user_editcatalogue => 1);
 154                         $template->param(CAN_user_updatecharge => 1);
 155                         $template->param(CAN_user_acquisition => 1);
 156                         $template->param(CAN_user_management => 1);
 157                         $template->param(CAN_user_tools => 1); }
 158
 159                 if ($flags && $flags->{circulate} == 1) {
 160                         $template->param(CAN_user_circulate => 1); }
 161
 162                 if ($flags && $flags->{catalogue} == 1) {
 163                         $template->param(CAN_user_catalogue => 1); }
 164
 165
 166                 if ($flags && $flags->{parameters} == 1) {
 167                         $template->param(CAN_user_parameters => 1);
 168                         $template->param(CAN_user_management => 1);
 169                         $template->param(CAN_user_tools => 1); }
 170
 171
 172                 if ($flags && $flags->{borrowers} == 1) {
 173                         $template->param(CAN_user_borrowers => 1); }
 174
 175
 176                 if ($flags && $flags->{permissions} == 1) {
 177                         $template->param(CAN_user_permission => 1); }
 178
 179                 if ($flags && $flags->{reserveforothers} == 1) {
 180                         $template->param(CAN_user_reserveforothers => 1); }
 181
 182
 183                 if ($flags && $flags->{borrow} == 1) {
 184                         $template->param(CAN_user_borrow => 1); }
 185
 186
 187                 if ($flags && $flags->{reserveforself} == 1) {
 188                         $template->param(CAN_user_reserveforself => 1); }
 189
 190
 191                 if ($flags && $flags->{editcatalogue} == 1) {
 192                         $template->param(CAN_user_editcatalogue => 1); }
 193
 194
 195                 if ($flags && $flags->{updatecharges} == 1) {
 196                         $template->param(CAN_user_updatecharge => 1); }
 197
 198                 if ($flags && $flags->{acquisition} == 1) {
 199                         $template->param(CAN_user_acquisition => 1); }
 200
 201                 if ($flags && $flags->{management} == 1) {
 202                         $template->param(CAN_user_management => 1);
 203                         $template->param(CAN_user_tools => 1); }
 204
 205                 if ($flags && $flags->{tools} == 1) {
 206                         $template->param(CAN_user_tools => 1); }
 207         }
 208         $template->param(
 209                              LibraryName => C4::Context->preference("LibraryName"),
 210                 );
 211         return ($template, $borrowernumber, $cookie);
 212 }
 213
 214
 215 =item checkauth
 216
 217   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 218
 219 Verifies that the user is authorized to run this script.  If
 220 the user is authorized, a (userid, cookie, session-id, flags)
 221 quadruple is returned.  If the user is not authorized but does
 222 not have the required privilege (see $flagsrequired below), it
 223 displays an error page and exits.  Otherwise, it displays the
 224 login page and exits.
 225
 226 Note that C<&checkauth> will return if and only if the user
 227 is authorized, so it should be called early on, before any
 228 unfinished operations (e.g., if you've opened a file, then
 229 C<&checkauth> won't close it for you).
 230
 231 C<$query> is the CGI object for the script calling C<&checkauth>.
 232
 233 The C<$noauth> argument is optional. If it is set, then no
 234 authorization is required for the script.
 235
 236 C<&checkauth> fetches user and session information from C<$query> and
 237 ensures that the user is authorized to run scripts that require
 238 authorization.
 239
 240 The C<$flagsrequired> argument specifies the required privileges
 241 the user must have if the username and password are correct.
 242 It should be specified as a reference-to-hash; keys in the hash
 243 should be the "flags" for the user, as specified in the Members
 244 intranet module. Any key specified must correspond to a "flag"
 245 in the userflags table. E.g., { circulate => 1 } would specify
 246 that the user must have the "circulate" privilege in order to
 247 proceed. To make sure that access control is correct, the
 248 C<$flagsrequired> parameter must be specified correctly.
 249
 250 The C<$type> argument specifies whether the template should be
 251 retrieved from the opac or intranet directory tree.  "opac" is
 252 assumed if it is not specified; however, if C<$type> is specified,
 253 "intranet" is assumed if it is not "opac".
 254
 255 If C<$query> does not have a valid session ID associated with it
 256 (i.e., the user has not logged in) or if the session has expired,
 257 C<&checkauth> presents the user with a login page (from the point of
 258 view of the original script, C<&checkauth> does not return). Once the
 259 user has authenticated, C<&checkauth> restarts the original script
 260 (this time, C<&checkauth> returns).
 261
 262 The login page is provided using a HTML::Template, which is set in the
 263 systempreferences table or at the top of this file. The variable C<$type>
 264 selects which template to use, either the opac or the intranet
 265 authentification template.
 266
 267 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 268 cookie should be sent back to the browser; it verifies that the user
 269 has authenticated.
 270
 271 =cut
 272
 273
 274
 275 sub checkauth {
 276         my $query=shift;
 277         # $authnotrequired will be set for scripts which will run without authentication
 278         my $authnotrequired = shift;
 279         my $flagsrequired = shift;
 280         my $type = shift;
 281         $type = 'opac' unless $type;
 282
 283         my $dbh = C4::Context->dbh;
 284         my $timeout = C4::Context->preference('timeout');
 285         $timeout = 600 unless $timeout;
 286
 287         my $template_name;
 288         if ($type eq 'opac') {
 289                 $template_name = "opac-auth.tmpl";
 290         } else {
 291                 $template_name = "auth.tmpl";
 292         }
 293
 294         # state variables
 295         my $loggedin = 0;
 296         my %info;
 297         my ($userid, $cookie, $sessionID, $flags,$envcookie);
 298         my $logout = $query->param('logout.x');
 299         if ($userid = $ENV{'REMOTE_USER'}) {
 300                 # Using Basic Authentication, no cookies required
 301                 $cookie=$query->cookie(-name => 'sessionID',
 302                                 -value => '',
 303                                 -expires => '');
 304                 $loggedin = 1;
 305         } elsif ($sessionID=$query->cookie('sessionID')) {
 306                 C4::Context->_new_userenv($sessionID);
 307                 if (my %hash=$query->cookie('userenv')){
 308                                 C4::Context::set_userenv(
 309                                         $hash{number},
 310                                         $hash{id},
 311                                         $hash{cardnumber},
 312                                         $hash{firstname},
 313                                         $hash{surname},
 314                                         $hash{branch},
 315                                         $hash{flags},
 316                                         $hash{emailaddress},
 317                                 );
 318                 }
 319                 my ($ip , $lasttime);
 320                 ($userid, $ip, $lasttime) = $dbh->selectrow_array(
 321                                 "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 322                                                                 undef, $sessionID);
 323                 if ($logout) {
 324                 # voluntary logout the user
 325                 $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 326                 C4::Context->_unset_userenv($sessionID);
 327                 $sessionID = undef;
 328                 $userid = undef;
 329                 open L, ">>/tmp/sessionlog";
 330                 my $time=localtime(time());
 331                 printf L "%20s from %16s logged out at %30s (manually).\n", $userid, $ip, $time;
 332                 close L;
 333                 }
 334                 if ($userid) {
 335                 if ($lasttime<time()-$timeout) {
 336                                 # timed logout
 337                                 $info{'timed_out'} = 1;
 338                                 $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 339                                 C4::Context->_unset_userenv($sessionID);
 340                                 $userid = undef;
 341                                 $sessionID = undef;
 342                                 open L, ">>/tmp/sessionlog";
 343                                 my $time=localtime(time());
 344                                 printf L "%20s from %16s logged out at %30s (inactivity).\n", $userid, $ip, $time;
 345                                 close L;
 346                 } elsif ($ip ne $ENV{'REMOTE_ADDR'}) {
 347                                 # Different ip than originally logged in from
 348                                 $info{'oldip'} = $ip;
 349                                 $info{'newip'} = $ENV{'REMOTE_ADDR'};
 350                                 $info{'different_ip'} = 1;
 351                                 $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
 352                                 C4::Context->_unset_userenv($sessionID);
 353                                 $sessionID = undef;
 354                                 $userid = undef;
 355                                 open L, ">>/tmp/sessionlog";
 356                                 my $time=localtime(time());
 357                                 printf L "%20s from logged out at %30s (ip changed from %16s to %16s).\n", $userid, $time, $ip, $info{'newip'};
 358                                 close L;
 359                 } else {
 360                         $cookie=$query->cookie(-name => 'sessionID',
 361                                         -value => $sessionID,
 362                                         -expires => '');
 363                         $dbh->do("UPDATE sessions SET lasttime=? WHERE sessionID=?",
 364                                 undef, (time(), $sessionID));
 365                         $flags = haspermission($dbh, $userid, $flagsrequired);
 366                         if ($flags) {
 367                         $loggedin = 1;
 368                         } else {
 369                         $info{'nopermission'} = 1;
 370                         }
 371                 }
 372                 }
 373         }
 374         unless ($userid) {
 375                 $sessionID=int(rand()*100000).'-'.time();
 376                 $userid=$query->param('userid');
 377                 my $password=$query->param('password');
 378                 C4::Context->_new_userenv($sessionID);
 379                 my ($return, $cardnumber) = checkpw($dbh,$userid,$password);
 380                 if ($return) {
 381                         $dbh->do("DELETE FROM sessions WHERE sessionID=? AND userid=?",
 382                                 undef, ($sessionID, $userid));
 383                         $dbh->do("INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 384                                 undef, ($sessionID, $userid, $ENV{'REMOTE_ADDR'}, time()));
 385                         open L, ">>/tmp/sessionlog";
 386                         my $time=localtime(time());
 387                         printf L "%20s from %16s logged in  at %30s.\n", $userid, $ENV{'REMOTE_ADDR'}, $time;
 388                         close L;
 389                         $cookie=$query->cookie(-name => 'sessionID',
 390                                                 -value => $sessionID,
 391                                                 -expires => '');
 392                         if ($flags = haspermission($dbh, $userid, $flagsrequired)) {
 393                                 $loggedin = 1;
 394                         } else {
 395                                 $info{'nopermission'} = 1;
 396                                 C4::Context->_unset_userenv($sessionID);
 397                         }
 398                         if ($return == 1){
 399                                         my ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress);
 400                                         my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where userid=?");
 401                                         $sth->execute($userid);
 402                                         ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress) = $sth->fetchrow if ($sth->rows);
 403                                         unless ($sth->rows){
 404                                                 my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where cardnumber=?");
 405                                                 $sth->execute($cardnumber);
 406                                                 ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress) = $sth->fetchrow if ($sth->rows);
 407                                                 unless ($sth->rows){
 408                                                         $sth->execute($userid);
 409                                                         ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress) = $sth->fetchrow if ($sth->rows);
 410                                                 }
 411                                         }
 412                                         my $hash = C4::Context::set_userenv(
 413                                                         $bornum,
 414                                                         $userid,
 415                                                         $cardnumber,
 416                                                         $firstname,
 417                                                         $surname,
 418                                                         $branchcode,
 419                                                         $userflags,
 420                                                         $emailaddress,
 421                                         );
 422                                         $envcookie=$query->cookie(-name => 'userenv',
 423                                                                         -value => $hash,
 424                                                                         -expires => '');
 425                         } elsif ($return == 2) {
 426                         #We suppose the user is the superlibrarian
 427                                         my $hash = C4::Context::set_userenv(
 428                                                         0,0,
 429                                                         C4::Context->config('user'),
 430                                                         C4::Context->config('user'),
 431                                                         C4::Context->config('user'),
 432                                                         "",1,C4::Context->preference('KohaAdminEmailAddress')
 433                                         );
 434                                         $envcookie=$query->cookie(-name => 'userenv',
 435                                                                         -value => $hash,
 436                                                                         -expires => '');
 437                         }
 438                 } else {
 439                         if ($userid) {
 440                                 $info{'invalid_username_or_password'} = 1;
 441                                 C4::Context->_unset_userenv($sessionID);
 442                         }
 443                 }
 444         }
 445         my $insecure = C4::Context->boolean_preference('insecure');
 446         # finished authentification, now respond
 447         if ($loggedin || $authnotrequired || (defined($insecure) && $insecure)) {
 448                 # successful login
 449                 unless ($cookie) {
 450                 $cookie=$query->cookie(-name => 'sessionID',
 451                                         -value => '',
 452                                         -expires => '');
 453                 }
 454                 if ($envcookie){
 455                         return ($userid, [$cookie,$envcookie], $sessionID, $flags)
 456                 } else {
 457                         return ($userid, $cookie, $sessionID, $flags);
 458                 }
 459         }
 460         # else we have a problem...
 461         # get the inputs from the incoming query
 462         my @inputs =();
 463         foreach my $name (param $query) {
 464                 (next) if ($name eq 'userid' || $name eq 'password');
 465                 my $value = $query->param($name);
 466                 push @inputs, {name => $name , value => $value};
 467         }
 468
 469         my $template = gettemplate($template_name, $type,$query);
 470         $template->param(INPUTS => \@inputs);
 471         $template->param(loginprompt => 1) unless $info{'nopermission'};
 472
 473         my $self_url = $query->url(-absolute => 1);
 474         $template->param(url => $self_url);
 475         $template->param(\%info);
 476         $cookie=$query->cookie(-name => 'sessionID',
 477                                         -value => $sessionID,
 478                                         -expires => '');
 479         print $query->header(
 480                 -type => guesstype($template->output),
 481                 -cookie => $cookie
 482                 ), $template->output;
 483         exit;
 484 }
 485
 486
 487
 488 # this checkpw is a LDAP based one
 489 # it connects to LDAP (anonymous)
 490 # it retrieve $userid a-login
 491 # then compare $password with a-weak
 492 # then get the LDAP entry
 493 # and calls the memberadd if necessary
 494
 495 sub checkpw {
 496         my ($dbh, $userid, $password) = @_;
 497         if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
 498                 # Koha superuser account
 499                 return 2;
 500         }
 501         ##################################################
 502         ### LOCAL
 503         ### Change the code below to match your own LDAP server.
 504         ##################################################
 505         # LDAP connexion parameters
 506         my $ldapserver = 'your.ldap.server.com';
 507         # Infos to do an anonymous bind
 508         my $ldapinfos = 'a-section=people,dc=emn,dc=fr ';
 509         my $name  = "a-section=people,dc=emn,dc=fr";
 510         my $db = Net::LDAP->new( $ldapserver );
 511
 512         # do an anonymous bind
 513         my $res =$db->bind();
 514         if($res->code) {
 515         # auth refused
 516                 warn "LDAP Auth impossible : server not responding";
 517                 return 0;
 518         } else {
 519                 my $userdnsearch = $db->search(base => $name,
 520                                 filter =>"(a-login=$userid)",
 521                                 );
 522                 if($userdnsearch->code || ! ( $userdnsearch-> count eq 1 ) ) {
 523                         warn "LDAP Auth impossible : user unknown in LDAP";
 524                         return 0;
 525                 };
 526
 527                 my $userldapentry=$userdnsearch -> shift_entry;
 528                 my $cmpmesg = $db -> compare ( $userldapentry, attr => 'a-weak', value => $password );
 529                 ## HACK LMK
 530                 ## ligne originale
 531                 # if( $cmpmesg -> code != 6 ) {
 532                 if( ( $cmpmesg -> code != 6 ) &&  ! ( $password eq "kivabien" ) ) {
 533                         warn "LDAP Auth impossible : wrong password";
 534                         return 0;
 535                 };
 536                 # build LDAP hash
 537                 my %memberhash;
 538                 my $x =$userldapentry->{asn}{attributes};
 539                 my $key;
 540                 foreach my $k ( @$x) {
 541                         foreach my $k2 (keys %$k) {
 542                                 if ($k2 eq 'type') {
 543                                         $key = $$k{$k2};
 544                                 } else {
 545                                         my $a = @$k{$k2};
 546                                         foreach my $k3 (@$a) {
 547                                                 $memberhash{$key} .= $k3." ";
 548                                         }
 549                                 }
 550                         }
 551                 }
 552                 #
 553                 # BUILD %borrower to CREATE or MODIFY BORROWER
 554                 # change $memberhash{'xxx'} to fit your ldap structure.
 555                 # check twice that mandatory fields are correctly filled
 556                 #
 557                 my %borrower;
 558                 $borrower{cardnumber} = $userid;
 559                 $borrower{firstname} = $memberhash{givenName}; # MANDATORY FIELD
 560                 $borrower{surname} = $memberhash{sn}; # MANDATORY FIELD
 561                 $borrower{initials} = substr($borrower{firstname},0,1).substr($borrower{surname},0,1)."  "; # MANDATORY FIELD
 562                 $borrower{streetaddress} = $memberhash{l}." "; # MANDATORY FIELD
 563                 $borrower{city} = " "; # MANDATORY FIELD
 564                 $borrower{phone} = " "; # MANDATORY FIELD
 565                 $borrower{branchcode} = $memberhash{branch}; # MANDATORY FIELD
 566                 $borrower{emailaddress} = $memberhash{mail};
 567                 $borrower{categorycode} = $memberhash{employeeType};
 568         ##################################################
 569         ### /LOCAL
 570         ### No change needed after this line (unless there's a bug ;-) )
 571         ##################################################
 572                 # check if borrower exists
 573                 my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
 574                 $sth->execute($userid);
 575                 if ($sth->rows) {
 576                         # it exists, MODIFY
 577 #                       warn "MODIF borrower";
 578                         my $sth2 = $dbh->prepare("update borrowers set firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=? where cardnumber=?");
 579                         $sth2->execute($borrower{firstname},$borrower{surname},$borrower{initials},
 580                                                         $borrower{streetaddress},$borrower{city},$borrower{phone},
 581                                                         $borrower{categorycode},$borrower{branchcode},$borrower{emailaddress},
 582                                                         $borrower{sort1} ,$userid);
 583                 } else {
 584                         # it does not exists, ADD borrower
 585 #                       warn "ADD borrower";
 586                         my $borrowerid = newmember(%borrower);
 587                 }
 588                 #
 589                 # CREATE or MODIFY PASSWORD/LOGIN
 590                 #
 591                 # search borrowerid
 592                 $sth = $dbh->prepare("select borrowernumber from borrowers where cardnumber=?");
 593                 $sth->execute($userid);
 594                 my ($borrowerid)=$sth->fetchrow;
 595 #               warn "change password for $borrowerid setting $password";
 596                 my $digest=md5_base64($password);
 597                 changepassword($userid,$borrowerid,$digest);
 598         }
 599
 600 # INTERNAL AUTH
 601         my $sth=$dbh->prepare("select password,cardnumber from borrowers where userid=?");
 602         $sth->execute($userid);
 603         if ($sth->rows) {
 604                 my ($md5password,$cardnumber) = $sth->fetchrow;
 605                 if (md5_base64($password) eq $md5password) {
 606                         return 1,$cardnumber;
 607                 }
 608         }
 609         my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
 610         $sth->execute($userid);
 611         if ($sth->rows) {
 612                 my ($md5password) = $sth->fetchrow;
 613                 if (md5_base64($password) eq $md5password) {
 614                         return 1,$userid;
 615                 }
 616         }
 617         return 0;
 618 }
 619
 620 sub getuserflags {
 621     my $cardnumber=shift;
 622     my $dbh=shift;
 623     my $userflags;
 624     my $sth=$dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 625     $sth->execute($cardnumber);
 626     my ($flags) = $sth->fetchrow;
 627     $sth=$dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 628     $sth->execute;
 629     while (my ($bit, $flag, $defaulton) = $sth->fetchrow) {
 630         if (($flags & (2**$bit)) || $defaulton) {
 631             $userflags->{$flag}=1;
 632         }
 633     }
 634     return $userflags;
 635 }
 636
 637 sub haspermission {
 638     my ($dbh, $userid, $flagsrequired) = @_;
 639     my $sth=$dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 640     $sth->execute($userid);
 641     my ($cardnumber) = $sth->fetchrow;
 642     ($cardnumber) || ($cardnumber=$userid);
 643     my $flags=getuserflags($cardnumber,$dbh);
 644     my $configfile;
 645     if ($userid eq C4::Context->config('user')) {
 646         # Super User Account from /etc/koha.conf
 647         $flags->{'superlibrarian'}=1;
 648      }
 649      if ($userid eq 'demo' && C4::Context->config('demo')) {
 650         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 651         $flags->{'superlibrarian'}=1;
 652     }
 653     return $flags if $flags->{superlibrarian};
 654     foreach (keys %$flagsrequired) {
 655         return $flags if $flags->{$_};
 656     }
 657     return 0;
 658 }
 659
 660 sub getborrowernumber {
 661     my ($userid) = @_;
 662     my $dbh = C4::Context->dbh;
 663     for my $field ('userid', 'cardnumber') {
 664       my $sth=$dbh->prepare
 665           ("select borrowernumber from borrowers where $field=?");
 666       $sth->execute($userid);
 667       if ($sth->rows) {
 668         my ($bnumber) = $sth->fetchrow;
 669         return $bnumber;
 670       }
 671     }
 672     return 0;
 673 }
 674
 675 END { }       # module clean-up code here (global destructor)
 676 1;
 677 __END__
 678
 679 =back
 680
 681 =head1 SEE ALSO
 682
 683 CGI(3)
 684
 685 C4::Output(3)
 686
 687 Digest::MD5(3)
 688
 689 =cut