koha-dev.rot13.org Git - koha_fer/blob - C4/Auth.pm

   1
   2 # -*- tab-width: 8 -*-
   3 # NOTE: This file uses 8-character tabs; do not change the tab size!
   4
   5 package C4::Auth;
   6
   7 # Copyright 2000-2002 Katipo Communications
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it under the
  12 # terms of the GNU General Public License as published by the Free Software
  13 # Foundation; either version 2 of the License, or (at your option) any later
  14 # version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  18 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License along with
  21 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  22 # Suite 330, Boston, MA  02111-1307 USA
  23
  24 use strict;
  25 use Digest::MD5 qw(md5_base64);
  26 use CGI::Session;
  27
  28 require Exporter;
  29 use C4::Context;
  30 use C4::Output;    # to get the template
  31 use C4::Members;
  32 use C4::Koha;
  33 use C4::Branch; # GetBranches
  34
  35 # use utf8;
  36 # use Net::LDAP;
  37 # use Net::LDAP qw(:all);
  38
  39 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  40
  41 # set the version for version checking
  42 $VERSION = 3.00;
  43
  44 =head1 NAME
  45
  46 C4::Auth - Authenticates Koha users
  47
  48 =head1 SYNOPSIS
  49
  50   use CGI;
  51   use C4::Auth;
  52
  53   my $query = new CGI;
  54
  55   my ($template, $borrowernumber, $cookie)
  56     = get_template_and_user(
  57         {
  58             template_name   => "opac-main.tmpl",
  59             query           => $query,
  60       type            => "opac",
  61       authnotrequired => 1,
  62       flagsrequired   => {borrow => 1},
  63   }
  64     );
  65
  66   print $query->header(
  67     -type => 'utf-8',
  68     -cookie => $cookie
  69   ), $template->output;
  70
  71
  72 =head1 DESCRIPTION
  73
  74     The main function of this module is to provide
  75     authentification. However the get_template_and_user function has
  76     been provided so that a users login information is passed along
  77     automatically. This gets loaded into the template.
  78
  79 =head1 FUNCTIONS
  80
  81 =over 2
  82
  83 =cut
  84
  85 @ISA    = qw(Exporter);
  86 @EXPORT = qw(
  87   &checkauth
  88   &get_template_and_user
  89 );
  90 @EXPORT_OK = qw(
  91   &check_api_auth
  92   &get_session
  93   &check_cookie_auth
  94 );
  95
  96 =item get_template_and_user
  97
  98   my ($template, $borrowernumber, $cookie)
  99     = get_template_and_user(
 100         {
 101            template_name   => "opac-main.tmpl",
 102            query           => $query,
 103      type            => "opac",
 104      authnotrequired => 1,
 105      flagsrequired   => {borrow => 1},
 106   }
 107     );
 108
 109     This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
 110     to C<&checkauth> (in this module) to perform authentification.
 111     See C<&checkauth> for an explanation of these parameters.
 112
 113     The C<template_name> is then used to find the correct template for
 114     the page. The authenticated users details are loaded onto the
 115     template in the HTML::Template LOOP variable C<USER_INFO>. Also the
 116     C<sessionID> is passed to the template. This can be used in templates
 117     if cookies are disabled. It needs to be put as and input to every
 118     authenticated page.
 119
 120     More information on the C<gettemplate> sub can be found in the
 121     Output.pm module.
 122
 123 =cut
 124
 125 sub get_template_and_user {
 126     my $in       = shift;
 127     my $template =
 128       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 129     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 130         $in->{'query'},
 131         $in->{'authnotrequired'},
 132         $in->{'flagsrequired'},
 133         $in->{'type'}
 134     ) unless ($in->{'template_name'}=~/maintenance/);
 135
 136     my $borrowernumber;
 137     my $insecure = C4::Context->preference('insecure');
 138     if ($user or $insecure) {
 139
 140                 # load the template variables for stylesheets and JavaScript
 141                 $template->param( css_libs => $in->{'css_libs'} );
 142                 $template->param( css_module => $in->{'css_module'} );
 143                 $template->param( css_page => $in->{'css_page'} );
 144                 $template->param( css_widgets => $in->{'css_widgets'} );
 145
 146         $template->param( js_libs => $in->{'js_libs'} );
 147         $template->param( js_module => $in->{'js_module'} );
 148         $template->param( js_page => $in->{'js_page'} );
 149         $template->param( js_widgets => $in->{'js_widgets'} );
 150
 151                 # user info
 152         $template->param( loggedinusername => $user );
 153         $template->param( sessionID        => $sessionID );
 154
 155         $borrowernumber = getborrowernumber($user);
 156         my ( $borr, $alternativeflags ) =
 157           GetMemberDetails( $borrowernumber );
 158         my @bordat;
 159         $bordat[0] = $borr;
 160         $template->param( "USER_INFO" => \@bordat );
 161
 162         # We are going to use the $flags returned by checkauth
 163         # to create the template's parameters that will indicate
 164         # which menus the user can access.
 165         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
 166             $template->param( CAN_user_circulate        => 1 );
 167             $template->param( CAN_user_catalogue        => 1 );
 168             $template->param( CAN_user_parameters       => 1 );
 169             $template->param( CAN_user_borrowers        => 1 );
 170             $template->param( CAN_user_permission       => 1 );
 171             $template->param( CAN_user_reserveforothers => 1 );
 172             $template->param( CAN_user_borrow           => 1 );
 173             $template->param( CAN_user_editcatalogue    => 1 );
 174             $template->param( CAN_user_updatecharge     => 1 );
 175             $template->param( CAN_user_acquisition      => 1 );
 176             $template->param( CAN_user_management       => 1 );
 177             $template->param( CAN_user_tools            => 1 );
 178             $template->param( CAN_user_editauthorities  => 1 );
 179             $template->param( CAN_user_serials          => 1 );
 180             $template->param( CAN_user_reports          => 1 );
 181             $template->param( CAN_user_staffaccess              => 1 );
 182         }
 183
 184         if ( $flags && $flags->{circulate} == 1 ) {
 185             $template->param( CAN_user_circulate => 1 );
 186         }
 187
 188         if ( $flags && $flags->{catalogue} == 1 ) {
 189             $template->param( CAN_user_catalogue => 1 );
 190         }
 191
 192         if ( $flags && $flags->{parameters} == 1 ) {
 193             $template->param( CAN_user_parameters => 1 );
 194             $template->param( CAN_user_management => 1 );
 195         }
 196
 197         if ( $flags && $flags->{borrowers} == 1 ) {
 198             $template->param( CAN_user_borrowers => 1 );
 199         }
 200
 201         if ( $flags && $flags->{permissions} == 1 ) {
 202             $template->param( CAN_user_permission => 1 );
 203         }
 204
 205         if ( $flags && $flags->{reserveforothers} == 1 ) {
 206             $template->param( CAN_user_reserveforothers => 1 );
 207         }
 208
 209         if ( $flags && $flags->{borrow} == 1 ) {
 210             $template->param( CAN_user_borrow => 1 );
 211         }
 212
 213         if ( $flags && $flags->{editcatalogue} == 1 ) {
 214             $template->param( CAN_user_editcatalogue => 1 );
 215         }
 216
 217         if ( $flags && $flags->{updatecharges} == 1 ) {
 218             $template->param( CAN_user_updatecharge => 1 );
 219         }
 220
 221         if ( $flags && $flags->{acquisition} == 1 ) {
 222             $template->param( CAN_user_acquisition => 1 );
 223         }
 224
 225         if ( $flags && $flags->{tools} == 1 ) {
 226             $template->param( CAN_user_tools => 1 );
 227         }
 228
 229         if ( $flags && $flags->{editauthorities} == 1 ) {
 230             $template->param( CAN_user_editauthorities => 1 );
 231         }
 232
 233         if ( $flags && $flags->{serials} == 1 ) {
 234             $template->param( CAN_user_serials => 1 );
 235         }
 236
 237         if ( $flags && $flags->{reports} == 1 ) {
 238             $template->param( CAN_user_reports => 1 );
 239         }
 240         if ( $flags && $flags->{staffaccess} == 1 ) {
 241             $template->param( CAN_user_staffaccess => 1 );
 242         }
 243     }
 244     if ( $in->{'type'} eq "intranet" ) {
 245         $template->param(
 246             intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
 247             intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 248             IntranetNav        => C4::Context->preference("IntranetNav"),
 249             intranetuserjs     => C4::Context->preference("intranetuserjs"),
 250             TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 251             AmazonContent      => C4::Context->preference("AmazonContent"),
 252             LibraryName        => C4::Context->preference("LibraryName"),
 253             LoginBranchcode    => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 254             LoginBranchname    => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
 255             LoginFirstname     => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 256             LoginSurname       => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 257             AutoLocation       => C4::Context->preference("AutoLocation"),
 258             hide_marc          => C4::Context->preference("hide_marc"),
 259             patronimages       => C4::Context->preference("patronimages"),
 260             "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
 261             advancedMARCEditor      => C4::Context->preference("advancedMARCEditor"),
 262             suggestion              => C4::Context->preference("suggestion"),
 263             virtualshelves          => C4::Context->preference("virtualshelves"),
 264             LibraryName             => C4::Context->preference("LibraryName"),
 265             KohaAdminEmailAddress   => "" . C4::Context->preference("KohaAdminEmailAddress"),
 266             IntranetmainUserblock       => C4::Context->preference("IntranetmainUserblock"),
 267             IndependantBranches     => C4::Context->preference("IndependantBranches"),
 268                         CircAutocompl => C4::Context->preference("CircAutocompl"),
 269                         yuipath => C4::Context->preference("yuipath"),
 270                         FRBRizeEditions => C4::Context->preference("FRBRizeEditions"),
 271                         AmazonSimilarItems => C4::Context->preference("AmazonSimilarItems"),
 272         );
 273     }
 274     else {
 275         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 276         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 277         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 278         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 279   $template->param(
 280             KohaAdminEmailAddress  => "" . C4::Context->preference("KohaAdminEmailAddress"),
 281                         AnonSuggestions =>  "" . C4::Context->preference("AnonSuggestions"),
 282             suggestion             => "" . C4::Context->preference("suggestion"),
 283             virtualshelves         => "" . C4::Context->preference("virtualshelves"),
 284             OpacNav                => "" . C4::Context->preference("OpacNav"),
 285             opacheader             => "" . C4::Context->preference("opacheader"),
 286             opaccredits            => "" . C4::Context->preference("opaccredits"),
 287             opacsmallimage         => "" . C4::Context->preference("opacsmallimage"),
 288             opaclargeimage         => "" . C4::Context->preference("opaclargeimage"),
 289             opaclayoutstylesheet   => "". C4::Context->preference("opaclayoutstylesheet"),
 290             opaccolorstylesheet    => "". C4::Context->preference("opaccolorstylesheet"),
 291             opaclanguagesdisplay   => "". C4::Context->preference("opaclanguagesdisplay"),
 292             opacuserlogin          => "" . C4::Context->preference("opacuserlogin"),
 293             opacbookbag            => "" . C4::Context->preference("opacbookbag"),
 294             TemplateEncoding       => "". C4::Context->preference("TemplateEncoding"),
 295             AmazonContent          => "" . C4::Context->preference("AmazonContent"),
 296             LibraryName            => "" . C4::Context->preference("LibraryName"),
 297             LibraryNameTitle       => "" . $LibraryNameTitle,
 298             LoginBranchcode        => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 299             LoginBranchname        => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 300             LoginFirstname        => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 301             LoginSurname        => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 302             OpacPasswordChange     => C4::Context->preference("OpacPasswordChange"),
 303             opacreadinghistory     => C4::Context->preference("opacreadinghistory"),
 304             opacuserjs             => C4::Context->preference("opacuserjs"),
 305             OpacCloud              => C4::Context->preference("OpacCloud"),
 306             OpacTopissue           => C4::Context->preference("OpacTopissue"),
 307             OpacAuthorities        => C4::Context->preference("OpacAuthorities"),
 308             OpacBrowser            => C4::Context->preference("OpacBrowser"),
 309             RequestOnOpac          => C4::Context->preference("RequestOnOpac"),
 310             reviewson              => C4::Context->preference("reviewson"),
 311             hide_marc              => C4::Context->preference("hide_marc"),
 312             patronimages           => C4::Context->preference("patronimages"),
 313             mylibraryfirst   => C4::Context->preference("SearchMyLibraryFirst"),
 314             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
 315                         OPACFRBRizeEditions => C4::Context->preference("OPACFRBRizeEditions"),
 316         );
 317     }
 318     return ( $template, $borrowernumber, $cookie );
 319 }
 320
 321 =item checkauth
 322
 323   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 324
 325 Verifies that the user is authorized to run this script.  If
 326 the user is authorized, a (userid, cookie, session-id, flags)
 327 quadruple is returned.  If the user is not authorized but does
 328 not have the required privilege (see $flagsrequired below), it
 329 displays an error page and exits.  Otherwise, it displays the
 330 login page and exits.
 331
 332 Note that C<&checkauth> will return if and only if the user
 333 is authorized, so it should be called early on, before any
 334 unfinished operations (e.g., if you've opened a file, then
 335 C<&checkauth> won't close it for you).
 336
 337 C<$query> is the CGI object for the script calling C<&checkauth>.
 338
 339 The C<$noauth> argument is optional. If it is set, then no
 340 authorization is required for the script.
 341
 342 C<&checkauth> fetches user and session information from C<$query> and
 343 ensures that the user is authorized to run scripts that require
 344 authorization.
 345
 346 The C<$flagsrequired> argument specifies the required privileges
 347 the user must have if the username and password are correct.
 348 It should be specified as a reference-to-hash; keys in the hash
 349 should be the "flags" for the user, as specified in the Members
 350 intranet module. Any key specified must correspond to a "flag"
 351 in the userflags table. E.g., { circulate => 1 } would specify
 352 that the user must have the "circulate" privilege in order to
 353 proceed. To make sure that access control is correct, the
 354 C<$flagsrequired> parameter must be specified correctly.
 355
 356 The C<$type> argument specifies whether the template should be
 357 retrieved from the opac or intranet directory tree.  "opac" is
 358 assumed if it is not specified; however, if C<$type> is specified,
 359 "intranet" is assumed if it is not "opac".
 360
 361 If C<$query> does not have a valid session ID associated with it
 362 (i.e., the user has not logged in) or if the session has expired,
 363 C<&checkauth> presents the user with a login page (from the point of
 364 view of the original script, C<&checkauth> does not return). Once the
 365 user has authenticated, C<&checkauth> restarts the original script
 366 (this time, C<&checkauth> returns).
 367
 368 The login page is provided using a HTML::Template, which is set in the
 369 systempreferences table or at the top of this file. The variable C<$type>
 370 selects which template to use, either the opac or the intranet
 371 authentification template.
 372
 373 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 374 cookie should be sent back to the browser; it verifies that the user
 375 has authenticated.
 376
 377 =cut
 378
 379 sub checkauth {
 380     my $query = shift;
 381   # warn "Checking Auth";
 382     # $authnotrequired will be set for scripts which will run without authentication
 383     my $authnotrequired = shift;
 384     my $flagsrequired   = shift;
 385     my $type            = shift;
 386     $type = 'opac' unless $type;
 387
 388     my $dbh     = C4::Context->dbh;
 389     my $timeout = C4::Context->preference('timeout');
 390         # days
 391         if ($timeout =~ /(\d*)[dD]/) {
 392                 $timeout = $1 * 86400;
 393     };
 394         $timeout = 600 unless $timeout;
 395
 396     # If Version syspref is unavailable, it means Koha is beeing installed,
 397     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 398     #warn "about to check version";
 399     unless (C4::Context->preference('Version')) {
 400       if ($type ne 'opac') {
 401         warn "Install required, redirecting to Installer";
 402         print $query->redirect("/cgi-bin/koha/installer/install.pl");
 403       }
 404       else {
 405         warn "OPAC Install required, redirecting to maintenance";
 406         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 407       }
 408       exit;
 409     }
 410
 411
 412     # state variables
 413     my $loggedin = 0;
 414     my %info;
 415     my ( $userid, $cookie, $sessionID, $flags );
 416     my $logout = $query->param('logout.x');
 417     if ( $userid = $ENV{'REMOTE_USER'} ) {
 418         # Using Basic Authentication, no cookies required
 419         $cookie = $query->cookie(
 420             -name    => 'CGISESSID',
 421             -value   => '',
 422             -expires => ''
 423         );
 424         $loggedin = 1;
 425     }
 426     elsif ( $sessionID = $query->cookie("CGISESSID")) {
 427         my $session = get_session($sessionID);
 428         C4::Context->_new_userenv($sessionID);
 429         if ($session){
 430             C4::Context::set_userenv(
 431                 $session->param('number'),       $session->param('id'),
 432                 $session->param('cardnumber'),   $session->param('firstname'),
 433                 $session->param('surname'),      $session->param('branch'),
 434                 $session->param('branchname'),   $session->param('flags'),
 435                 $session->param('emailaddress'), $session->param('branchprinter')
 436             );
 437 #             warn       "".$session->param('cardnumber').",   ".$session->param('firstname').",
 438 #                 ".$session->param('surname').",      ".$session->param('branch');
 439         }
 440         my $ip;
 441         my $lasttime;
 442         if ($session) {
 443           $ip = $session->param('ip');
 444           $lasttime = $session->param('lasttime');
 445                 $userid = $session->param('id');
 446         }
 447
 448
 449         if ($logout) {
 450
 451             # voluntary logout the user
 452
 453             $session->flush;
 454                         $session->delete();
 455             C4::Context->_unset_userenv($sessionID);
 456             $sessionID = undef;
 457             $userid    = undef;
 458             open L, ">>/tmp/sessionlog";
 459             my $time = localtime( time() );
 460             printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
 461               $ip, $time;
 462             close L;
 463         }
 464         if ($userid) {
 465             if ( $lasttime < time() - $timeout ) {
 466                 # timed logout
 467                 $info{'timed_out'} = 1;
 468                 $session->delete();
 469                 C4::Context->_unset_userenv($sessionID);
 470                 $userid    = undef;
 471                 $sessionID = undef;
 472                 open L, ">>/tmp/sessionlog";
 473                 my $time = localtime( time() );
 474                 printf L "%20s from %16s logged out at %30s (inactivity).\n",
 475                   $userid, $ip, $time;
 476                 close L;
 477             }
 478             elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 479                 # Different ip than originally logged in from
 480                 $info{'oldip'}        = $ip;
 481                 $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 482                 $info{'different_ip'} = 1;
 483         $session->delete();
 484                 C4::Context->_unset_userenv($sessionID);
 485                 $sessionID = undef;
 486                 $userid    = undef;
 487                 open L, ">>/tmp/sessionlog";
 488                 my $time = localtime( time() );
 489                 printf L
 490 "%20s from logged out at %30s (ip changed from %16s to %16s).\n",
 491                   $userid, $time, $ip, $info{'newip'};
 492                 close L;
 493             }
 494             else {
 495                 $cookie = $query->cookie( CGISESSID => $session->id );
 496                 $session->param('lasttime',time());
 497                 $flags = haspermission( $dbh, $userid, $flagsrequired );
 498                 if ($flags) {
 499                     $loggedin = 1;
 500                 }
 501                 else {
 502                     $info{'nopermission'} = 1;
 503                 }
 504             }
 505         }
 506     }
 507     unless ($userid) {
 508                 my $session = get_session("");
 509
 510         my $sessionID;
 511                 if ($session) {
 512                         $sessionID = $session->id;
 513                 }
 514         $userid    = $query->param('userid');
 515         C4::Context->_new_userenv($sessionID);
 516         my $password = $query->param('password');
 517         C4::Context->_new_userenv($sessionID);
 518         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 519         if ($return) {
 520             open L, ">>/tmp/sessionlog";
 521             my $time = localtime( time() );
 522             printf L "%20s from %16s logged in  at %30s.\n", $userid,
 523               $ENV{'REMOTE_ADDR'}, $time;
 524             close L;
 525             $cookie = $query->cookie(CGISESSID => $sessionID);
 526             if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
 527                 $loggedin = 1;
 528             }
 529             else {
 530                 $info{'nopermission'} = 1;
 531                 C4::Context->_unset_userenv($sessionID);
 532             }
 533             if ( $return == 1 ) {
 534                 my (
 535                     $borrowernumber, $firstname,  $surname,
 536                     $userflags,      $branchcode, $branchname,
 537                     $branchprinter,  $emailaddress
 538                 );
 539                 my $sth =
 540                   $dbh->prepare(
 541 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
 542                   );
 543                 $sth->execute($userid);
 544                 (
 545                     $borrowernumber, $firstname,  $surname,
 546                     $userflags,      $branchcode, $branchname,
 547                     $branchprinter,  $emailaddress
 548                   )
 549                   = $sth->fetchrow
 550                   if ( $sth->rows );
 551
 552 #         warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 553                 unless ( $sth->rows ) {
 554                     my $sth =
 555                       $dbh->prepare(
 556 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
 557                       );
 558                     $sth->execute($cardnumber);
 559                     (
 560                         $borrowernumber, $firstname,  $surname,
 561                         $userflags,      $branchcode, $branchname,
 562                         $branchprinter,  $emailaddress
 563                       )
 564                       = $sth->fetchrow
 565                       if ( $sth->rows );
 566
 567 #           warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
 568                     unless ( $sth->rows ) {
 569                         $sth->execute($userid);
 570                         (
 571                             $borrowernumber, $firstname, $surname, $userflags,
 572                             $branchcode, $branchname, $branchprinter, $emailaddress
 573                           )
 574                           = $sth->fetchrow
 575                           if ( $sth->rows );
 576                     }
 577                 }
 578
 579 # launch a sequence to check if we have a ip for the branch, if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 580                 my $ip       = $ENV{'REMOTE_ADDR'};
 581                 # if they specify at login, use that
 582                 if ($query->param('branch')) {
 583                     $branchcode  = $query->param('branch');
 584                     $branchname = GetBranchName($branchcode);
 585                 }
 586                 my $branches = GetBranches();
 587                 my @branchesloop;
 588                 foreach my $br ( keys %$branches ) {
 589                     #     now we work with the treatment of ip
 590                     my $domain = $branches->{$br}->{'branchip'};
 591                     if ( $domain && $ip =~ /^$domain/ ) {
 592                         $branchcode = $branches->{$br}->{'branchcode'};
 593
 594                         # new op dev : add the branchprinter and branchname in the cookie
 595                         $branchprinter = $branches->{$br}->{'branchprinter'};
 596                         $branchname    = $branches->{$br}->{'branchname'};
 597                     }
 598                 }
 599                 $session->param('number',$borrowernumber);
 600                 $session->param('id',$userid);
 601                 $session->param('cardnumber',$cardnumber);
 602                 $session->param('firstname',$firstname);
 603                 $session->param('surname',$surname);
 604                 $session->param('branch',$branchcode);
 605                 $session->param('branchname',$branchname);
 606                 $session->param('flags',$userflags);
 607                 $session->param('emailaddress',$emailaddress);
 608                 $session->param('ip',$session->remote_addr());
 609                 $session->param('lasttime',time());
 610 #            warn       "".$session->param('cardnumber').",   ".$session->param('firstname').",
 611 #                 ".$session->param('surname').",      ".$session->param('branch');
 612             }
 613             elsif ( $return == 2 ) {
 614                 #We suppose the user is the superlibrarian
 615                         $session->param('number',0);
 616                         $session->param('id',C4::Context->config('user'));
 617                         $session->param('cardnumber',C4::Context->config('user'));
 618                         $session->param('firstname',C4::Context->config('user'));
 619                         $session->param('surname',C4::Context->config('user'));
 620                         $session->param('branch','NO_LIBRARY_SET');
 621                         $session->param('branchname','NO_LIBRARY_SET');
 622                         $session->param('flags',1);
 623                         $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 624                         $session->param('ip',$session->remote_addr());
 625                         $session->param('lasttime',time());
 626                 }
 627                 if ($session){
 628                     C4::Context::set_userenv(
 629                         $session->param('number'),       $session->param('id'),
 630                         $session->param('cardnumber'),   $session->param('firstname'),
 631                         $session->param('surname'),      $session->param('branch'),
 632                         $session->param('branchname'),   $session->param('flags'),
 633                         $session->param('emailaddress'), $session->param('branchprinter')
 634                     );
 635                 }
 636         }
 637
 638         else {
 639             if ($userid) {
 640                 $info{'invalid_username_or_password'} = 1;
 641                 C4::Context->_unset_userenv($sessionID);
 642             }
 643         }
 644     }
 645     my $insecure = C4::Context->boolean_preference('insecure');
 646
 647     # finished authentification, now respond
 648     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
 649     {
 650         # successful login
 651         unless ($cookie) {
 652             $cookie = $query->cookie( CGISESSID => ''
 653             );
 654         }
 655     return ( $userid, $cookie, $sessionID, $flags );
 656
 657     }
 658
 659 #
 660 #
 661 # AUTH rejected, show the login/password template, after checking the DB.
 662 #
 663 #
 664
 665     # get the inputs from the incoming query
 666     my @inputs = ();
 667     foreach my $name ( param $query) {
 668         (next) if ( $name eq 'userid' || $name eq 'password' );
 669         my $value = $query->param($name);
 670         push @inputs, { name => $name, value => $value };
 671     }
 672     # get the branchloop, which we need for authentication
 673     my $branches = GetBranches();
 674     my @branch_loop;
 675     for my $branch_hash (keys %$branches) {
 676                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
 677     }
 678
 679     # check that database and koha version are the same
 680     # there is no DB version, it's a fresh install,
 681     # go to web installer
 682     # there is a DB version, compare it to the code version
 683     my $kohaversion=C4::Context::KOHAVERSION;
 684     # remove the 3 last . to have a Perl number
 685     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 686 #     warn "kohaversion : $kohaversion";
 687     if (C4::Context->preference('Version') < $kohaversion){
 688       if ($type ne 'opac'){
 689       warn "Database update needed, redirecting to Installer. Database is ".C4::Context->preference('Version')." and Koha is : ".C4::Context->config("kohaversion");
 690         print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 691       } else {
 692       warn "OPAC :Database update needed, redirecting to maintenance. Database is ".C4::Context->preference('Version')." and Koha is : ".C4::Context->config("kohaversion");
 693         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 694       }
 695       exit;
 696     }
 697     my $template_name;
 698     if ( $type eq 'opac' ) {
 699         $template_name = "opac-auth.tmpl";
 700     }
 701     else {
 702         $template_name = "auth.tmpl";
 703     }
 704     my $template = gettemplate( $template_name, $type, $query );
 705     $template->param(branchloop => \@branch_loop,);
 706     $template->param(
 707     login        => 1,
 708         INPUTS               => \@inputs,
 709         suggestion           => C4::Context->preference("suggestion"),
 710         virtualshelves       => C4::Context->preference("virtualshelves"),
 711         opaclargeimage       => C4::Context->preference("opaclargeimage"),
 712         LibraryName          => C4::Context->preference("LibraryName"),
 713         OpacNav              => C4::Context->preference("OpacNav"),
 714         opaccredits          => C4::Context->preference("opaccredits"),
 715         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
 716         opacsmallimage       => C4::Context->preference("opacsmallimage"),
 717         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
 718         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
 719         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
 720         opacuserjs           => C4::Context->preference("opacuserjs"),
 721
 722         intranetcolorstylesheet =>
 723           C4::Context->preference("intranetcolorstylesheet"),
 724         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
 725         IntranetNav        => C4::Context->preference("IntranetNav"),
 726         intranetuserjs     => C4::Context->preference("intranetuserjs"),
 727         TemplateEncoding   => C4::Context->preference("TemplateEncoding"),
 728         IndependantBranches     => C4::Context->preference("IndependantBranches"),
 729                 AutoLocation       => C4::Context->preference("AutoLocation"),
 730     );
 731     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
 732
 733     my $self_url = $query->url( -absolute => 1 );
 734     $template->param(
 735         url         => $self_url,
 736         LibraryName => => C4::Context->preference("LibraryName"),
 737     );
 738     $template->param( \%info );
 739 #    $cookie = $query->cookie(CGISESSID => $session->id
 740 #   );
 741     print $query->header(
 742                 -type   => 'text/html',
 743         -charset => 'utf-8',
 744         -cookie => $cookie
 745       ),
 746       $template->output;
 747     exit;
 748 }
 749
 750 =item check_api_auth
 751
 752   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
 753
 754 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
 755 cookie, determine if the user has the privileges specified by C<$userflags>.
 756
 757 C<check_api_auth> is is meant for authenticating users of web services, and
 758 consequently will always return and will not attempt to redirect the user
 759 agent.
 760
 761 If a valid session cookie is already present, check_api_auth will return a status
 762 of "ok", the cookie, and the Koha session ID.
 763
 764 If no session cookie is present, check_api_auth will check the 'userid' and 'password
 765 parameters and create a session cookie and Koha session if the supplied credentials
 766 are OK.
 767
 768 Possible return values in C<$status> are:
 769
 770 =over 4
 771
 772 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
 773
 774 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
 775
 776 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 777
 778 =item "expired -- session cookie has expired; API user should resubmit userid and password
 779
 780 =back
 781
 782 =cut
 783
 784 sub check_api_auth {
 785     my $query = shift;
 786     my $flagsrequired = shift;
 787
 788     my $dbh     = C4::Context->dbh;
 789     my $timeout = C4::Context->preference('timeout');
 790     $timeout = 600 unless $timeout;
 791
 792     unless (C4::Context->preference('Version')) {
 793         # database has not been installed yet
 794         return ("maintenance", undef, undef);
 795     }
 796     my $kohaversion=C4::Context::KOHAVERSION;
 797     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 798     if (C4::Context->preference('Version') < $kohaversion) {
 799         # database in need of version update; assume that
 800         # no API should be called while databsae is in
 801         # this condition.
 802         return ("maintenance", undef, undef);
 803     }
 804
 805     # FIXME -- most of what follows is a copy-and-paste
 806     # of code from checkauth.  There is an obvious need
 807     # for refactoring to separate the various parts of
 808     # the authentication code, but as of 2007-11-19 this
 809     # is deferred so as to not introduce bugs into the
 810     # regular authentication code for Koha 3.0.
 811
 812     # see if we have a valid session cookie already
 813     # however, if a userid parameter is present (i.e., from
 814     # a form submission, assume that any current cookie
 815     # is to be ignored
 816     my $sessionID = undef;
 817     unless ($query->param('userid')) {
 818         $sessionID = $query->cookie("CGISESSID");
 819     }
 820     if ($sessionID) {
 821         my $session = get_session($sessionID);
 822         C4::Context->_new_userenv($sessionID);
 823         if ($session) {
 824             C4::Context::set_userenv(
 825                 $session->param('number'),       $session->param('id'),
 826                 $session->param('cardnumber'),   $session->param('firstname'),
 827                 $session->param('surname'),      $session->param('branch'),
 828                 $session->param('branchname'),   $session->param('flags'),
 829                 $session->param('emailaddress'), $session->param('branchprinter')
 830             );
 831
 832             my $ip = $session->param('ip');
 833             my $lasttime = $session->param('lasttime');
 834             my $userid = $session->param('id');
 835             if ( $lasttime < time() - $timeout ) {
 836                 # time out
 837                 $session->delete();
 838                 C4::Context->_unset_userenv($sessionID);
 839                 $userid    = undef;
 840                 $sessionID = undef;
 841                 return ("expired", undef, undef);
 842             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 843                 # IP address changed
 844                 $session->delete();
 845                 C4::Context->_unset_userenv($sessionID);
 846                 $userid    = undef;
 847                 $sessionID = undef;
 848                 return ("expired", undef, undef);
 849             } else {
 850                 my $cookie = $query->cookie( CGISESSID => $session->id );
 851                 $session->param('lasttime',time());
 852                 my $flags = haspermission( $dbh, $userid, $flagsrequired );
 853                 if ($flags) {
 854                     return ("ok", $cookie, $sessionID);
 855                 } else {
 856                     $session->delete();
 857                     C4::Context->_unset_userenv($sessionID);
 858                     $userid    = undef;
 859                     $sessionID = undef;
 860                     return ("failed", undef, undef);
 861                 }
 862             }
 863         } else {
 864             return ("expired", undef, undef);
 865         }
 866     } else {
 867         # new login
 868         my $userid = $query->param('userid');
 869         my $password = $query->param('password');
 870         unless ($userid and $password) {
 871             # caller did something wrong, fail the authenticateion
 872             return ("failed", undef, undef);
 873         }
 874         my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
 875         if ($return and haspermission( $dbh, $userid, $flagsrequired)) {
 876             my $session = get_session("");
 877             return ("failed", undef, undef) unless $session;
 878
 879             my $sessionID = $session->id;
 880             C4::Context->_new_userenv($sessionID);
 881             my $cookie = $query->cookie(CGISESSID => $sessionID);
 882             if ( $return == 1 ) {
 883                 my (
 884                     $borrowernumber, $firstname,  $surname,
 885                     $userflags,      $branchcode, $branchname,
 886                     $branchprinter,  $emailaddress
 887                 );
 888                 my $sth =
 889                   $dbh->prepare(
 890 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
 891                   );
 892                 $sth->execute($userid);
 893                 (
 894                     $borrowernumber, $firstname,  $surname,
 895                     $userflags,      $branchcode, $branchname,
 896                     $branchprinter,  $emailaddress
 897                 ) = $sth->fetchrow if ( $sth->rows );
 898
 899                 unless ($sth->rows ) {
 900                     my $sth = $dbh->prepare(
 901 "select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
 902                       );
 903                     $sth->execute($cardnumber);
 904                     (
 905                         $borrowernumber, $firstname,  $surname,
 906                         $userflags,      $branchcode, $branchname,
 907                         $branchprinter,  $emailaddress
 908                     ) = $sth->fetchrow if ( $sth->rows );
 909
 910                     unless ( $sth->rows ) {
 911                         $sth->execute($userid);
 912                         (
 913                             $borrowernumber, $firstname, $surname, $userflags,
 914                             $branchcode, $branchname, $branchprinter, $emailaddress
 915                         ) = $sth->fetchrow if ( $sth->rows );
 916                     }
 917                 }
 918
 919                 my $ip       = $ENV{'REMOTE_ADDR'};
 920                 # if they specify at login, use that
 921                 if ($query->param('branch')) {
 922                     $branchcode  = $query->param('branch');
 923                     $branchname = GetBranchName($branchcode);
 924                 }
 925                 my $branches = GetBranches();
 926                 my @branchesloop;
 927                 foreach my $br ( keys %$branches ) {
 928                     #     now we work with the treatment of ip
 929                     my $domain = $branches->{$br}->{'branchip'};
 930                     if ( $domain && $ip =~ /^$domain/ ) {
 931                         $branchcode = $branches->{$br}->{'branchcode'};
 932
 933                         # new op dev : add the branchprinter and branchname in the cookie
 934                         $branchprinter = $branches->{$br}->{'branchprinter'};
 935                         $branchname    = $branches->{$br}->{'branchname'};
 936                     }
 937                 }
 938                 $session->param('number',$borrowernumber);
 939                 $session->param('id',$userid);
 940                 $session->param('cardnumber',$cardnumber);
 941                 $session->param('firstname',$firstname);
 942                 $session->param('surname',$surname);
 943                 $session->param('branch',$branchcode);
 944                 $session->param('branchname',$branchname);
 945                 $session->param('flags',$userflags);
 946                 $session->param('emailaddress',$emailaddress);
 947                 $session->param('ip',$session->remote_addr());
 948                 $session->param('lasttime',time());
 949             } elsif ( $return == 2 ) {
 950                 #We suppose the user is the superlibrarian
 951                 $session->param('number',0);
 952                 $session->param('id',C4::Context->config('user'));
 953                 $session->param('cardnumber',C4::Context->config('user'));
 954                 $session->param('firstname',C4::Context->config('user'));
 955                 $session->param('surname',C4::Context->config('user'));
 956                 $session->param('branch','NO_LIBRARY_SET');
 957                 $session->param('branchname','NO_LIBRARY_SET');
 958                 $session->param('flags',1);
 959                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 960                 $session->param('ip',$session->remote_addr());
 961                 $session->param('lasttime',time());
 962             }
 963             C4::Context::set_userenv(
 964                 $session->param('number'),       $session->param('id'),
 965                 $session->param('cardnumber'),   $session->param('firstname'),
 966                 $session->param('surname'),      $session->param('branch'),
 967                 $session->param('branchname'),   $session->param('flags'),
 968                 $session->param('emailaddress'), $session->param('branchprinter')
 969             );
 970             return ("ok", $cookie, $sessionID);
 971         } else {
 972             return ("failed", undef, undef);
 973         }
 974     }
 975 }
 976
 977 =item check_cookie_auth
 978
 979   ($status, $sessionId) = check_api_auth($cookie, $userflags);
 980
 981 Given a CGISESSID cookie set during a previous login to Koha, determine
 982 if the user has the privileges specified by C<$userflags>.
 983
 984 C<check_cookie_auth> is meant for authenticating special services
 985 such as tools/upload-file.pl that are invoked by other pages that
 986 have been authenticated in the usual way.
 987
 988 Possible return values in C<$status> are:
 989
 990 =over 4
 991
 992 =item "ok" -- user authenticated; C<$sessionID> have valid values.
 993
 994 =item "failed" -- credentials are not correct; C<$sessionid> are undef
 995
 996 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
 997
 998 =item "expired -- session cookie has expired; API user should resubmit userid and password
 999
