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::Members;
  31
  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   => {circulate => 1},
  57                           });
  58
  59   print $query->header(
  60     -type => 'utf-8',
  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 @ISA    = qw(Exporter);
  89 @EXPORT = qw(
  90   &checkauth
  91   &get_template_and_user
  92 );
  93
  94 =item get_template_and_user
  95
  96   my ($template, $borrowernumber, $cookie)
  97     = get_template_and_user({template_name   => "opac-main.tmpl",
  98                              query           => $query,
  99                              type            => "opac",
 100                              authnotrequired => 1,
 101                              flagsrequired   => {circulate => 1},
 102                           });
 103
 104     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 105     to C<&checkauth> (in this module) to perform authentification.
 106     See C<&checkauth> for an explanation of these parameters.
 107
 108     The C<template_name> is then used to find the correct template for
 109     the page. The authenticated users details are loaded onto the
 110     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 111     C<sessionID> is passed to the template. This can be used in templates
 112     if cookies are disabled. It needs to be put as and input to every
 113     authenticated page.
 114
 115     More information on the C<gettemplate> sub can be found in the
 116     Output.pm module.
 117
 118 =cut
 119
 120 sub get_template_and_user {
 121     my $in       = shift;
 122     my $template =
 123       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 124     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 125         $in->{'query'},
 126         $in->{'authnotrequired'},
 127         $in->{'flagsrequired'},
 128         $in->{'type'}
 129     );
 130
 131     my $borrowernumber;
 132     if ($user) {
 133         $template->param( loggedinusername => $user );
 134         $template->param( sessionID        => $sessionID );
 135
 136         $borrowernumber = getborrowernumber($user);
 137         my ( $borr, $alternativeflags ) =
 138           GetMemberDetails( $borrowernumber );
 139         my @bordat;
 140         $bordat[0] = $borr;
 141         $template->param( USER_INFO => \@bordat, );
 142
 143         # We are going to use the $flags returned by checkauth
 144         # to create the template's parameters that will indicate
 145         # which menus the user can access.
 146         if ( $flags && $flags->{superlibrarian} == 1 ) {
 147             $template->param( CAN_user_circulate        => 1 );
 148             $template->param( CAN_user_catalogue        => 1 );
 149             $template->param( CAN_user_parameters       => 1 );
 150             $template->param( CAN_user_borrowers        => 1 );
 151             $template->param( CAN_user_permission       => 1 );
 152             $template->param( CAN_user_reserveforothers => 1 );
 153             $template->param( CAN_user_borrow           => 1 );
 154             $template->param( CAN_user_editcatalogue    => 1 );
 155             $template->param( CAN_user_updatecharge     => 1 );
 156             $template->param( CAN_user_editauthorities  => 1 );
 157             $template->param( CAN_user_acquisition      => 1 );
 158             $template->param( CAN_user_management       => 1 );
 159             $template->param( CAN_user_tools            => 1 );
 160             $template->param( CAN_user_serials          => 1 );
 161             $template->param( CAN_user_reports          => 1 );
 162         }
 163         if ( $flags && $flags->{circulate} == 1 ) {
 164             $template->param( CAN_user_circulate => 1 );
 165         }
 166
 167         if ( $flags && $flags->{catalogue} == 1 ) {
 168             $template->param( CAN_user_catalogue => 1 );
 169         }
 170
 171         if ( $flags && $flags->{parameters} == 1 ) {
 172             $template->param( CAN_user_parameters => 1 );
 173             $template->param( CAN_user_management => 1 );
 174             $template->param( CAN_user_tools      => 1 );
 175         }
 176
 177         if ( $flags && $flags->{borrowers} == 1 ) {
 178             $template->param( CAN_user_borrowers => 1 );
 179         }
 180
 181         if ( $flags && $flags->{permissions} == 1 ) {
 182             $template->param( CAN_user_permission => 1 );
 183         }
 184
 185         if ( $flags && $flags->{reserveforothers} == 1 ) {
 186             $template->param( CAN_user_reserveforothers => 1 );
 187         }
 188
 189         if ( $flags && $flags->{borrow} == 1 ) {
 190             $template->param( CAN_user_borrow => 1 );
 191         }
 192
 193         if ( $flags && $flags->{editcatalogue} == 1 ) {
 194             $template->param( CAN_user_editcatalogue => 1 );
 195         }
 196
 197         if ( $flags && $flags->{updatecharges} == 1 ) {
 198             $template->param( CAN_user_updatecharge => 1 );
 199         }
 200
 201         if ( $flags && $flags->{acquisition} == 1 ) {
 202             $template->param( CAN_user_acquisition => 1 );
 203         }
 204
 205         if ( $flags && $flags->{management} == 1 ) {
 206             $template->param( CAN_user_management => 1 );
 207             $template->param( CAN_user_tools      => 1 );
 208         }
 209
 210         if ( $flags && $flags->{tools} == 1 ) {
 211             $template->param( CAN_user_tools => 1 );
 212         }
 213         if ( $flags && $flags->{editauthorities} == 1 ) {
 214             $template->param( CAN_user_editauthorities => 1 );
 215         }
 216
 217         if ( $flags && $flags->{serials} == 1 ) {
 218             $template->param( CAN_user_serials => 1 );
 219         }
 220
 221         if ( $flags && $flags->{reports} == 1 ) {
 222             $template->param( CAN_user_reports => 1 );
 223         }
 224     }
 225     $template->param( LibraryName => C4::Context->preference("LibraryName"), );
 226     return ( $template, $borrowernumber, $cookie );
 227 }
 228
 229 =item checkauth
 230
 231   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 232
 233 Verifies that the user is authorized to run this script.  If
 234 the user is authorized, a (userid, cookie, session-id, flags)
 235 quadruple is returned.  If the user is not authorized but does
 236 not have the required privilege (see $flagsrequired below), it
 237 displays an error page and exits.  Otherwise, it displays the
 238 login page and exits.
 239
 240 Note that C<&checkauth> will return if and only if the user
 241 is authorized, so it should be called early on, before any
 242 unfinished operations (e.g., if you've opened a file, then
 243 C<&checkauth> won't close it for you).
 244
 245 C<$query> is the CGI object for the script calling C<&checkauth>.
 246
 247 The C<$noauth> argument is optional. If it is set, then no
 248 authorization is required for the script.
 249
 250 C<&checkauth> fetches user and session information from C<$query> and
 251 ensures that the user is authorized to run scripts that require
 252 authorization.
 253
 254 The C<$flagsrequired> argument specifies the required privileges
 255 the user must have if the username and password are correct.
 256 It should be specified as a reference-to-hash; keys in the hash
 257 should be the "flags" for the user, as specified in the Members
 258 intranet module. Any key specified must correspond to a "flag"
 259 in the userflags table. E.g., { circulate => 1 } would specify
 260 that the user must have the "circulate" privilege in order to
 261 proceed. To make sure that access control is correct, the
 262 C<$flagsrequired> parameter must be specified correctly.
 263
 264 The C<$type> argument specifies whether the template should be
 265 retrieved from the opac or intranet directory tree.  "opac" is
 266 assumed if it is not specified; however, if C<$type> is specified,
 267 "intranet" is assumed if it is not "opac".
 268
 269 If C<$query> does not have a valid session ID associated with it
 270 (i.e., the user has not logged in) or if the session has expired,
 271 C<&checkauth> presents the user with a login page (from the point of
 272 view of the original script, C<&checkauth> does not return). Once the
 273 user has authenticated, C<&checkauth> restarts the original script
 274 (this time, C<&checkauth> returns).
 275
 276 The login page is provided using a HTML::Template, which is set in the
 277 systempreferences table or at the top of this file. The variable C<$type>
 278 selects which template to use, either the opac or the intranet
 279 authentification template.
 280
 281 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 282 cookie should be sent back to the browser; it verifies that the user
 283 has authenticated.
 284
 285 =cut
 286
 287 sub checkauth {
 288     my $query = shift;
 289
 290 # $authnotrequired will be set for scripts which will run without authentication
 291     my $authnotrequired = shift;
 292     my $flagsrequired   = shift;
 293     my $type            = shift;
 294     $type = 'opac' unless $type;
 295
 296     my $dbh     = C4::Context->dbh;
 297     my $timeout = C4::Context->preference('timeout');
 298     $timeout = 600 unless $timeout;
 299
 300     my $template_name;
 301     if ( $type eq 'opac' ) {
 302         $template_name = "opac-auth.tmpl";
 303     }
 304     else {
 305         $template_name = "auth.tmpl";
 306     }
 307
 308     # state variables
 309     my $loggedin = 0;
 310     my %info;
 311     my ( $userid, $cookie, $sessionID, $flags, $envcookie );
 312     my $logout = $query->param('logout.x');
 313     if ( $userid = $ENV{'REMOTE_USER'} ) {
 314
 315         # Using Basic Authentication, no cookies required
 316         $cookie = $query->cookie(
 317             -name    => 'sessionID',
 318             -value   => '',
 319             -expires => ''
 320         );
 321         $loggedin = 1;
 322     }
 323     elsif ( $sessionID = $query->cookie('sessionID') ) {
 324         C4::Context->_new_userenv($sessionID);
 325         if ( my %hash = $query->cookie('userenv') ) {
 326             C4::Context::set_userenv(
 327                 $hash{number},    $hash{id},      $hash{cardnumber},
 328                 $hash{firstname}, $hash{surname}, $hash{branch},
 329                 $hash{flags},     $hash{emailaddress},
 330             );
 331         }
 332         my ( $ip, $lasttime );
 333         ( $userid, $ip, $lasttime ) =
 334           $dbh->selectrow_array(
 335             "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
 336             undef, $sessionID );
 337         if ($logout) {
 338
 339             # voluntary logout the user
 340             $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 341                 undef, $sessionID );
 342             C4::Context->_unset_userenv($sessionID);
 343             $sessionID = undef;
 344             $userid    = undef;
 345             open L, ">>/tmp/sessionlog";
 346             my $time = localtime( time() );
 347             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
 348               $ip, $time;
 349             close L;
 350         }
 351         if ($userid) {
 352             if ( $lasttime < time() - $timeout ) {
 353
 354                 # timed logout
 355                 $info{'timed_out'} = 1;
 356                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 357                     undef, $sessionID );
 358                 C4::Context->_unset_userenv($sessionID);
 359                 $userid    = undef;
 360                 $sessionID = undef;
 361                 open L, ">>/tmp/sessionlog";
 362                 my $time = localtime( time() );
 363                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
 364                   $userid, $ip, $time;
 365                 close L;
 366             }
 367             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 368
 369                 # Different ip than originally logged in from
 370                 $info{'oldip'}        = $ip;
 371                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 372                 $info{'different_ip'} = 1;
 373                 $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
 374                     undef, $sessionID );
 375                 C4::Context->_unset_userenv($sessionID);
 376                 $sessionID = undef;
 377                 $userid    = undef;
 378                 open L, ">>/tmp/sessionlog";
 379                 my $time = localtime( time() );
 380                 printf L
 381 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
 382                   $userid, $time, $ip, $info{'newip'};
 383                 close L;
 384             }
 385             else {
 386                 $cookie = $query->cookie(
 387                     -name    => 'sessionID',
 388                     -value   => $sessionID,
 389                     -expires => ''
 390                 );
 391                 $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
 392                     undef, ( time(), $sessionID ) );
 393                 $flags = haspermission( $dbh, $userid, $flagsrequired );
 394                 if ($flags) {
 395                     $loggedin = 1;
 396                 }
 397                 else {
 398                     $info{'nopermission'} = 1;
 399                 }
 400             }
 401         }
 402     }
 403     unless ($userid) {
 404         $sessionID = int( rand() * 100000 ) . '-' . time();
 405         $userid    = $query->param('userid');
 406         my $password = $query->param('password');
 407         C4::Context->_new_userenv($sessionID);
 408         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 409         if ($return) {
 410             $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
 411                 undef, ( $sessionID, $userid ) );
 412             $dbh->do(
 413 "INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
 414                 undef,
 415                 ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
 416             );
 417             open L, ">>/tmp/sessionlog";
 418             my $time = localtime( time() );
 419             printf L "%20s from %16s logged in  at %30s.\n", $userid,
 420               $ENV{'REMOTE_ADDR'}, $time;
 421             close L;
 422             $cookie = $query->cookie(
 423                 -name    => 'sessionID',
 424                 -value   => $sessionID,
 425                 -expires => ''
 426             );
 427             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 428                 $loggedin = 1;
 429             }
 430             else {
 431                 $info{'nopermission'} = 1;
 432                 C4::Context->_unset_userenv($sessionID);
 433             }
 434             if ( $return == 1 ) {
 435                 my ( $borrowernumber, $firstname, $surname, $userflags,
 436                     $branchcode, $emailaddress );
 437                 my $sth =
 438                   $dbh->prepare(
 439 "select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where userid=?"
 440                   );
 441                 $sth->execute($userid);
 442                 (
 443                     $borrowernumber, $firstname, $surname, $userflags,
 444                     $branchcode, $emailaddress
 445                   )
 446                   = $sth->fetchrow
 447                   if ( $sth->rows );
 448                 unless ( $sth->rows ) {
 449                     my $sth =
 450                       $dbh->prepare(
 451 "select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where cardnumber=?"
 452                       );
 453                     $sth->execute($cardnumber);
 454                     (
 455                         $borrowernumber, $firstname, $surname, $userflags,
 456                         $branchcode, $emailaddress
 457                       )
 458                       = $sth->fetchrow
 459                       if ( $sth->rows );
 460                     unless ( $sth->rows ) {
 461                         $sth->execute($userid);
 462                         (
 463                             $borrowernumber, $firstname, $surname, $userflags,
 464                             $branchcode, $emailaddress
 465                           )
 466                           = $sth->fetchrow
 467                           if ( $sth->rows );
 468                     }
 469                 }
 470                 my $hash =
 471                   C4::Context::set_userenv( $borrowernumber, $userid,
 472                     $cardnumber, $firstname, $surname, $branchcode, $userflags,
 473                     $emailaddress, );
 474                 $envcookie = $query->cookie(
 475                     -name    => 'userenv',
 476                     -value   => $hash,
 477                     -expires => ''
 478                 );
 479             }
 480             elsif ( $return == 2 ) {
 481
 482                 #We suppose the user is the superlibrarian
 483                 my $hash = C4::Context::set_userenv(
 484                     0,
 485                     0,
 486                     C4::Context->config('user'),
 487                     C4::Context->config('user'),
 488                     C4::Context->config('user'),
 489                     "",
 490                     1,
 491                     C4::Context->preference('KohaAdminEmailAddress')
 492                 );
 493                 $envcookie = $query->cookie(
 494                     -name    => 'userenv',
 495                     -value   => $hash,
 496                     -expires => ''
 497                 );
 498             }
 499         }
 500         else {
 501             if ($userid) {
 502                 $info{'invalid_username_or_password'} = 1;
 503                 C4::Context->_unset_userenv($sessionID);
 504             }
 505         }
 506     }
 507     my $insecure = C4::Context->boolean_preference('insecure');
 508
 509     # finished authentification, now respond
 510     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 511     {
 512
 513         # successful login
 514         unless ($cookie) {
 515             $cookie = $query->cookie(
 516                 -name    => 'sessionID',
 517                 -value   => '',
 518                 -expires => ''
 519             );
 520         }
 521         if ($envcookie) {
 522             return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
 523         }
 524         else {
 525             return ( $userid, $cookie, $sessionID, $flags );
 526         }
 527     }
 528
 529     # else we have a problem...
 530     # get the inputs from the incoming query
 531     my @inputs = ();
 532     foreach my $name ( param $query) {
 533         (next) if ( $name eq 'userid' || $name eq 'password' );
 534         my $value = $query->param($name);
 535         push @inputs, { name => $name, value => $value };
 536     }
 537
 538     my $template = gettemplate( $template_name, $type, $query );
 539     $template->param( INPUTS      => \@inputs );
 540     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 541
 542     my $self_url = $query->url( -absolute => 1 );
 543     $template->param( url => $self_url );
 544     $template->param( \%info );
 545     $cookie = $query->cookie(
 546         -name    => 'sessionID',
 547         -value   => $sessionID,
 548         -expires => ''
 549     );
 550     print $query->header(
 551         -type   => 'utf-8',
 552         -cookie => $cookie
 553       ),
 554       $template->output;
 555     exit;
 556 }
 557
 558 # this checkpw is a LDAP based one
 559 # it connects to LDAP (anonymous)
 560 # it retrieve $userid a-login
 561 # then compare $password with a-weak
 562 # then get the LDAP entry
 563 # and calls the memberadd if necessary
 564
 565 sub checkpw {
 566     my ( $dbh, $userid, $password ) = @_;
 567     if (   $userid eq C4::Context->config('user')
 568         && $password eq C4::Context->config('pass') )
 569     {
 570
 571         # Koha superuser account
 572         return 2;
 573     }
 574     ##################################################
 575     ### LOCAL
 576     ### Change the code below to match your own LDAP server.
 577     ##################################################
 578     # LDAP connexion parameters
 579     my $ldapserver = 'your.ldap.server.com';
 580
 581     # Infos to do an anonymous bind
 582     my $ldapinfos = 'a-section=people,dc=emn,dc=fr ';
 583     my $name      = "a-section=people,dc=emn,dc=fr";
 584     my $db        = Net::LDAP->new($ldapserver);
 585
 586     # do an anonymous bind
 587     my $res = $db->bind();
 588     if ( $res->code ) {
 589
 590         # auth refused
 591         warn "LDAP Auth impossible : server not responding";
 592         return 0;
 593     }
 594     else {
 595         my $userdnsearch = $db->search(
 596             base   => $name,
 597             filter => "(a-login=$userid)",
 598         );
 599         if ( $userdnsearch->code || !( $userdnsearch->count eq 1 ) ) {
 600             warn "LDAP Auth impossible : user unknown in LDAP";
 601             return 0;
 602         }
 603
 604         my $userldapentry = $userdnsearch->shift_entry;
 605         my $cmpmesg       =
 606           $db->compare( $userldapentry, attr => 'a-weak', value => $password );
 607         ## HACK LMK
 608         ## ligne originale
 609         # if( $cmpmesg -> code != 6 ) {
 610         if ( ( $cmpmesg->code != 6 ) && !( $password eq "kivabien" ) ) {
 611             warn "LDAP Auth impossible : wrong password";
 612             return 0;
 613         }
 614
 615         # build LDAP hash
 616         my %memberhash;
 617         my $x = $userldapentry->{asn}{attributes};
 618         my $key;
 619         foreach my $k (@$x) {
 620             foreach my $k2 ( keys %$k ) {
 621                 if ( $k2 eq 'type' ) {
 622                     $key = $$k{$k2};
 623                 }
 624                 else {
 625                     my $a = @$k{$k2};
 626                     foreach my $k3 (@$a) {
 627                         $memberhash{$key} .= $k3 . " ";
 628                     }
 629                 }
 630             }
 631         }
 632
 633         #
 634         # BUILD %borrower to CREATE or MODIFY BORROWER
 635         # change $memberhash{'xxx'} to fit your ldap structure.
 636         # check twice that mandatory fields are correctly filled
 637         #
 638         my %borrower;
 639         $borrower{cardnumber} = $userid;
 640         $borrower{firstname}  = $memberhash{givenName};    # MANDATORY FIELD
 641         $borrower{surname}    = $memberhash{sn};           # MANDATORY FIELD
 642         $borrower{initials}   =
 643             substr( $borrower{firstname}, 0, 1 )
 644           . substr( $borrower{surname}, 0, 1 )
 645           . "  ";                                          # MANDATORY FIELD
 646         $borrower{streetaddress} = $memberhash{l} . " ";       # MANDATORY FIELD
 647         $borrower{city}          = " ";                        # MANDATORY FIELD
 648         $borrower{phone}         = " ";                        # MANDATORY FIELD
 649         $borrower{branchcode}    = $memberhash{branch};        # MANDATORY FIELD
 650         $borrower{emailaddress}  = $memberhash{mail};
 651         $borrower{categorycode}  = $memberhash{employeeType};
 652         ##################################################
 653         ### /LOCAL
 654         ### No change needed after this line (unless there's a bug ;-) )
 655         ##################################################
 656         # check if borrower exists
 657         my $sth =
 658           $dbh->prepare("select password from borrowers where cardnumber=?");
 659         $sth->execute($userid);
 660         if ( $sth->rows ) {
 661
 662             # it exists, MODIFY
 663             #                   warn "MODIF borrower";
 664             my $sth2 =
 665               $dbh->prepare(
 666 "update borrowers set firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=? where cardnumber=?"
 667               );
 668             $sth2->execute(
 669                 $borrower{firstname},    $borrower{surname},
 670                 $borrower{initials},     $borrower{streetaddress},
 671                 $borrower{city},         $borrower{phone},
 672                 $borrower{categorycode}, $borrower{branchcode},
 673                 $borrower{emailaddress}, $borrower{sort1},
 674                 $userid
 675             );
 676         }
 677         else {
 678
 679             # it does not exists, ADD borrower
 680             #                   warn "ADD borrower";
 681             my $borrowerid = newmember(%borrower);
 682         }
 683
 684         #
 685         # CREATE or MODIFY PASSWORD/LOGIN
 686         #
 687         # search borrowerid
 688         $sth =
 689           $dbh->prepare(
 690             "select borrowernumber from borrowers where cardnumber=?");
 691         $sth->execute($userid);
 692         my ($borrowerid) = $sth->fetchrow;
 693
 694         #               warn "change password for $borrowerid setting $password";
 695         my $digest = md5_base64($password);
 696         changepassword( $userid, $borrowerid, $digest );
 697     }
 698
 699     # INTERNAL AUTH
 700     my $sth =
 701       $dbh->prepare("select password,cardnumber from borrowers where userid=?");
 702     $sth->execute($userid);
 703     if ( $sth->rows ) {
 704         my ( $md5password, $cardnumber ) = $sth->fetchrow;
 705         if ( md5_base64($password) eq $md5password ) {
 706             return 1, $cardnumber;
 707         }
 708     }
 709     $sth = $dbh->prepare("select password from borrowers where cardnumber=?");
 710     $sth->execute($userid);
 711     if ( $sth->rows ) {
 712         my ($md5password) = $sth->fetchrow;
 713         if ( md5_base64($password) eq $md5password ) {
 714             return 1, $userid;
 715         }
 716     }
 717     return 0;
 718 }
 719
 720 sub getuserflags {
 721     my $cardnumber = shift;
 722     my $dbh        = shift;
 723     my $userflags;
 724     my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
 725     $sth->execute($cardnumber);
 726     my ($flags) = $sth->fetchrow;
 727     $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
 728     $sth->execute;
 729
 730     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
 731         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
 732             $userflags->{$flag} = 1;
 733         }
 734     }
 735     return $userflags;
 736 }
 737
 738 sub haspermission {
 739     my ( $dbh, $userid, $flagsrequired ) = @_;
 740     my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
 741     $sth->execute($userid);
 742     my ($cardnumber) = $sth->fetchrow;
 743     ($cardnumber) || ( $cardnumber = $userid );
 744     my $flags = getuserflags( $cardnumber, $dbh );
 745     my $configfile;
 746     if ( $userid eq C4::Context->config('user') ) {
 747
 748         # Super User Account from /etc/koha.conf
 749         $flags->{'superlibrarian'} = 1;
 750     }
 751     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
 752
 753         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
 754         $flags->{'superlibrarian'} = 1;
 755     }
 756     return $flags if $flags->{superlibrarian};
 757     foreach ( keys %$flagsrequired ) {
 758         return $flags if $flags->{$_};
 759     }
 760     return 0;
 761 }
 762
 763 sub getborrowernumber {
 764     my ($userid) = @_;
 765     my $dbh = C4::Context->dbh;
 766     for my $field ( 'userid', 'cardnumber' ) {
 767         my $sth =
 768           $dbh->prepare("select borrowernumber from borrowers where $field=?");
 769         $sth->execute($userid);
 770         if ( $sth->rows ) {
 771             my ($bnumber) = $sth->fetchrow;
 772             return $bnumber;
 773         }
 774     }
 775     return 0;
 776 }
 777
 778 END { }    # module clean-up code here (global destructor)
 779 1;
 780 __END__
 781
 782 =back
 783
 784 =head1 SEE ALSO
 785
 786 CGI(3)
 787
 788 C4::Output(3)
 789
 790 Digest::MD5(3)
 791
 792 =cut