C4/Auth.pm

   1 package C4::Auth;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 #use warnings; FIXME - Bug 2505
  22 use Digest::MD5 qw(md5_base64);
  23 use Storable qw(thaw freeze);
  24 use URI::Escape;
  25 use CGI::Session;
  26
  27 require Exporter;
  28 use C4::Context;
  29 use C4::Output;    # to get the template
  30 use C4::Members;
  31 use C4::Koha;
  32 use C4::Branch; # GetBranches
  33 use C4::VirtualShelves;
  34 use POSIX qw/strftime/;
  35
  36 use Cache::Memcached;
  37
  38 # use utf8;
  39 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout);
  40
  41 BEGIN {
  42     $VERSION = 3.02;        # set version for version checking
  43     $debug = $ENV{DEBUG};
  44     @ISA   = qw(Exporter);
  45     @EXPORT    = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
  46     @EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &get_all_subpermissions &get_user_subpermissions);
  47     %EXPORT_TAGS = (EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)]);
  48     $ldap = C4::Context->config('useldapserver') || 0;
  49     $cas = C4::Context->preference('casAuthentication');
  50     $caslogout = C4::Context->preference('casLogout');
  51     if ($ldap) {
  52         require C4::Auth_with_ldap;             # no import
  53         import  C4::Auth_with_ldap qw(checkpw_ldap);
  54     }
  55     if ($cas) {
  56         require C4::Auth_with_cas;             # no import
  57         import  C4::Auth_with_cas qw(checkpw_cas login_cas logout_cas login_cas_url);
  58     }
  59
  60 }
  61
  62 =head1 NAME
  63
  64 C4::Auth - Authenticates Koha users
  65
  66 =head1 SYNOPSIS
  67
  68   use CGI;
  69   use C4::Auth;
  70   use C4::Output;
  71
  72   my $query = new CGI;
  73
  74   my ($template, $borrowernumber, $cookie)
  75     = get_template_and_user(
  76         {
  77             template_name   => "opac-main.tmpl",
  78             query           => $query,
  79       type            => "opac",
  80       authnotrequired => 1,
  81       flagsrequired   => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
  82   }
  83     );
  84
  85   output_html_with_http_headers $query, $cookie, $template->output;
  86
  87 =head1 DESCRIPTION
  88
  89 The main function of this module is to provide
  90 authentification. However the get_template_and_user function has
  91 been provided so that a users login information is passed along
  92 automatically. This gets loaded into the template.
  93
  94 =head1 FUNCTIONS
  95
  96 =head2 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, catalogue => '*', tools => 'import_patrons' },
 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 my $SEARCH_HISTORY_INSERT_SQL =<<EOQ;
 126 INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time            )
 127 VALUES                    (     ?,         ?,          ?,         ?,     ?, FROM_UNIXTIME(?))
 128 EOQ
 129 sub get_template_and_user {
 130     my $in       = shift;
 131     my $template =
 132       gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
 133     my ( $user, $cookie, $sessionID, $flags ) = checkauth(
 134         $in->{'query'},
 135         $in->{'authnotrequired'},
 136         $in->{'flagsrequired'},
 137         $in->{'type'}
 138     ) unless ($in->{'template_name'}=~/maintenance/);
 139
 140     my $borrowernumber;
 141     my $insecure = C4::Context->preference('insecure');
 142     if ($user or $insecure) {
 143
 144         # load the template variables for stylesheets and JavaScript
 145         $template->param( css_libs => $in->{'css_libs'} );
 146         $template->param( css_module => $in->{'css_module'} );
 147         $template->param( css_page => $in->{'css_page'} );
 148         $template->param( css_widgets => $in->{'css_widgets'} );
 149
 150         $template->param( js_libs => $in->{'js_libs'} );
 151         $template->param( js_module => $in->{'js_module'} );
 152         $template->param( js_page => $in->{'js_page'} );
 153         $template->param( js_widgets => $in->{'js_widgets'} );
 154
 155         # user info
 156         $template->param( loggedinusername => $user );
 157         $template->param( sessionID        => $sessionID );
 158
 159         my ($total, $pubshelves, $barshelves) = C4::Context->get_shelves_userenv();
 160         if (defined($pubshelves)) {
 161             $template->param( pubshelves     => scalar @{$pubshelves},
 162                               pubshelvesloop => $pubshelves,
 163             );
 164             $template->param( pubtotal   => $total->{'pubtotal'}, ) if ($total->{'pubtotal'} > scalar @{$pubshelves});
 165         }
 166         if (defined($barshelves)) {
 167             $template->param( barshelves      => scalar @{$barshelves},
 168                               barshelvesloop  => $barshelves,
 169             );
 170             $template->param( bartotal  => $total->{'bartotal'}, ) if ($total->{'bartotal'} > scalar @{$barshelves});
 171         }
 172
 173         $borrowernumber = getborrowernumber($user) if defined($user);
 174
 175         my ( $borr ) = GetMemberDetails( $borrowernumber );
 176         my @bordat;
 177         $bordat[0] = $borr;
 178         $template->param( "USER_INFO" => \@bordat );
 179
 180         my $all_perms = get_all_subpermissions();
 181
 182         my @flagroots = qw(circulate catalogue parameters borrowers permissions reserveforothers borrow
 183                             editcatalogue updatecharges management tools editauthorities serials reports acquisition);
 184         # We are going to use the $flags returned by checkauth
 185         # to create the template's parameters that will indicate
 186         # which menus the user can access.
 187         if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
 188             $template->param( CAN_user_circulate        => 1 );
 189             $template->param( CAN_user_catalogue        => 1 );
 190             $template->param( CAN_user_parameters       => 1 );
 191             $template->param( CAN_user_borrowers        => 1 );
 192             $template->param( CAN_user_permissions      => 1 );
 193             $template->param( CAN_user_reserveforothers => 1 );
 194             $template->param( CAN_user_borrow           => 1 );
 195             $template->param( CAN_user_editcatalogue    => 1 );
 196             $template->param( CAN_user_updatecharges     => 1 );
 197             $template->param( CAN_user_acquisition      => 1 );
 198             $template->param( CAN_user_management       => 1 );
 199             $template->param( CAN_user_tools            => 1 );
 200             $template->param( CAN_user_editauthorities  => 1 );
 201             $template->param( CAN_user_serials          => 1 );
 202             $template->param( CAN_user_reports          => 1 );
 203             $template->param( CAN_user_staffaccess      => 1 );
 204             foreach my $module (keys %$all_perms) {
 205                 foreach my $subperm (keys %{ $all_perms->{$module} }) {
 206                     $template->param( "CAN_user_${module}_${subperm}" => 1 );
 207                 }
 208             }
 209         }
 210
 211         if ( $flags ) {
 212             foreach my $module (keys %$all_perms) {
 213                 if ( $flags->{$module} == 1) {
 214                     foreach my $subperm (keys %{ $all_perms->{$module} }) {
 215                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 216                     }
 217                 } elsif ( ref($flags->{$module}) ) {
 218                     foreach my $subperm (keys %{ $flags->{$module} } ) {
 219                         $template->param( "CAN_user_${module}_${subperm}" => 1 );
 220                     }
 221                 }
 222             }
 223         }
 224
 225         if ($flags) {
 226             foreach my $module (keys %$flags) {
 227                 if ( $flags->{$module} == 1 or ref($flags->{$module}) ) {
 228                     $template->param( "CAN_user_$module" => 1 );
 229                     if ($module eq "parameters") {
 230                         $template->param( CAN_user_management => 1 );
 231                     }
 232                 }
 233             }
 234         }
 235                 # Logged-in opac search history
 236                 # If the requested template is an opac one and opac search history is enabled
 237                 if ($in->{type} eq 'opac' && C4::Context->preference('EnableOpacSearchHistory')) {
 238                         my $dbh = C4::Context->dbh;
 239                         my $query = "SELECT COUNT(*) FROM search_history WHERE userid=?";
 240                         my $sth = $dbh->prepare($query);
 241                         $sth->execute($borrowernumber);
 242
 243                         # If at least one search has already been performed
 244                         if ($sth->fetchrow_array > 0) {
 245                         # We show the link in opac
 246                         $template->param(ShowOpacRecentSearchLink => 1);
 247                         }
 248
 249                         # And if there's a cookie with searches performed when the user was not logged in,
 250                         # we add them to the logged-in search history
 251                         my $searchcookie = $in->{'query'}->cookie('KohaOpacRecentSearches');
 252                         if ($searchcookie){
 253                                 $searchcookie = uri_unescape($searchcookie);
 254                                 my @recentSearches = @{thaw($searchcookie) || []};
 255                                 if (@recentSearches) {
 256                                         my $sth = $dbh->prepare($SEARCH_HISTORY_INSERT_SQL);
 257                                         $sth->execute( $borrowernumber,
 258                                                        $in->{'query'}->cookie("CGISESSID"),
 259                                                        $_->{'query_desc'},
 260                                                        $_->{'query_cgi'},
 261                                                        $_->{'total'},
 262                                                        $_->{'time'},
 263                                         ) foreach @recentSearches;
 264
 265                                         # And then, delete the cookie's content
 266                                         my $newsearchcookie = $in->{'query'}->cookie(
 267                                                                                                 -name => 'KohaOpacRecentSearches',
 268                                                                                                 -value => freeze([]),
 269                                                                                                 -expires => ''
 270                                                                                          );
 271                                         $cookie = [$cookie, $newsearchcookie];
 272                                 }
 273                         }
 274                 }
 275     }
 276         else {  # if this is an anonymous session, setup to display public lists...
 277
 278         # load the template variables for stylesheets and JavaScript
 279         $template->param( css_libs => $in->{'css_libs'} );
 280         $template->param( css_module => $in->{'css_module'} );
 281         $template->param( css_page => $in->{'css_page'} );
 282         $template->param( css_widgets => $in->{'css_widgets'} );
 283
 284         $template->param( js_libs => $in->{'js_libs'} );
 285         $template->param( js_module => $in->{'js_module'} );
 286         $template->param( js_page => $in->{'js_page'} );
 287         $template->param( js_widgets => $in->{'js_widgets'} );
 288
 289         $template->param( sessionID        => $sessionID );
 290
 291         my ($total, $pubshelves) = C4::Context->get_shelves_userenv();  # an anonymous user has no 'barshelves'...
 292         if (defined $pubshelves) {
 293             $template->param(   pubshelves      => scalar @{$pubshelves},
 294                                 pubshelvesloop  => $pubshelves,
 295                             );
 296             $template->param(   pubtotal        => $total->{'pubtotal'}, ) if ($total->{'pubtotal'} > scalar @{$pubshelves});
 297         }
 298
 299     }
 300         # Anonymous opac search history
 301         # If opac search history is enabled and at least one search has already been performed
 302         if (C4::Context->preference('EnableOpacSearchHistory')) {
 303                 my $searchcookie = $in->{'query'}->cookie('KohaOpacRecentSearches');
 304                 if ($searchcookie){
 305                         $searchcookie = uri_unescape($searchcookie);
 306                         my @recentSearches = @{thaw($searchcookie) || []};
 307             # We show the link in opac
 308                         if (@recentSearches) {
 309                                 $template->param(ShowOpacRecentSearchLink => 1);
 310                         }
 311             }
 312         }
 313
 314     if(C4::Context->preference('dateformat')){
 315         if(C4::Context->preference('dateformat') eq "metric"){
 316             $template->param(dateformat_metric => 1);
 317         } elsif(C4::Context->preference('dateformat') eq "us"){
 318             $template->param(dateformat_us => 1);
 319         } else {
 320             $template->param(dateformat_iso => 1);
 321         }
 322     } else {
 323         $template->param(dateformat_iso => 1);
 324     }
 325
 326     # these template parameters are set the same regardless of $in->{'type'}
 327     $template->param(
 328             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView")         => 1,
 329             EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
 330             GoogleJackets                => C4::Context->preference("GoogleJackets"),
 331             KohaAdminEmailAddress        => "" . C4::Context->preference("KohaAdminEmailAddress"),
 332             LoginBranchcode              => (C4::Context->userenv?C4::Context->userenv->{"branch"}:"insecure"),
 333             LoginFirstname               => (C4::Context->userenv?C4::Context->userenv->{"firstname"}:"Bel"),
 334             LoginSurname                 => C4::Context->userenv?C4::Context->userenv->{"surname"}:"Inconnu",
 335             TagsEnabled                  => C4::Context->preference("TagsEnabled"),
 336             hide_marc                    => C4::Context->preference("hide_marc"),
 337             'item-level_itypes'          => C4::Context->preference('item-level_itypes'),
 338             patronimages                 => C4::Context->preference("patronimages"),
 339             singleBranchMode             => C4::Context->preference("singleBranchMode"),
 340             XSLTDetailsDisplay           => C4::Context->preference("XSLTDetailsDisplay"),
 341             XSLTResultsDisplay           => C4::Context->preference("XSLTResultsDisplay"),
 342             using_https                  => $in->{'query'}->https() ? 1 : 0,
 343             noItemTypeImages            => C4::Context->preference("noItemTypeImages"),
 344     );
 345
 346     if ( $in->{'type'} eq "intranet" ) {
 347         $template->param(
 348             AmazonContent               => C4::Context->preference("AmazonContent"),
 349             AmazonCoverImages           => C4::Context->preference("AmazonCoverImages"),
 350             AmazonEnabled               => C4::Context->preference("AmazonEnabled"),
 351             AmazonSimilarItems          => C4::Context->preference("AmazonSimilarItems"),
 352             AutoLocation                => C4::Context->preference("AutoLocation"),
 353             "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
 354             CircAutocompl               => C4::Context->preference("CircAutocompl"),
 355             FRBRizeEditions             => C4::Context->preference("FRBRizeEditions"),
 356             IndependantBranches         => C4::Context->preference("IndependantBranches"),
 357             IntranetNav                 => C4::Context->preference("IntranetNav"),
 358             IntranetmainUserblock       => C4::Context->preference("IntranetmainUserblock"),
 359             LibraryName                 => C4::Context->preference("LibraryName"),
 360             LoginBranchname             => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
 361             advancedMARCEditor          => C4::Context->preference("advancedMARCEditor"),
 362             canreservefromotherbranches => C4::Context->preference('canreservefromotherbranches'),
 363             intranetcolorstylesheet     => C4::Context->preference("intranetcolorstylesheet"),
 364             intranetreadinghistory      => C4::Context->preference("intranetreadinghistory"),
 365             intranetstylesheet          => C4::Context->preference("intranetstylesheet"),
 366             IntranetUserCSS             => C4::Context->preference("IntranetUserCSS"),
 367             intranetuserjs              => C4::Context->preference("intranetuserjs"),
 368             intranetbookbag             => C4::Context->preference("intranetbookbag"),
 369             suggestion                  => C4::Context->preference("suggestion"),
 370             virtualshelves              => C4::Context->preference("virtualshelves"),
 371             StaffSerialIssueDisplayCount => C4::Context->preference("StaffSerialIssueDisplayCount"),
 372             NoZebra                     => C4::Context->preference('NoZebra'),
 373         );
 374     }
 375     else {
 376         warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]" unless ( $in->{'type'} eq 'opac' );
 377         #TODO : replace LibraryName syspref with 'system name', and remove this html processing
 378         my $LibraryNameTitle = C4::Context->preference("LibraryName");
 379         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
 380         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 381         # variables passed from CGI: opac_css_override and opac_search_limits.
 382         my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
 383         my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
 384         my $opac_name = '';
 385         if (($opac_search_limit =~ /branch:(\w+)/ && $opac_limit_override) || $in->{'query'}->param('limit') =~ /branch:(\w+)/){
 386             $opac_name = $1;   # opac_search_limit is a branch, so we use it.
 387         } elsif (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'}) {
 388             $opac_name = C4::Context->userenv->{'branch'};
 389         }
 390         $template->param(
 391             AmazonContent             => "" . C4::Context->preference("AmazonContent"),
 392             AnonSuggestions           => "" . C4::Context->preference("AnonSuggestions"),
 393             AuthorisedValueImages     => C4::Context->preference("AuthorisedValueImages"),
 394             BranchesLoop              => GetBranchesLoop($opac_name),
 395             LibraryName               => "" . C4::Context->preference("LibraryName"),
 396             LibraryNameTitle          => "" . $LibraryNameTitle,
 397             LoginBranchname           => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
 398             OPACAmazonEnabled         => C4::Context->preference("OPACAmazonEnabled"),
 399             OPACAmazonSimilarItems    => C4::Context->preference("OPACAmazonSimilarItems"),
 400             OPACAmazonCoverImages     => C4::Context->preference("OPACAmazonCoverImages"),
 401             OPACAmazonReviews         => C4::Context->preference("OPACAmazonReviews"),
 402             OPACFRBRizeEditions       => C4::Context->preference("OPACFRBRizeEditions"),
 403             OpacHighlightedWords       => C4::Context->preference("OpacHighlightedWords"),
 404             OPACItemHolds             => C4::Context->preference("OPACItemHolds"),
 405             OPACShelfBrowser          => "". C4::Context->preference("OPACShelfBrowser"),
 406             OPACURLOpenInNewWindow    => "" . C4::Context->preference("OPACURLOpenInNewWindow"),
 407             OPACUserCSS               => "". C4::Context->preference("OPACUserCSS"),
 408             OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
 409             OpacAuthorities           => C4::Context->preference("OpacAuthorities"),
 410             OPACBaseURL               => ($in->{'query'}->https() ? "https://" : "http://") . $ENV{'SERVER_NAME'} .
 411                    ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}"),
 412             opac_css_override           => $ENV{'OPAC_CSS_OVERRIDE'},
 413             opac_search_limit         => $opac_search_limit,
 414             opac_limit_override       => $opac_limit_override,
 415             OpacBrowser               => C4::Context->preference("OpacBrowser"),
 416             OpacCloud                 => C4::Context->preference("OpacCloud"),
 417             OpacMainUserBlock         => "" . C4::Context->preference("OpacMainUserBlock"),
 418             OpacNav                   => "" . C4::Context->preference("OpacNav"),
 419             OpacPasswordChange        => C4::Context->preference("OpacPasswordChange"),
 420             OPACPatronDetails        => C4::Context->preference("OPACPatronDetails"),
 421             OPACFinesTab              => C4::Context->preference("OPACFinesTab"),
 422             OpacTopissue              => C4::Context->preference("OpacTopissue"),
 423             RequestOnOpac             => C4::Context->preference("RequestOnOpac"),
 424             'Version'                 => C4::Context->preference('Version'),
 425             hidelostitems             => C4::Context->preference("hidelostitems"),
 426             mylibraryfirst            => (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv) ? C4::Context->userenv->{'branch'} : '',
 427             opaclayoutstylesheet      => "" . C4::Context->preference("opaclayoutstylesheet"),
 428             opaccolorstylesheet       => "" . C4::Context->preference("opaccolorstylesheet"),
 429             opacstylesheet            => "" . C4::Context->preference("opacstylesheet"),
 430             opacbookbag               => "" . C4::Context->preference("opacbookbag"),
 431             opaccredits               => "" . C4::Context->preference("opaccredits"),
 432             opacheader                => "" . C4::Context->preference("opacheader"),
 433             opaclanguagesdisplay      => "" . C4::Context->preference("opaclanguagesdisplay"),
 434             opacreadinghistory        => C4::Context->preference("opacreadinghistory"),
 435             opacsmallimage            => "" . C4::Context->preference("opacsmallimage"),
 436             opacuserjs                => C4::Context->preference("opacuserjs"),
 437             opacuserlogin             => "" . C4::Context->preference("opacuserlogin"),
 438             reviewson                 => C4::Context->preference("reviewson"),
 439             suggestion                => "" . C4::Context->preference("suggestion"),
 440             virtualshelves            => "" . C4::Context->preference("virtualshelves"),
 441             OPACSerialIssueDisplayCount => C4::Context->preference("OPACSerialIssueDisplayCount"),
 442             OpacAddMastheadLibraryPulldown => C4::Context->preference("OpacAddMastheadLibraryPulldown"),
 443             OPACXSLTDetailsDisplay           => C4::Context->preference("OPACXSLTDetailsDisplay"),
 444             OPACXSLTResultsDisplay           => C4::Context->preference("OPACXSLTResultsDisplay"),
 445             SyndeticsClientCode          => C4::Context->preference("SyndeticsClientCode"),
 446             SyndeticsEnabled             => C4::Context->preference("SyndeticsEnabled"),
 447             SyndeticsCoverImages         => C4::Context->preference("SyndeticsCoverImages"),
 448             SyndeticsTOC                 => C4::Context->preference("SyndeticsTOC"),
 449             SyndeticsSummary             => C4::Context->preference("SyndeticsSummary"),
 450             SyndeticsEditions            => C4::Context->preference("SyndeticsEditions"),
 451             SyndeticsExcerpt             => C4::Context->preference("SyndeticsExcerpt"),
 452             SyndeticsReviews             => C4::Context->preference("SyndeticsReviews"),
 453             SyndeticsAuthorNotes         => C4::Context->preference("SyndeticsAuthorNotes"),
 454             SyndeticsAwards              => C4::Context->preference("SyndeticsAwards"),
 455             SyndeticsSeries              => C4::Context->preference("SyndeticsSeries"),
 456             SyndeticsCoverImageSize      => C4::Context->preference("SyndeticsCoverImageSize"),
 457         );
 458     }
 459         $template->param(listloop=>[{shelfname=>"Freelist", shelfnumber=>110}]);
 460     return ( $template, $borrowernumber, $cookie, $flags);
 461 }
 462
 463 =head2 checkauth
 464
 465   ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
 466
 467 Verifies that the user is authorized to run this script.  If
 468 the user is authorized, a (userid, cookie, session-id, flags)
 469 quadruple is returned.  If the user is not authorized but does
 470 not have the required privilege (see $flagsrequired below), it
 471 displays an error page and exits.  Otherwise, it displays the
 472 login page and exits.
 473
 474 Note that C<&checkauth> will return if and only if the user
 475 is authorized, so it should be called early on, before any
 476 unfinished operations (e.g., if you've opened a file, then
 477 C<&checkauth> won't close it for you).
 478
 479 C<$query> is the CGI object for the script calling C<&checkauth>.
 480
 481 The C<$noauth> argument is optional. If it is set, then no
 482 authorization is required for the script.
 483
 484 C<&checkauth> fetches user and session information from C<$query> and
 485 ensures that the user is authorized to run scripts that require
 486 authorization.
 487
 488 The C<$flagsrequired> argument specifies the required privileges
 489 the user must have if the username and password are correct.
 490 It should be specified as a reference-to-hash; keys in the hash
 491 should be the "flags" for the user, as specified in the Members
 492 intranet module. Any key specified must correspond to a "flag"
 493 in the userflags table. E.g., { circulate => 1 } would specify
 494 that the user must have the "circulate" privilege in order to
 495 proceed. To make sure that access control is correct, the
 496 C<$flagsrequired> parameter must be specified correctly.
 497
 498 Koha also has a concept of sub-permissions, also known as
 499 granular permissions.  This makes the value of each key
 500 in the C<flagsrequired> hash take on an additional
 501 meaning, i.e.,
 502
 503  1
 504
 505 The user must have access to all subfunctions of the module
 506 specified by the hash key.
 507
 508  *
 509
 510 The user must have access to at least one subfunction of the module
 511 specified by the hash key.
 512
 513  specific permission, e.g., 'export_catalog'
 514
 515 The user must have access to the specific subfunction list, which
 516 must correspond to a row in the permissions table.
 517
 518 The C<$type> argument specifies whether the template should be
 519 retrieved from the opac or intranet directory tree.  "opac" is
 520 assumed if it is not specified; however, if C<$type> is specified,
 521 "intranet" is assumed if it is not "opac".
 522
 523 If C<$query> does not have a valid session ID associated with it
 524 (i.e., the user has not logged in) or if the session has expired,
 525 C<&checkauth> presents the user with a login page (from the point of
 526 view of the original script, C<&checkauth> does not return). Once the
 527 user has authenticated, C<&checkauth> restarts the original script
 528 (this time, C<&checkauth> returns).
 529
 530 The login page is provided using a HTML::Template, which is set in the
 531 systempreferences table or at the top of this file. The variable C<$type>
 532 selects which template to use, either the opac or the intranet
 533 authentification template.
 534
 535 C<&checkauth> returns a user ID, a cookie, and a session ID. The
 536 cookie should be sent back to the browser; it verifies that the user
 537 has authenticated.
 538
 539 =cut
 540
 541 sub _version_check ($$) {
 542     my $type = shift;
 543     my $query = shift;
 544     my $version;
 545     # If Version syspref is unavailable, it means Koha is beeing installed,
 546     # and so we must redirect to OPAC maintenance page or to the WebInstaller
 547         # also, if OpacMaintenance is ON, OPAC should redirect to maintenance
 548         if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
 549                 warn "OPAC Install required, redirecting to maintenance";
 550                 print $query->redirect("/cgi-bin/koha/maintenance.pl");
 551         }
 552     unless ($version = C4::Context->preference('Version')) {    # assignment, not comparison
 553       if ($type ne 'opac') {
 554         warn "Install required, redirecting to Installer";
 555         print $query->redirect("/cgi-bin/koha/installer/install.pl");
 556       }
 557       else {
 558         warn "OPAC Install required, redirecting to maintenance";
 559         print $query->redirect("/cgi-bin/koha/maintenance.pl");
 560       }
 561       exit;
 562     }
 563
 564     # check that database and koha version are the same
 565     # there is no DB version, it's a fresh install,
 566     # go to web installer
 567     # there is a DB version, compare it to the code version
 568     my $kohaversion=C4::Context::KOHAVERSION;
 569     # remove the 3 last . to have a Perl number
 570     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 571     $debug and print STDERR "kohaversion : $kohaversion\n";
 572     if ($version < $kohaversion){
 573         my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
 574         if ($type ne 'opac'){
 575             warn sprintf($warning, 'Installer');
 576             print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
 577         } else {
 578             warn sprintf("OPAC: " . $warning, 'maintenance');
 579             print $query->redirect("/cgi-bin/koha/maintenance.pl");
 580         }
 581         exit;
 582     }
 583 }
 584
 585 sub _session_log {
 586     (@_) or return 0;
 587     open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
 588     printf L join("\n",@_);
 589     close L;
 590 }
 591
 592 sub clear_saml {
 593         my $query = shift;
 594         my $cookie = [
 595                 $query->cookie( 'CGISESSID' => '' ),
 596                 $query->cookie( 'SimpleSAMLAuthToken' => '' ),
 597                 $query->cookie( 'AuthMemCookie' => '' ),
 598                 $query->cookie( 'PHPSESSID' => '' ),
 599         ];
 600         return ( undef, $cookie, undef ); # FIXME
 601 }
 602
 603 sub checkauth {
 604     my $query = shift;
 605         $debug and warn "Checking Auth";
 606     # $authnotrequired will be set for scripts which will run without authentication
 607     my $authnotrequired = shift;
 608     my $flagsrequired   = shift;
 609     my $type            = shift;
 610     $type = 'opac' unless $type;
 611
 612     my $dbh     = C4::Context->dbh;
 613     my $timeout = C4::Context->preference('timeout');
 614     # days
 615     if ($timeout =~ /(\d+)[dD]/) {
 616         $timeout = $1 * 86400;
 617     };
 618     $timeout = 600 unless $timeout;
 619
 620     _version_check($type,$query);
 621     # state variables
 622     my $loggedin = 0;
 623     my %info;
 624     my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
 625     my $logout = $query->param('logout.x');
 626
 627     $userid = $ENV{'REMOTE_USER'};
 628     $sessionID = $query->cookie("CGISESSID");
 629
 630     if ( $sessionID && $userid ) {
 631         my $s = get_session($sessionID);
 632         if ( $s->param('sessiontype') eq 'anon' ) {
 633                 undef $sessionID; # remove anonymous session if we have SAML user
 634         }
 635     }
 636
 637 #    ($userid,$sessionID) = () if $userid eq '_everyone';
 638         return clear_saml $query if $userid eq '_everyone';
 639
 640     if ( ! $sessionID && $userid ) { # anonymous SAML user
 641         warn "# userid: $userid";
 642
 643         # create new user from SAML data
 644         if ( my $token = $query->cookie('AuthMemCookie') ) {
 645
 646                 my $memd = new Cache::Memcached { 'servers' => [ '127.0.0.1:11211' ], 'compress_threshold' => 10_000 };
 647                 if ( my $data = $memd->get($token) ) {
 648
 649                         my $saml;
 650                         foreach ( split(/[\n\r]+/,$data) ) {
 651                                 my ($n,$v) = split /=/, $_;
 652                                 $saml->{$n} = $v;
 653                         }
 654
 655                         my $categorycode =
 656                                 $saml->{ATTR_code} =~ m/^\d{10}$/ ? 'S' : # JMBAG
 657                                 $saml->{ATTR_code} =~ m/^\w\w\d+/ ? 'D' :
 658                                 'O';
 659
 660                         my $cardnumber =  $categorycode . $saml->{ATTR_code};
 661
 662                         if ( my $borrowernumber = getborrowernumber($saml->{ATTR_nick}) ) {
 663                                 warn "SAML login OK $borrowernumber using ATTR_nick: ", $saml->{ATTR_nick};
 664                         } elsif ( my $borrowernumber = getborrowernumber( $cardnumber ) ) {
 665                                 warn "SAML login OK $borrowernumber using cardnumber: $cardnumber update userid: $userid";
 666                                 my $sth = $dbh->prepare(qq{ update borrowers set userid = ? where userid = cardnumber and cardnumber = ? });
 667                                 $sth->execute( $userid, $cardnumber );
 668                         } else {
 669                                 my $borrower = {
 670                                         cardnumber => $cardnumber,
 671                                         categorycode => $categorycode,
 672
 673                                         userid    => $saml->{ATTR_nick},
 674                                         firstname => $saml->{ATTR_first_name},
 675                                         surname   => $saml->{ATTR_last_name},
 676                                         branchcode => 'SRE', # FIXME
 677                                         email     => $saml->{ATTR_email},
 678                                         dateexpiry => '2020-12-13',
 679                                         password => $token, # required so AddMember won't erase userid
 680                                 };
 681
 682                                 AddMember( %$borrower );
 683
 684                                 warn "ADDED $data";
 685
 686                         }
 687
 688                         # Create session for SAML user
 689
 690                         my $sql = qq{
 691                         SELECT
 692                                 borrowernumber  as number,
 693                                 userid          as id,
 694                                 cardnumber,
 695                                 firstname,
 696                                 surname,
 697                                 borrowers.branchcode    as branch,
 698                                 branches.branchname     as branchname,
 699                                 flags,
 700                                 email                   as emailaddress
 701                         FROM borrowers
 702                         LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 703                         where userid=?
 704                         };
 705                         my $sth = $dbh->prepare($sql);
 706                         $sth->execute( $userid );
 707                         die "can't find $userid" unless $sth->rows;
 708
 709                         my $session = get_session('') or die "can't create session";
 710                         my $sessionID = $session->id;
 711                         C4::Context->_new_userenv($sessionID);
 712                         $cookie = $query->cookie(CGISESSID => $sessionID);
 713
 714                         my $row = $sth->fetchrow_hashref;
 715
 716                         $session->param( $_ => $row->{$_} ) foreach keys %$row;
 717
 718                         $session->param('ip', $ENV{'REMOTE_ADDR'});
 719                         $session->param('lasttime',time());
 720
 721                         $session->param('AuthMemCookie', $token);
 722
 723                         C4::Context::set_userenv(
 724                                 $session->param('number'),       $session->param('id'),
 725                                 $session->param('cardnumber'),   $session->param('firstname'),
 726                                 $session->param('surname'),      $session->param('branch'),
 727                                 $session->param('branchname'),   $session->param('flags'),
 728                                 $session->param('emailaddress'), $session->param('branchprinter')
 729                         );
 730
 731                         my $row_count = 10; # FIXME:This probably should be a syspref
 732                         my ($total, $totshelves, $barshelves, $pubshelves);
 733                         ($barshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(1, $row_count, $session->param('number'));
 734                         $total->{'bartotal'} = $totshelves;
 735                         ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
 736                         $total->{'pubtotal'} = $totshelves;
 737                         $session->param('barshelves', $barshelves);
 738                         $session->param('pubshelves', $pubshelves);
 739                         $session->param('totshelves', $total);
 740
 741                         C4::Context::set_shelves_userenv('bar',$barshelves);
 742                         C4::Context::set_shelves_userenv('pub',$pubshelves);
 743                         C4::Context::set_shelves_userenv('tot',$total);
 744
 745                         $loggedin = 1;
 746
 747                         if ( $type eq 'opac' ) {
 748                                         # FIXME 2011-12-20 dpavlin -- redirect logged in users to http
 749                                         print $query->redirect( -uri => 'http://' . $query->virtual_host, -status => 302, -cookie => $cookie );
 750 #                                       exit;
 751                                         warn "XXX redirect to ", $query->virtual_host;
 752                         }
 753
 754                 } else {
 755                         die "Can't find SAML token $token for user $userid\n";
 756                 }
 757         } else {
 758                 die "Can't find SAML token for user $userid\n";
 759         }
 760
 761     }
 762     elsif ( $sessionID = $query->cookie("CGISESSID")) {     # assignment, not comparison
 763         my $session = get_session($sessionID);
 764         C4::Context->_new_userenv($sessionID);
 765         my ($ip, $lasttime, $sessiontype);
 766         if ($session){
 767             C4::Context::set_userenv(
 768                 $session->param('number'),       $session->param('id'),
 769                 $session->param('cardnumber'),   $session->param('firstname'),
 770                 $session->param('surname'),      $session->param('branch'),
 771                 $session->param('branchname'),   $session->param('flags'),
 772                 $session->param('emailaddress'), $session->param('branchprinter')
 773             );
 774             C4::Context::set_shelves_userenv('bar',$session->param('barshelves'));
 775             C4::Context::set_shelves_userenv('pub',$session->param('pubshelves'));
 776             C4::Context::set_shelves_userenv('tot',$session->param('totshelves'));
 777             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 778             $ip       = $session->param('ip');
 779             $lasttime = $session->param('lasttime');
 780             $userid   = $session->param('id');
 781                         $sessiontype = $session->param('sessiontype');
 782         }
 783         if ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) ) {
 784             #if a user enters an id ne to the id in the current session, we need to log them in...
 785             #first we need to clear the anonymous session...
 786             $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
 787             $session->flush;
 788             $session->delete();
 789             C4::Context->_unset_userenv($sessionID);
 790                         $sessionID = undef;
 791                         $userid = undef;
 792                 }
 793         elsif ($logout) {
 794                 if ( my $token = $query->cookie('AuthMemCookie') ) {
 795                         my $memd = new Cache::Memcached { 'servers' => [ '127.0.0.1:11211' ], 'compress_threshold' => 10_000 };
 796                         #$memd->set( $token => '' ); # invalidate AuthMemCookie and leave anonymous user logged in
 797                         $memd->delete( $token );
 798                         warn "# nuked $token from memcache";
 799                 }
 800
 801             # voluntary logout the user
 802             $session->flush;
 803             $session->delete();
 804             C4::Context->_unset_userenv($sessionID);
 805             _session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
 806             $sessionID = undef;
 807             $userid    = undef;
 808
 809                         # http://groups.google.com/group/simplesamlphp/browse_thread/thread/a1603f9cff5007e1/bfc487ee88981ac0
 810                         print $query->redirect('/simplesaml/saml2/sp/initSLO.php?RelayState=https://lib.fer.hr');
 811
 812 #                       print $query->redirect('/simplesaml/module.php/core/as_logout.php?AuthId=default-sp&ReturnTo=http://lib.fer.hr');
 813
 814 #                       print $query->redirect('http://' . $query->virtual_host);
 815                         exit;
 816
 817             if ($cas and $caslogout) {
 818                 logout_cas($query);
 819             }
 820
 821                 return clear_saml($query); # FIXME
 822
 823         }
 824         elsif ( $lasttime < time() - $timeout ) {
 825             # timed logout
 826             $info{'timed_out'} = 1;
 827             $session->delete();
 828             C4::Context->_unset_userenv($sessionID);
 829             _session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
 830             $userid    = undef;
 831             $sessionID = undef;
 832         }
 833         elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
 834             # Different ip than originally logged in from
 835             $info{'oldip'}        = $ip;
 836             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
 837             $info{'different_ip'} = 1;
 838             $session->delete();
 839             C4::Context->_unset_userenv($sessionID);
 840             _session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
 841             $sessionID = undef;
 842             $userid    = undef;
 843         }
 844         else {
 845             $cookie = $query->cookie( CGISESSID => $session->id );
 846             $session->param('lasttime',time());
 847             unless ( $sessiontype eq 'anon' ) { #if this is an anonymous session, we want to update the session, but not behave as if they are logged in...
 848                 $flags = haspermission($userid, $flagsrequired);
 849                 if ($flags) {
 850                     $loggedin = 1;
 851                 } else {
 852                     $info{'nopermission'} = 1;
 853                 }
 854             }
 855         }
 856     }
 857     unless ($userid || $sessionID) {
 858         #we initiate a session prior to checking for a username to allow for anonymous sessions...
 859                 my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
 860         my $sessionID = $session->id;
 861         C4::Context->_new_userenv($sessionID);
 862         $cookie = $query->cookie(CGISESSID => $sessionID);
 863             $userid    = $query->param('userid');
 864             if ($cas || $userid) {
 865                 my $password = $query->param('password');
 866                 my ($return, $cardnumber);
 867                 if ($cas && $query->param('ticket')) {
 868                     my $retuserid;
 869                     ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, $password, $query );
 870                     $userid = $retuserid;
 871                     $info{'invalidCasLogin'} = 1 unless ($return);
 872                 } else {
 873                     my $retuserid;
 874                     ( $return, $retuserid ) = checkpw( $dbh, $userid, $password, $query );
 875                     $userid = $retuserid if ($retuserid ne '');
 876                 }
 877                 if ($return) {
 878                _session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
 879                 if ( $flags = haspermission(  $userid, $flagsrequired ) ) {
 880                                         $loggedin = 1;
 881                 }
 882                         else {
 883                         $info{'nopermission'} = 1;
 884                         C4::Context->_unset_userenv($sessionID);
 885                 }
 886
 887                                 my ($borrowernumber, $firstname, $surname, $userflags,
 888                                         $branchcode, $branchname, $branchprinter, $emailaddress);
 889
 890                 if ( $return == 1 ) {
 891                         my $select = "
 892                         SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode,
 893                             branches.branchname    as branchname,
 894                                 branches.branchprinter as branchprinter,
 895                                 email
 896                         FROM borrowers
 897                         LEFT JOIN branches on borrowers.branchcode=branches.branchcode
 898                         ";
 899                         my $sth = $dbh->prepare("$select where userid=?");
 900                         $sth->execute($userid);
 901                         unless ($sth->rows) {
 902                             $debug and print STDERR "AUTH_1: no rows for userid='$userid'\n";
 903                             $sth = $dbh->prepare("$select where cardnumber=?");
 904                             $sth->execute($cardnumber);
 905
 906                             unless ($sth->rows) {
 907                                 $debug and print STDERR "AUTH_2a: no rows for cardnumber='$cardnumber'\n";
 908                                 $sth->execute($userid);
 909                                 unless ($sth->rows) {
 910                                     $debug and print STDERR "AUTH_2b: no rows for userid='$userid' AS cardnumber\n";
 911                                 }
 912                             }
 913                         }
 914                         if ($sth->rows) {
 915                             ($borrowernumber, $firstname, $surname, $userflags,
 916                                 $branchcode, $branchname, $branchprinter, $emailaddress) = $sth->fetchrow;
 917                                                 $debug and print STDERR "AUTH_3 results: " .
 918                                                         "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n";
 919                                         } else {
 920                                                 print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n";
 921                                         }
 922
 923 # launch a sequence to check if we have a ip for the branch, i
 924 # if we have one we replace the branchcode of the userenv by the branch bound in the ip.
 925
 926                                         my $ip       = $ENV{'REMOTE_ADDR'};
 927                                         # if they specify at login, use that
 928                                         if ($query->param('branch')) {
 929                                                 $branchcode  = $query->param('branch');
 930                                                 $branchname = GetBranchName($branchcode);
 931                                         }
 932                                         my $branches = GetBranches();
 933                                         if (C4::Context->boolean_preference('IndependantBranches') && C4::Context->boolean_preference('Autolocation')){
 934                                                 # we have to check they are coming from the right ip range
 935                                                 my $domain = $branches->{$branchcode}->{'branchip'};
 936                                                 if ($ip !~ /^$domain/){
 937                                                         $loggedin=0;
 938                                                         $info{'wrongip'} = 1;
 939                                                 }
 940                                         }
 941
 942                                         my @branchesloop;
 943                                         foreach my $br ( keys %$branches ) {
 944                                                 #     now we work with the treatment of ip
 945                                                 my $domain = $branches->{$br}->{'branchip'};
 946                                                 if ( $domain && $ip =~ /^$domain/ ) {
 947                                                         $branchcode = $branches->{$br}->{'branchcode'};
 948
 949                                                         # new op dev : add the branchprinter and branchname in the cookie
 950                                                         $branchprinter = $branches->{$br}->{'branchprinter'};
 951                                                         $branchname    = $branches->{$br}->{'branchname'};
 952                                                 }
 953                                         }
 954                                         $session->param('number',$borrowernumber);
 955                                         $session->param('id',$userid);
 956                                         $session->param('cardnumber',$cardnumber);
 957                                         $session->param('firstname',$firstname);
 958                                         $session->param('surname',$surname);
 959                                         $session->param('branch',$branchcode);
 960                                         $session->param('branchname',$branchname);
 961                                         $session->param('flags',$userflags);
 962                                         $session->param('emailaddress',$emailaddress);
 963                                         $session->param('ip',$session->remote_addr());
 964                                         $session->param('lasttime',time());
 965                                         $debug and printf STDERR "AUTH_4: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
 966                                 }
 967                                 elsif ( $return == 2 ) {
 968                                         #We suppose the user is the superlibrarian
 969                                         $borrowernumber = 0;
 970                                         $session->param('number',0);
 971                                         $session->param('id',C4::Context->config('user'));
 972                                         $session->param('cardnumber',C4::Context->config('user'));
 973                                         $session->param('firstname',C4::Context->config('user'));
 974                                         $session->param('surname',C4::Context->config('user'));
 975                                         $session->param('branch','NO_LIBRARY_SET');
 976                                         $session->param('branchname','NO_LIBRARY_SET');
 977                                         $session->param('flags',1);
 978                                         $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
 979                                         $session->param('ip',$session->remote_addr());
 980                                         $session->param('lasttime',time());
 981                                 }
 982                                 C4::Context::set_userenv(
 983                                         $session->param('number'),       $session->param('id'),
 984                                         $session->param('cardnumber'),   $session->param('firstname'),
 985                                         $session->param('surname'),      $session->param('branch'),
 986                                         $session->param('branchname'),   $session->param('flags'),
 987                                         $session->param('emailaddress'), $session->param('branchprinter')
 988                                 );
 989
 990                                 # Grab borrower's shelves and public shelves and add them to the session
 991                                 # $row_count determines how many records are returned from the db query
 992                                 # and the number of lists to be displayed of each type in the 'Lists' button drop down
 993                                 my $row_count = 10; # FIXME:This probably should be a syspref
 994                                 my ($total, $totshelves, $barshelves, $pubshelves);
 995                                 ($barshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(1, $row_count, $borrowernumber);
 996                                 $total->{'bartotal'} = $totshelves;
 997                                 ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
 998                                 $total->{'pubtotal'} = $totshelves;
 999                                 $session->param('barshelves', $barshelves);
1000                                 $session->param('pubshelves', $pubshelves);
1001                                 $session->param('totshelves', $total);
1002
1003                                 C4::Context::set_shelves_userenv('bar',$barshelves);
1004                                 C4::Context::set_shelves_userenv('pub',$pubshelves);
1005                                 C4::Context::set_shelves_userenv('tot',$total);
1006                         }
1007                 else {
1008                 if ($userid) {
1009                         $info{'invalid_username_or_password'} = 1;
1010                         C4::Context->_unset_userenv($sessionID);
1011                 }
1012                         }
1013         }       # END if ( $userid    = $query->param('userid') )
1014                 elsif ($type eq "opac") {
1015             # if we are here this is an anonymous session; add public lists to it and a few other items...
1016             # anonymous sessions are created only for the OPAC
1017                         $debug and warn "Initiating an anonymous session...";
1018
1019                         # Grab the public shelves and add to the session...
1020                         my $row_count = 20; # FIXME:This probably should be a syspref
1021                         my ($total, $totshelves, $pubshelves);
1022                         ($pubshelves, $totshelves) = C4::VirtualShelves::GetRecentShelves(2, $row_count, undef);
1023                         $total->{'pubtotal'} = $totshelves;
1024                         $session->param('pubshelves', $pubshelves);
1025                         $session->param('totshelves', $total);
1026                         C4::Context::set_shelves_userenv('pub',$pubshelves);
1027                         C4::Context::set_shelves_userenv('tot',$total);
1028
1029                         # setting a couple of other session vars...
1030                         $session->param('ip',$session->remote_addr());
1031                         $session->param('lasttime',time());
1032                         $session->param('sessiontype','anon');
1033                 }
1034     }   # END unless ($userid)
1035     my $insecure = C4::Context->boolean_preference('insecure');
1036
1037     # finished authentification, now respond
1038     if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
1039     {
1040         # successful login
1041         unless ($cookie) {
1042             $cookie = $query->cookie( CGISESSID => '' );
1043         }
1044         return ( $userid, $cookie, $sessionID, $flags );
1045     }
1046
1047 #
1048 #
1049 # AUTH rejected, show the login/password template, after checking the DB.
1050 #
1051 #
1052
1053     # get the inputs from the incoming query
1054     my @inputs = ();
1055     foreach my $name ( param $query) {
1056         (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' );
1057         my $value = $query->param($name);
1058         push @inputs, { name => $name, value => $value };
1059     }
1060     # get the branchloop, which we need for authentication
1061     my $branches = GetBranches();
1062     my @branch_loop;
1063     for my $branch_hash (sort keys %$branches) {
1064                 push @branch_loop, {branchcode => "$branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
1065     }
1066
1067     my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
1068     my $template = gettemplate( $template_name, $type, $query );
1069     $template->param(branchloop => \@branch_loop,);
1070     $template->param(
1071     login        => 1,
1072         INPUTS               => \@inputs,
1073         casAuthentication    => C4::Context->preference("casAuthentication"),
1074         suggestion           => C4::Context->preference("suggestion"),
1075         virtualshelves       => C4::Context->preference("virtualshelves"),
1076         LibraryName          => C4::Context->preference("LibraryName"),
1077         opacuserlogin        => C4::Context->preference("opacuserlogin"),
1078         OpacNav              => C4::Context->preference("OpacNav"),
1079         opaccredits          => C4::Context->preference("opaccredits"),
1080         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
1081         opacsmallimage       => C4::Context->preference("opacsmallimage"),
1082         opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
1083         opaccolorstylesheet  => C4::Context->preference("opaccolorstylesheet"),
1084         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
1085         opacuserjs           => C4::Context->preference("opacuserjs"),
1086         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
1087         OpacCloud            => C4::Context->preference("OpacCloud"),
1088         OpacTopissue         => C4::Context->preference("OpacTopissue"),
1089         OpacAuthorities      => C4::Context->preference("OpacAuthorities"),
1090         OpacBrowser          => C4::Context->preference("OpacBrowser"),
1091         opacheader           => C4::Context->preference("opacheader"),
1092         TagsEnabled                  => C4::Context->preference("TagsEnabled"),
1093         OPACUserCSS           => C4::Context->preference("OPACUserCSS"),
1094         opacstylesheet       => C4::Context->preference("opacstylesheet"),
1095         intranetcolorstylesheet =>
1096                                                                 C4::Context->preference("intranetcolorstylesheet"),
1097         intranetstylesheet => C4::Context->preference("intranetstylesheet"),
1098         intranetbookbag    => C4::Context->preference("intranetbookbag"),
1099         IntranetNav        => C4::Context->preference("IntranetNav"),
1100         intranetuserjs     => C4::Context->preference("intranetuserjs"),
1101         IndependantBranches=> C4::Context->preference("IndependantBranches"),
1102         AutoLocation       => C4::Context->preference("AutoLocation"),
1103                 wrongip            => $info{'wrongip'}
1104     );
1105     $template->param( loginprompt => 1 ) unless $info{'nopermission'};
1106
1107     if ($cas) {
1108         $template->param(
1109             casServerUrl    => login_cas_url(),
1110             invalidCasLogin => $info{'invalidCasLogin'}
1111         );
1112     }
1113
1114     my $self_url = $query->url( -absolute => 1 );
1115     $template->param(
1116         url         => $self_url,
1117         LibraryName => C4::Context->preference("LibraryName"),
1118     );
1119     $template->param( \%info );
1120 #    $cookie = $query->cookie(CGISESSID => $session->id
1121 #   );
1122     print $query->header(
1123         -type   => 'text/html',
1124         -charset => 'utf-8',
1125         -cookie => $cookie
1126       ),
1127       $template->output;
1128     exit;
1129 }
1130
1131 =head2 check_api_auth
1132
1133   ($status, $cookie, $sessionId) = check_api_auth($query, $userflags);
1134
1135 Given a CGI query containing the parameters 'userid' and 'password' and/or a session
1136 cookie, determine if the user has the privileges specified by C<$userflags>.
1137
1138 C<check_api_auth> is is meant for authenticating users of web services, and
1139 consequently will always return and will not attempt to redirect the user
1140 agent.
1141
1142 If a valid session cookie is already present, check_api_auth will return a status
1143 of "ok", the cookie, and the Koha session ID.
1144
1145 If no session cookie is present, check_api_auth will check the 'userid' and 'password
1146 parameters and create a session cookie and Koha session if the supplied credentials
1147 are OK.
1148
1149 Possible return values in C<$status> are:
1150
1151 =over
1152
1153 =item "ok" -- user authenticated; C<$cookie> and C<$sessionid> have valid values.
1154
1155 =item "failed" -- credentials are not correct; C<$cookie> and C<$sessionid> are undef
1156
1157 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1158
1159 =item "expired -- session cookie has expired; API user should resubmit userid and password
1160
1161 =back
1162
1163 =cut
1164
1165 sub check_api_auth {
1166     my $query = shift;
1167     my $flagsrequired = shift;
1168
1169     my $dbh     = C4::Context->dbh;
1170     my $timeout = C4::Context->preference('timeout');
1171     $timeout = 600 unless $timeout;
1172
1173     unless (C4::Context->preference('Version')) {
1174         # database has not been installed yet
1175         return ("maintenance", undef, undef);
1176     }
1177     my $kohaversion=C4::Context::KOHAVERSION;
1178     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1179     if (C4::Context->preference('Version') < $kohaversion) {
1180         # database in need of version update; assume that
1181         # no API should be called while databsae is in
1182         # this condition.
1183         return ("maintenance", undef, undef);
1184     }
1185
1186     # FIXME -- most of what follows is a copy-and-paste
1187     # of code from checkauth.  There is an obvious need
1188     # for refactoring to separate the various parts of
1189     # the authentication code, but as of 2007-11-19 this
1190     # is deferred so as to not introduce bugs into the
1191     # regular authentication code for Koha 3.0.
1192
1193     # see if we have a valid session cookie already
1194     # however, if a userid parameter is present (i.e., from
1195     # a form submission, assume that any current cookie
1196     # is to be ignored
1197     my $sessionID = undef;
1198     unless ($query->param('userid')) {
1199         $sessionID = $query->cookie("CGISESSID");
1200     }
1201     if ($sessionID) {
1202         my $session = get_session($sessionID);
1203         C4::Context->_new_userenv($sessionID);
1204         if ($session) {
1205             C4::Context::set_userenv(
1206                 $session->param('number'),       $session->param('id'),
1207                 $session->param('cardnumber'),   $session->param('firstname'),
1208                 $session->param('surname'),      $session->param('branch'),
1209                 $session->param('branchname'),   $session->param('flags'),
1210                 $session->param('emailaddress'), $session->param('branchprinter')
1211             );
1212
1213             my $ip = $session->param('ip');
1214             my $lasttime = $session->param('lasttime');
1215             my $userid = $session->param('id');
1216             if ( $lasttime < time() - $timeout ) {
1217                 # time out
1218                 $session->delete();
1219                 C4::Context->_unset_userenv($sessionID);
1220                 $userid    = undef;
1221                 $sessionID = undef;
1222                 return ("expired", undef, undef);
1223             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1224                 # IP address changed
1225                 $session->delete();
1226                 C4::Context->_unset_userenv($sessionID);
1227                 $userid    = undef;
1228                 $sessionID = undef;
1229                 return ("expired", undef, undef);
1230             } else {
1231                 my $cookie = $query->cookie( CGISESSID => $session->id );
1232                 $session->param('lasttime',time());
1233                 my $flags = haspermission($userid, $flagsrequired);
1234                 if ($flags) {
1235                     return ("ok", $cookie, $sessionID);
1236                 } else {
1237                     $session->delete();
1238                     C4::Context->_unset_userenv($sessionID);
1239                     $userid    = undef;
1240                     $sessionID = undef;
1241                     return ("failed", undef, undef);
1242                 }
1243             }
1244         } else {
1245             return ("expired", undef, undef);
1246         }
1247     } else {
1248         # new login
1249         my $userid = $query->param('userid');
1250         my $password = $query->param('password');
1251         unless ($userid and $password) {
1252             # caller did something wrong, fail the authenticateion
1253             return ("failed", undef, undef);
1254         }
1255         my ($return, $cardnumber);
1256         if ($cas && $query->param('ticket')) {
1257             my $retuserid;
1258             ( $return, $cardnumber, $retuserid ) = checkpw( $dbh, $userid, $password, $query );
1259             $userid = $retuserid;
1260         } else {
1261             ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password, $query );
1262         }
1263         if ($return and haspermission(  $userid, $flagsrequired)) {
1264             my $session = get_session("");
1265             return ("failed", undef, undef) unless $session;
1266
1267             my $sessionID = $session->id;
1268             C4::Context->_new_userenv($sessionID);
1269             my $cookie = $query->cookie(CGISESSID => $sessionID);
1270             if ( $return == 1 ) {
1271                 my (
1272                     $borrowernumber, $firstname,  $surname,
1273                     $userflags,      $branchcode, $branchname,
1274                     $branchprinter,  $emailaddress
1275                 );
1276                 my $sth =
1277                   $dbh->prepare(
1278 "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=?"
1279                   );
1280                 $sth->execute($userid);
1281                 (
1282                     $borrowernumber, $firstname,  $surname,
1283                     $userflags,      $branchcode, $branchname,
1284                     $branchprinter,  $emailaddress
1285                 ) = $sth->fetchrow if ( $sth->rows );
1286
1287                 unless ($sth->rows ) {
1288                     my $sth = $dbh->prepare(
1289 "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=?"
1290                       );
1291                     $sth->execute($cardnumber);
1292                     (
1293                         $borrowernumber, $firstname,  $surname,
1294                         $userflags,      $branchcode, $branchname,
1295                         $branchprinter,  $emailaddress
1296                     ) = $sth->fetchrow if ( $sth->rows );
1297
1298                     unless ( $sth->rows ) {
1299                         $sth->execute($userid);
1300                         (
1301                             $borrowernumber, $firstname, $surname, $userflags,
1302                             $branchcode, $branchname, $branchprinter, $emailaddress
1303                         ) = $sth->fetchrow if ( $sth->rows );
1304                     }
1305                 }
1306
1307                 my $ip       = $ENV{'REMOTE_ADDR'};
1308                 # if they specify at login, use that
1309                 if ($query->param('branch')) {
1310                     $branchcode  = $query->param('branch');
1311                     $branchname = GetBranchName($branchcode);
1312                 }
1313                 my $branches = GetBranches();
1314                 my @branchesloop;
1315                 foreach my $br ( keys %$branches ) {
1316                     #     now we work with the treatment of ip
1317                     my $domain = $branches->{$br}->{'branchip'};
1318                     if ( $domain && $ip =~ /^$domain/ ) {
1319                         $branchcode = $branches->{$br}->{'branchcode'};
1320
1321                         # new op dev : add the branchprinter and branchname in the cookie
1322                         $branchprinter = $branches->{$br}->{'branchprinter'};
1323                         $branchname    = $branches->{$br}->{'branchname'};
1324                     }
1325                 }
1326                 $session->param('number',$borrowernumber);
1327                 $session->param('id',$userid);
1328                 $session->param('cardnumber',$cardnumber);
1329                 $session->param('firstname',$firstname);
1330                 $session->param('surname',$surname);
1331                 $session->param('branch',$branchcode);
1332                 $session->param('branchname',$branchname);
1333                 $session->param('flags',$userflags);
1334                 $session->param('emailaddress',$emailaddress);
1335                 $session->param('ip',$session->remote_addr());
1336                 $session->param('lasttime',time());
1337             } elsif ( $return == 2 ) {
1338                 #We suppose the user is the superlibrarian
1339                 $session->param('number',0);
1340                 $session->param('id',C4::Context->config('user'));
1341                 $session->param('cardnumber',C4::Context->config('user'));
1342                 $session->param('firstname',C4::Context->config('user'));
1343                 $session->param('surname',C4::Context->config('user'));
1344                 $session->param('branch','NO_LIBRARY_SET');
1345                 $session->param('branchname','NO_LIBRARY_SET');
1346                 $session->param('flags',1);
1347                 $session->param('emailaddress', C4::Context->preference('KohaAdminEmailAddress'));
1348                 $session->param('ip',$session->remote_addr());
1349                 $session->param('lasttime',time());
1350             }
1351             C4::Context::set_userenv(
1352                 $session->param('number'),       $session->param('id'),
1353                 $session->param('cardnumber'),   $session->param('firstname'),
1354                 $session->param('surname'),      $session->param('branch'),
1355                 $session->param('branchname'),   $session->param('flags'),
1356                 $session->param('emailaddress'), $session->param('branchprinter')
1357             );
1358             return ("ok", $cookie, $sessionID);
1359         } else {
1360             return ("failed", undef, undef);
1361         }
1362     }
1363 }
1364
1365 =head2 check_cookie_auth
1366
1367   ($status, $sessionId) = check_api_auth($cookie, $userflags);
1368
1369 Given a CGISESSID cookie set during a previous login to Koha, determine
1370 if the user has the privileges specified by C<$userflags>.
1371
1372 C<check_cookie_auth> is meant for authenticating special services
1373 such as tools/upload-file.pl that are invoked by other pages that
1374 have been authenticated in the usual way.
1375
1376 Possible return values in C<$status> are:
1377
1378 =over
1379
1380 =item "ok" -- user authenticated; C<$sessionID> have valid values.
1381
1382 =item "failed" -- credentials are not correct; C<$sessionid> are undef
1383
1384 =item "maintenance" -- DB is in maintenance mode; no login possible at the moment
1385
1386 =item "expired -- session cookie has expired; API user should resubmit userid and password
1387
1388 =back
1389
1390 =cut
1391
1392 sub check_cookie_auth {
1393     my $cookie = shift;
1394     my $flagsrequired = shift;
1395
1396     my $dbh     = C4::Context->dbh;
1397     my $timeout = C4::Context->preference('timeout');
1398     $timeout = 600 unless $timeout;
1399
1400     unless (C4::Context->preference('Version')) {
1401         # database has not been installed yet
1402         return ("maintenance", undef);
1403     }
1404     my $kohaversion=C4::Context::KOHAVERSION;
1405     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1406     if (C4::Context->preference('Version') < $kohaversion) {
1407         # database in need of version update; assume that
1408         # no API should be called while databsae is in
1409         # this condition.
1410         return ("maintenance", undef);
1411     }
1412
1413     # FIXME -- most of what follows is a copy-and-paste
1414     # of code from checkauth.  There is an obvious need
1415     # for refactoring to separate the various parts of
1416     # the authentication code, but as of 2007-11-23 this
1417     # is deferred so as to not introduce bugs into the
1418     # regular authentication code for Koha 3.0.
1419
1420     # see if we have a valid session cookie already
1421     # however, if a userid parameter is present (i.e., from
1422     # a form submission, assume that any current cookie
1423     # is to be ignored
1424     unless (defined $cookie and $cookie) {
1425         return ("failed", undef);
1426     }
1427     my $sessionID = $cookie;
1428     my $session = get_session($sessionID);
1429     C4::Context->_new_userenv($sessionID);
1430     if ($session) {
1431         C4::Context::set_userenv(
1432             $session->param('number'),       $session->param('id'),
1433             $session->param('cardnumber'),   $session->param('firstname'),
1434             $session->param('surname'),      $session->param('branch'),
1435             $session->param('branchname'),   $session->param('flags'),
1436             $session->param('emailaddress'), $session->param('branchprinter')
1437         );
1438
1439         my $ip = $session->param('ip');
1440         my $lasttime = $session->param('lasttime');
1441         my $userid = $session->param('id');
1442         if ( $lasttime < time() - $timeout ) {
1443             # time out
1444             $session->delete();
1445             C4::Context->_unset_userenv($sessionID);
1446             $userid    = undef;
1447             $sessionID = undef;
1448             return ("expired", undef);
1449         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
1450             # IP address changed
1451             $session->delete();
1452             C4::Context->_unset_userenv($sessionID);
1453             $userid    = undef;
1454             $sessionID = undef;
1455             return ("expired", undef);
1456         } else {
1457             $session->param('lasttime',time());
1458             my $flags = haspermission($userid, $flagsrequired);
1459             if ($flags) {
1460                 return ("ok", $sessionID);
1461             } else {
1462                 $session->delete();
1463                 C4::Context->_unset_userenv($sessionID);
1464                 $userid    = undef;
1465                 $sessionID = undef;
1466                 return ("failed", undef);
1467             }
1468         }
1469     } else {
1470         return ("expired", undef);
1471     }
1472 }
1473
1474 =head2 get_session
1475
1476   use CGI::Session;
1477   my $session = get_session($sessionID);
1478
1479 Given a session ID, retrieve the CGI::Session object used to store
1480 the session's state.  The session object can be used to store
1481 data that needs to be accessed by different scripts during a
1482 user's session.
1483
1484 If the C<$sessionID> parameter is an empty string, a new session
1485 will be created.
1486
1487 =cut
1488
1489 sub get_session {
1490     my $sessionID = shift;
1491     my $storage_method = C4::Context->preference('SessionStorage');
1492     my $dbh = C4::Context->dbh;
1493     my $session;
1494     if ($storage_method eq 'mysql'){
1495         $session = new CGI::Session("driver:MySQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1496     }
1497     elsif ($storage_method eq 'Pg') {
1498         $session = new CGI::Session("driver:PostgreSQL;serializer:yaml;id:md5", $sessionID, {Handle=>$dbh});
1499     }
1500     else {
1501         # catch all defaults to tmp should work on all systems
1502         $session = new CGI::Session("driver:File;serializer:yaml;id:md5", $sessionID, {Directory=>'/tmp'});
1503     }
1504     return $session;
1505 }
1506
1507 sub checkpw {
1508
1509     my ( $dbh, $userid, $password, $query ) = @_;
1510     if ($ldap) {
1511         $debug and print "## checkpw - checking LDAP\n";
1512         my ($retval,$retcard) = checkpw_ldap(@_);    # EXTERNAL AUTH
1513         ($retval) and return ($retval,$retcard);
1514     }
1515
1516     if ($cas && $query->param('ticket')) {
1517         $debug and print STDERR "## checkpw - checking CAS\n";
1518         # In case of a CAS authentication, we use the ticket instead of the password
1519         my $ticket = $query->param('ticket');
1520         my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query);    # EXTERNAL AUTH
1521         ($retval) and return ($retval,$retcard,$retuserid);
1522         return 0;
1523     }
1524
1525     # INTERNAL AUTH
1526     my $sth =
1527       $dbh->prepare(
1528 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
1529       );
1530     $sth->execute($userid);
1531     if ( $sth->rows ) {
1532         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1533             $surname, $branchcode, $flags )
1534           = $sth->fetchrow;
1535         if ( md5_base64($password) eq $md5password and $md5password ne "!") {
1536
1537             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
1538                 $firstname, $surname, $branchcode, $flags );
1539             return 1, $userid;
1540         }
1541     }
1542     $sth =
1543       $dbh->prepare(
1544 "select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
1545       );
1546     $sth->execute($userid);
1547     if ( $sth->rows ) {
1548         my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
1549             $surname, $branchcode, $flags )
1550           = $sth->fetchrow;
1551         if ( md5_base64($password) eq $md5password ) {
1552
1553             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
1554                 $firstname, $surname, $branchcode, $flags );
1555             return 1, $userid;
1556         }
1557     }
1558     if (   $userid && $userid eq C4::Context->config('user')
1559         && "$password" eq C4::Context->config('pass') )
1560     {
1561
1562 # Koha superuser account
1563 #     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
1564         return 2;
1565     }
1566     if (   $userid && $userid eq 'demo'
1567         && "$password" eq 'demo'
1568         && C4::Context->config('demo') )
1569     {
1570
1571 # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
1572 # some features won't be effective : modify systempref, modify MARC structure,
1573         return 2;
1574     }
1575     return 0;
1576 }
1577
1578 =head2 getuserflags
1579
1580     my $authflags = getuserflags($flags, $userid, [$dbh]);
1581
1582 Translates integer flags into permissions strings hash.
1583
1584 C<$flags> is the integer userflags value ( borrowers.userflags )
1585 C<$userid> is the members.userid, used for building subpermissions
1586 C<$authflags> is a hashref of permissions
1587
1588 =cut
1589
1590 sub getuserflags {
1591     my $flags   = shift;
1592     my $userid  = shift;
1593     my $dbh     = @_ ? shift : C4::Context->dbh;
1594     my $userflags;
1595     $flags = 0 unless $flags;
1596     my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
1597     $sth->execute;
1598
1599     while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
1600         if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
1601             $userflags->{$flag} = 1;
1602         }
1603         else {
1604             $userflags->{$flag} = 0;
1605         }
1606     }
1607
1608     # get subpermissions and merge with top-level permissions
1609     my $user_subperms = get_user_subpermissions($userid);
1610     foreach my $module (keys %$user_subperms) {
1611         next if $userflags->{$module} == 1; # user already has permission for everything in this module
1612         $userflags->{$module} = $user_subperms->{$module};
1613     }
1614
1615     return $userflags;
1616 }
1617
1618 =head2 get_user_subpermissions
1619
1620   $user_perm_hashref = get_user_subpermissions($userid);
1621
1622 Given the userid (note, not the borrowernumber) of a staff user,
1623 return a hashref of hashrefs of the specific subpermissions
1624 accorded to the user.  An example return is
1625
1626  {
1627     tools => {
1628         export_catalog => 1,
1629         import_patrons => 1,
1630     }
1631  }
1632
1633 The top-level hash-key is a module or function code from
1634 userflags.flag, while the second-level key is a code
1635 from permissions.
1636
1637 The results of this function do not give a complete picture
1638 of the functions that a staff user can access; it is also
1639 necessary to check borrowers.flags.
1640
1641 =cut
1642
1643 sub get_user_subpermissions {
1644     my $userid = shift;
1645
1646     my $dbh = C4::Context->dbh;
1647     my $sth = $dbh->prepare("SELECT flag, user_permissions.code
1648                              FROM user_permissions
1649                              JOIN permissions USING (module_bit, code)
1650                              JOIN userflags ON (module_bit = bit)
1651                              JOIN borrowers USING (borrowernumber)
1652                              WHERE userid = ?");
1653     $sth->execute($userid);
1654
1655     my $user_perms = {};
1656     while (my $perm = $sth->fetchrow_hashref) {
1657         $user_perms->{$perm->{'flag'}}->{$perm->{'code'}} = 1;
1658     }
1659     return $user_perms;
1660 }
1661
1662 =head2 get_all_subpermissions
1663
1664   my $perm_hashref = get_all_subpermissions();
1665
1666 Returns a hashref of hashrefs defining all specific
1667 permissions currently defined.  The return value
1668 has the same structure as that of C<get_user_subpermissions>,
1669 except that the innermost hash value is the description
1670 of the subpermission.
1671
1672 =cut
1673
1674 sub get_all_subpermissions {
1675     my $dbh = C4::Context->dbh;
1676     my $sth = $dbh->prepare("SELECT flag, code, description
1677                              FROM permissions
1678                              JOIN userflags ON (module_bit = bit)");
1679     $sth->execute();
1680
1681     my $all_perms = {};
1682     while (my $perm = $sth->fetchrow_hashref) {
1683         $all_perms->{$perm->{'flag'}}->{$perm->{'code'}} = $perm->{'description'};
1684     }
1685     return $all_perms;
1686 }
1687
1688 =head2 haspermission
1689
1690   $flags = ($userid, $flagsrequired);
1691
1692 C<$userid> the userid of the member
1693 C<$flags> is a hashref of required flags like C<$borrower-&lt;{authflags}>
1694
1695 Returns member's flags or 0 if a permission is not met.
1696
1697 =cut
1698
1699 sub haspermission {
1700     my ($userid, $flagsrequired) = @_;
1701     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
1702     $sth->execute($userid);
1703     my $flags = getuserflags($sth->fetchrow(), $userid);
1704     if ( $userid eq C4::Context->config('user') ) {
1705         # Super User Account from /etc/koha.conf
1706         $flags->{'superlibrarian'} = 1;
1707     }
1708     elsif ( $userid eq 'demo' && C4::Context->config('demo') ) {
1709         # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
1710         $flags->{'superlibrarian'} = 1;
1711     }
1712
1713     return $flags if $flags->{superlibrarian};
1714
1715     foreach my $module ( keys %$flagsrequired ) {
1716         my $subperm = $flagsrequired->{$module};
1717         if ($subperm eq '*') {
1718             return 0 unless ( $flags->{$module} == 1 or ref($flags->{$module}) );
1719         } else {
1720             return 0 unless ( $flags->{$module} == 1 or
1721                                 ( ref($flags->{$module}) and
1722                                   exists $flags->{$module}->{$subperm} and
1723                                   $flags->{$module}->{$subperm} == 1
1724                                 )
1725                             );
1726         }
1727     }
1728     return $flags;
1729     #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered.
1730 }
1731
1732
1733 sub getborrowernumber {
1734     my ($userid) = @_;
1735     my $userenv = C4::Context->userenv;
1736     if ( defined( $userenv ) && ref( $userenv ) eq 'HASH' && $userenv->{number} ) {
1737         return $userenv->{number};
1738     }
1739     my $dbh = C4::Context->dbh;
1740     for my $field ( 'userid', 'cardnumber' ) {
1741         my $sth =
1742           $dbh->prepare("select borrowernumber from borrowers where $field=?");
1743         $sth->execute($userid);
1744         if ( $sth->rows ) {
1745             my ($bnumber) = $sth->fetchrow;
1746             return $bnumber;
1747         }
1748     }
1749     return 0;
1750 }
1751
1752 END { }    # module clean-up code here (global destructor)
1753 1;
1754 __END__
1755
1756 =head1 SEE ALSO
1757
1758 CGI(3)
1759
1760 C4::Output(3)
1761
1762 Digest::MD5(3)
1763
1764 =cut