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