Bug 21738: make call of CanBookBeReserved more safe
[koha.git] / C4 / Auth_with_shibboleth.pm
index 863ea82..bb0a342 100644 (file)
@@ -1,45 +1,49 @@
 package C4::Auth_with_shibboleth;
 
-# Copyright 2011 BibLibre
+# Copyright 2014 PTFS Europe
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
-use strict;
-use warnings;
+use Modern::Perl;
 
 use C4::Debug;
 use C4::Context;
+use Koha::AuthUtils qw(get_script_name);
+use Koha::Database;
+use Koha::Patrons;
+use C4::Members::Messaging;
 use Carp;
 use CGI;
+use List::MoreUtils qw(any);
 
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
 
 BEGIN {
     require Exporter;
-    $VERSION = 3.03;                                                                    # set the version for version checking
     $debug   = $ENV{DEBUG};
     @ISA     = qw(Exporter);
-    @EXPORT  = qw(shib_ok logout_shib login_shib_url checkpw_shib get_login_shib);
+    @EXPORT =
+      qw(shib_ok logout_shib login_shib_url checkpw_shib get_login_shib);
 }
 
 # Check that shib config is not malformed
 sub shib_ok {
     my $config = _get_shib_config();
 
-    if ( $config ) {
+    if ($config) {
         return 1;
     }
 
@@ -57,7 +61,7 @@ sub logout_shib {
 sub login_shib_url {
     my ($query) = @_;
 
-    my $param = _get_uri() . $query->script_name();
+    my $param = _get_uri() . get_script_name();
     if ( $query->query_string() ) {
         $param = $param . '%3F' . $query->query_string();
     }
@@ -68,20 +72,25 @@ sub login_shib_url {
 # Returns shibboleth user login
 sub get_login_shib {
 
-    # In case of a Shibboleth authentication, we expect a shibboleth user attribute
-    # to contain the login match point of the shibboleth-authenticated user. This match
-    # point is configured in koha-conf.xml
+# In case of a Shibboleth authentication, we expect a shibboleth user attribute
+# to contain the login match point of the shibboleth-authenticated user. This match
+# point is configured in koha-conf.xml
 
-    # Shibboleth attributes are mapped into http environmement variables, so we're getting
-    # the match point of the user this way
+# Shibboleth attributes are mapped into http environmement variables, so we're getting
+# the match point of the user this way
 
     # Get shibboleth config
     my $config = _get_shib_config();
 
     my $matchAttribute = $config->{mapping}->{ $config->{matchpoint} }->{is};
-    $debug and warn $matchAttribute . " value: " . $ENV{ $matchAttribute };
 
-    return $ENV{ $matchAttribute } || '';
+    if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
+      $debug and warn $matchAttribute . " value: " . $ENV{"HTTP_".uc($matchAttribute)};
+      return $ENV{"HTTP_".uc($matchAttribute)} || '';
+    } else {
+      $debug and warn $matchAttribute . " value: " . $ENV{$matchAttribute};
+      return $ENV{$matchAttribute} || '';
+    }
 }
 
 # Checks for password correctness
@@ -89,31 +98,94 @@ sub get_login_shib {
 sub checkpw_shib {
     $debug and warn "checkpw_shib";
 
-    my ( $dbh, $match ) = @_;
-    my ( $retnumber, $userid );
+    my ( $match ) = @_;
     my $config = _get_shib_config();
     $debug and warn "User Shibboleth-authenticated as: $match";
 
     # Does the given shibboleth attribute value ($match) match a valid koha user ?
-    my $sth = $dbh->prepare("select cardnumber, userid from borrowers where $config->{matchpoint}=?");
-    $sth->execute($match);
-    if ( $sth->rows ) {
-        my @retvals = $sth->fetchrow;
-        $retnumber = $retvals[0];
-        $userid = $retvals[1];
-        return ( 1, $retnumber, $userid );
+    my $borrower =
+      Koha::Database->new()->schema()->resultset('Borrower')
+      ->find( { $config->{matchpoint} => $match } );
+    if ( defined($borrower) ) {
+        if ($config->{'sync'}) {
+            _sync($borrower->borrowernumber, $config, $match);
+        }
+        return ( 1, $borrower->get_column('cardnumber'), $borrower->get_column('userid') );
     }
 
-    # If we reach this point, the user is not a valid koha user
-    $debug and warn "User with $config->{matchpoint} of $match is not a valid Koha user";
-    return 0;
+    if ( $config->{'autocreate'} ) {
+        return _autocreate( $config, $match );
+    } else {
+        # If we reach this point, the user is not a valid koha user
+         $debug and warn "User with $config->{matchpoint} of $match is not a valid Koha user";
+        return 0;
+    }
+}
+
+sub _autocreate {
+    my ( $config, $match ) = @_;
+
+    my %borrower = ( $config->{matchpoint} => $match );
+
+    while ( my ( $key, $entry ) = each %{$config->{'mapping'}} ) {
+        if ( any { /(^psgi|^plack)/i } keys %ENV ) {
+            $borrower{$key} = ( $entry->{'is'} && $ENV{"HTTP_" . uc($entry->{'is'}) } ) || $entry->{'content'} || '';
+        } else {
+            $borrower{$key} = ( $entry->{'is'} && $ENV{ $entry->{'is'} } ) || $entry->{'content'} || '';
+        }
+    }
+
+    my $patron = Koha::Patron->new( \%borrower )->store;
+    C4::Members::Messaging::SetMessagingPreferencesFromDefaults( { borrowernumber => $patron->borrowernumber, categorycode => $patron->categorycode } );
+
+    return ( 1, $patron->cardnumber, $patron->userid );
+}
+
+sub _sync {
+    my ($borrowernumber, $config, $match ) = @_;
+    my %borrower;
+    $borrower{'borrowernumber'} = $borrowernumber;
+    while ( my ( $key, $entry ) = each %{$config->{'mapping'}} ) {
+        if ( any { /(^psgi|^plack)/i } keys %ENV ) {
+            $borrower{$key} = ( $entry->{'is'} && $ENV{"HTTP_" . uc($entry->{'is'}) } ) || $entry->{'content'} || '';
+        } else {
+            $borrower{$key} = ( $entry->{'is'} && $ENV{ $entry->{'is'} } ) || $entry->{'content'} || '';
+        }
+    }
+    my $patron = Koha::Patrons->find( $borrowernumber );
+    $patron->set(\%borrower)->store;
 }
 
 sub _get_uri {
 
     my $protocol = "https://";
+    my $interface = C4::Context->interface;
+    $debug and warn "shibboleth interface: " . $interface;
+
+    my $uri;
+    if ( $interface eq 'intranet' ) {
+
+        $uri = C4::Context->preference('staffClientBaseURL') // '';
+        if ($uri eq '') {
+            $debug and warn 'staffClientBaseURL not set!';
+        }
+    } else {
+        $uri = C4::Context->preference('OPACBaseURL') // '';
+        if ($uri eq '') {
+            $debug and warn 'OPACBaseURL not set!';
+        }
+    }
 
-    my $return = $protocol . C4::Context->preference('OPACBaseURL');
+    if ($uri =~ /(.*):\/\/(.*)/) {
+        my $oldprotocol = $1;
+        if ($oldprotocol ne 'https') {
+            $debug
+                and warn
+                  'Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!';
+        }
+        $uri = $2;
+    }
+    my $return = $protocol . $uri;
     return $return;
 }
 
@@ -121,7 +193,7 @@ sub _get_shib_config {
     my $config = C4::Context->config('shibboleth');
 
     if ( !$config ) {
-        carp 'shibboleth config not defined';
+        carp 'shibboleth config not defined' if $debug;
         return 0;
     }
 
@@ -203,13 +275,24 @@ Map their attributes to what you want to see in koha
 
 Tell apache that we wish to allow koha to authenticate via shibboleth.
 
-This is as simple as adding the below to your virtualhost config:
+This is as simple as adding the below to your virtualhost config (for CGI running):
 
  <Location />
    AuthType shibboleth
    Require shibboleth
  </Location>
 
+Or (for Plack running):
+
+ <Location />
+   AuthType shibboleth
+   Require shibboleth
+   ShibUseEnvironment Off
+   ShibUseHeaders On
+ </Location>
+
+IMPORTANT: Please note, if you are running in the plack configuration you should consult https://wiki.shibboleth.net/confluence/display/SHIB2/NativeSPSpoofChecking for security advice regarding header spoof checking settings. (See also bug 17776 on Bugzilla about enabling ShibUseHeaders.)
+
 =item 5.
 
 Configure koha to listen for shibboleth environment variables.
@@ -223,7 +306,7 @@ This is as simple as enabling B<useshibboleth> in koha-conf.xml:
 Map shibboleth attributes to koha fields, and configure authentication match point in koha-conf.xml.
 
  <shibboleth>
-   <matchpoint>userid<matchpoint> <!-- koha borrower field to match upon -->
+   <matchpoint>userid</matchpoint> <!-- koha borrower field to match upon -->
    <mapping>
      <userid is="eduPersonID"></userid> <!-- koha borrower field to shibboleth attribute mapping -->
    </mapping>
@@ -259,9 +342,33 @@ Returns the shibboleth login attribute should it be found present in the http se
 
 =head2 checkpw_shib
 
-Given a database handle and a shib_login attribute, this routine checks for a matching local user and if found returns true, their cardnumber and their userid.  If a match is not found, then this returns false.
+Given a shib_login attribute, this routine checks for a matching local user and if found returns true, their cardnumber and their userid.  If a match is not found, then this returns false.
+
+  my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib( $shib_login );
+
+=head2 _get_uri
+
+  _get_uri();
+
+A sugar function to that simply returns the current page URI with appropriate protocol attached
+
+This routine is NOT exported
+
+=head2 _get_shib_config
+
+  my $config = _get_shib_config();
+
+A sugar function that checks for a valid shibboleth configuration, and if found returns a hashref of it's contents
+
+This routine is NOT exported
+
+=head2 _autocreate
+
+  my ( $retval, $retcard, $retuserid ) = _autocreate( $config, $match );
+
+Given a shibboleth attribute reference and a userid this internal routine will add the given user to Koha and return their user credentials.
 
-  my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib( $dbh, $shib_login );
+This routine is NOT exported
 
 =head1 SEE ALSO