1000 =back
1001
1002 =cut
1003
1004 sub check_cookie_auth {
1005     my $cookie = shift;
1006     my $flagsrequired = shift;
1007
1008     my $dbh     = C4::Context->dbh;
1009     my $timeout = C4::Context->preference('timeout');
1010     $timeout = 600 unless $timeout;
1011
1012     unless (C4::Context->preference('Version')) {
1013         # database has not been installed yet
1014         return ("maintenance", undef);
1015     }
1016     my $kohaversion=C4::Context::KOHAVERSION;
1017     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1018     if (C4::Context->preference('Version') < $kohaversion) {
1019         # database in need of version update; assume that
1020         # no API should be called while databsae is in
1021         # this condition.
1022         return ("maintenance", undef);
1023     }
1024
1025     # FIXME -- most of what follows is a copy-and-paste
1026     # of code from checkauth.  There is an obvious need
1027     # for refactoring to separate the various parts of
1028     # the authentication code, but as of 2007-11-23 this
1029     # is deferred so as to not introduce bugs into the
1030     # regular authentication code for Koha 3.0.
1031
1032     # see if we have a valid session cookie already
1033     # however, if a userid parameter is present (i.e., from
1034     # a form submission, assume that any current cookie
1035     # is to be ignored
1036     unless (defined $cookie and $cookie) {
1037         return ("failed", undef);
1038     }
1039     my $sessionID = $cookie;
1040     my $session = get_session($sessionID);
1041     C4::Context->_new_userenv($sessionID);
1042     if ($session) {
1043         C4::Context::set_userenv(
1044             $session->param('number'),       $session->param('id'),
1045             $session->param('cardnumber'),   $session->param('firstname'),
1046             $session->param('surname'),      $session->param('branch'),
1047             $session->param('branchname'),   $session->param('flags'),
1048             $session->param('emailaddress'), $session->param('branchprinter')
1049         );
1050
1051         my $ip = $session->param('ip');
1052         my $lasttime = $session->param('lasttime');
1053         my $userid = $session->param('id');
1054         if ( $lasttime < time() - $timeout ) {
1055             # time out
1056             $session->delete();
1057             C4::Context->_unset_userenv($sessionID);
1058             $userid    = undef;
1059             $sessionID = undef;
1060             return ("expired", undef);
1061         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1062             # IP address changed
1063             $session->delete();
1064             C4::Context->_unset_userenv($sessionID);
1065             $userid    = undef;
1066             $sessionID = undef;
1067             return ("expired", undef);
1068         } else {
1069             $session->param('lasttime',time());
1070             my $flags = haspermission( $dbh, $userid, $flagsrequired );
1071             if ($flags) {
1072                 return ("ok", $sessionID);
1073             } else {
1074                 $session->delete();
1075                 C4::Context->_unset_userenv($sessionID);
1076                 $userid    = undef;
1077                 $sessionID = undef;
1078                 return ("failed", undef);
1079             }
1080         }
1081     } else {
1082         return ("expired", undef);
1083     }
1084 }
1085
1086 =item get_session
1087
1088   use CGI::Session;
1089   my $session = get_session($sessionID);
1090
1091 Given a session ID, retrieve the CGI::Session object used to store
1092 the session's state.  The session object can be used to store
1093 data that needs to be accessed by different scripts during a
1094 user's session.
1095
1096 If the C<$sessionID> parameter is an empty string, a new session
1097 will be created.
1098
1099 =cut
1100
1101 sub get_session {
1102     my $sessionID = shift;
1103     my $storage_method = C4::Context->preference('SessionStorage');
1104     my $dbh = C4::Context->dbh;
1105     my $session;
1106     if ($storage_method eq 'mysql'){
1107         $session = new CGI::Session("driver:MySQL", $sessionID, {Handle=>$dbh});
1108     }
1109     elsif ($storage_method eq 'Pg') {
1110         $session = new CGI::Session("driver:PostgreSQL", $sessionID, {Handle=>$dbh});
1111     }
1112     else {
1113         # catch all defaults to tmp should work on all systems
1114         $session = new CGI::Session("driver:File", $sessionID, {Directory=>'/tmp'});
1115     }
1116     return $session;
1117 }
1118
1119 sub checkpw {
1120
1121     my ( $dbh, $userid, $password ) = @_;
1122
1123     # INTERNAL AUTH
1124     my $sth =
1125       $dbh->prepare(
1126 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1127       );
1128     $sth->execute($userid);
1129     if ( $sth->rows ) {
1130         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1131             $surname, $branchcode, $flags )
1132           = $sth->fetchrow;
1133         if ( md5_base64($password) eq $md5password ) {
1134
1135             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1136                 $firstname, $surname, $branchcode, $flags );
1137             return 1, $cardnumber;
1138         }
1139     }
1140     $sth =
1141       $dbh->prepare(
1142 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1143       );
1144     $sth->execute($userid);
1145     if ( $sth->rows ) {
1146         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1147             $surname, $branchcode, $flags )
1148           = $sth->fetchrow;
1149         if ( md5_base64($password) eq $md5password ) {
1150
1151             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1152                 $firstname, $surname, $branchcode, $flags );
1153             return 1, $userid;
1154         }
1155     }
1156     if (   $userid && $userid eq C4::Context->config('user')
1157         && "$password" eq C4::Context->config('pass') )
1158     {
1159
1160 # Koha superuser account
1161 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1162         return 2;
1163     }
1164     if (   $userid && $userid eq 'demo'
1165         && "$password" eq 'demo'
1166         && C4::Context->config('demo') )
1167     {
1168
1169 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1170 # some features won't be effective : modify systempref, modify MARC structure,
1171         return 2;
1172     }
1173     return 0;
1174 }
1175
1176 =item getuserflags
1177
1178  $authflags = getuserflags($flags,$dbh);
1179 Translates integer flags into permissions strings hash.
1180
1181 C<$flags> is the integer userflags value ( borrowers.userflags )
1182 C<$authflags> is a hashref of permissions
1183
1184 =cut
1185
1186 sub getuserflags {
1187     my $flags   = shift;
1188     my $dbh     = shift;
1189     my $userflags;
1190         $flags = 0 unless $flags;
1191     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1192     $sth->execute;
1193
1194     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1195         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1196             $userflags->{$flag} = 1;
1197         }
1198         else {
1199             $userflags->{$flag} = 0;
1200         }
1201     }
1202     return $userflags;
1203 }
1204
1205 =item haspermission
1206
1207   $flags = ($dbh,$member,$flagsrequired);
1208
1209 C<$member> may be either userid or overloaded with $borrower hashref from GetMemberDetails.
1210 C<$flags> is a hashref of required flags lik C<$borrower-&lt;{authflags}>
1211
1212 Returns member's flags or 0 if a permission is not met.
1213
1214 =cut
1215
1216 sub haspermission {
1217     my ( $dbh, $userid, $flagsrequired ) = @_;
1218         my ($flags,$intflags);
1219         if(ref($userid)) {
1220                 $intflags = $userid->{'flags'};
1221         } else {
1222             my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1223             $sth->execute($userid);
1224             my ($intflags) = $sth->fetchrow;
1225             $flags = getuserflags( $intflags, $dbh );
1226         }
1227         if ( $userid eq C4::Context->config('user') ) {
1228         # Super User Account from /etc/koha.conf
1229         $flags->{'superlibrarian'} = 1;
1230     }
1231     if ( $userid eq 'demo' && C4::Context->config('demo') ) {
1232         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1233         $flags->{'superlibrarian'} = 1;
1234     }
1235     return $flags if $flags->{superlibrarian};
1236     foreach ( keys %$flagsrequired ) {
1237         return 0 unless( $flags->{$_} );
1238     }
1239     return $flags;
1240         #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1241 }
1242
1243
1244 sub getborrowernumber {
1245     my ($userid) = @_;
1246     my $dbh = C4::Context->dbh;
1247     for my $field ( 'userid', 'cardnumber' ) {
1248         my $sth =
1249           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1250         $sth->execute($userid);
1251         if ( $sth->rows ) {
1252             my ($bnumber) = $sth->fetchrow;
1253             return $bnumber;
1254         }
1255     }
1256     return 0;
1257 }
1258
1259 END { }    # module clean-up code here (global destructor)
1260 1;
1261 __END__
1262
1263 =back
1264
1265 =head1 SEE ALSO
1266
1267 CGI(3)
1268
1269 C4::Output(3)
1270
1271 Digest::MD5(3)
1272
1273 =cut