Bug 17600: Standardize our EXPORT_OK

[srvgit] / C4 / Auth_with_shibboleth.pm

diff --git a/C4/Auth_with_shibboleth.pm b/C4/Auth_with_shibboleth.pm
index 6a9a1cf..e214a53 100644 (file)
--- a/C4/Auth_with_shibboleth.pm
+++ b/C4/Auth_with_shibboleth.pm
@@ -19,22 +19,21 @@ package C4::Auth_with_shibboleth;
 
 use Modern::Perl;
 
 
 use Modern::Perl;
 

-use C4::Debug;

 use C4::Context;
 use C4::Context;

-use Koha::AuthUtils qw(get_script_name);
+use Koha::AuthUtils qw( get_script_name );

 use Koha::Database;
 use Koha::Database;

-use C4::Members qw( AddMember_Auto );
+use Koha::Patrons;

 use C4::Members::Messaging;
 use C4::Members::Messaging;

-use Carp;
-use CGI;
+use Carp qw( carp );
+use List::MoreUtils qw( any );

 
 

-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
+use Koha::Logger;

 
 

+our (@ISA, @EXPORT_OK);

 BEGIN {
     require Exporter;
 BEGIN {
     require Exporter;

-    $debug   = $ENV{DEBUG};

     @ISA     = qw(Exporter);
     @ISA     = qw(Exporter);

-    @EXPORT =
+    @EXPORT_OK =

       qw(shib_ok logout_shib login_shib_url checkpw_shib get_login_shib);
 }
 
       qw(shib_ok logout_shib login_shib_url checkpw_shib get_login_shib);
 }
 


@@ -53,18 +52,17 @@ sub shib_ok {
 sub logout_shib {
     my ($query) = @_;
     my $uri = _get_uri();
 sub logout_shib {
     my ($query) = @_;
     my $uri = _get_uri();

-    print $query->redirect( $uri . "/Shibboleth.sso/Logout?return=$uri" );
+    my $return = _get_return($query);
+    print $query->redirect( $uri . "/Shibboleth.sso/Logout?return=$return" );

 }
 
 # Returns Shibboleth login URL with callback to the requesting URL
 sub login_shib_url {
     my ($query) = @_;
 
 }
 
 # Returns Shibboleth login URL with callback to the requesting URL
 sub login_shib_url {
     my ($query) = @_;
 

-    my $param = _get_uri() . get_script_name();
-    if ( $query->query_string() ) {
-        $param = $param . '%3F' . $query->query_string();
-    }
-    my $uri = _get_uri() . "/Shibboleth.sso/Login?target=$param";
+    my $target = _get_return($query);
+    my $uri = _get_uri() . "/Shibboleth.sso/Login?target=" . $target;
+

     return $uri;
 }
 
     return $uri;
 }
 


@@ -82,25 +80,34 @@ sub get_login_shib {
     my $config = _get_shib_config();
 
     my $matchAttribute = $config->{mapping}->{ $config->{matchpoint} }->{is};
     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 ) {
+      return $ENV{"HTTP_".uc($matchAttribute)} || '';
+    } else {
+      return $ENV{$matchAttribute} || '';
+    }

 }
 
 # Checks for password correctness
 # In our case : does the given attribute match one of our users ?
 sub checkpw_shib {
 }
 
 # Checks for password correctness
 # In our case : does the given attribute match one of our users ?
 sub checkpw_shib {

-    $debug and warn "checkpw_shib";

 
     my ( $match ) = @_;
     my $config = _get_shib_config();
 
     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 ?
 
     # Does the given shibboleth attribute value ($match) match a valid koha user ?

-    my $borrower =
-      Koha::Database->new()->schema()->resultset('Borrower')
-      ->find( { $config->{matchpoint} => $match } );
+    my $borrowers = Koha::Patrons->search( { $config->{matchpoint} => $match } );
+    if ( $borrowers->count > 1 ){
+        # If we have more than 1 borrower the matchpoint is not unique
+        # we cannot know which patron is the correct one, so we should fail
+        Koha::Logger->get->warn("There are several users with $config->{matchpoint} of $match, matchpoints must be unique");
+        return 0;
+    }
+    my $borrower = $borrowers->next;

     if ( defined($borrower) ) {
     if ( defined($borrower) ) {

+        if ($config->{'sync'}) {
+            _sync($borrower->borrowernumber, $config, $match);
+        }

         return ( 1, $borrower->get_column('cardnumber'), $borrower->get_column('userid') );
     }
 
         return ( 1, $borrower->get_column('cardnumber'), $borrower->get_column('userid') );
     }
 


@@ -108,7 +115,7 @@ sub checkpw_shib {
         return _autocreate( $config, $match );
     } else {
         # If we reach this point, the user is not a valid koha user
         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";
+        Koha::Logger->get->info("There are several users with $config->{matchpoint} of $match, matchpoints must be unique");

         return 0;
     }
 }
         return 0;
     }
 }


@@ -116,56 +123,97 @@ sub checkpw_shib {
 sub _autocreate {
     my ( $config, $match ) = @_;
 
 sub _autocreate {
     my ( $config, $match ) = @_;
 

-    my %borrower = ( shibbolethMatchField => $match );
+    my %borrower = ( $config->{matchpoint} => $match );

 
     while ( my ( $key, $entry ) = each %{$config->{'mapping'}} ) {
 
     while ( my ( $key, $entry ) = each %{$config->{'mapping'}} ) {

-        $borrower{$key} = ( $entry->{'is'} && $ENV{ $entry->{'is'} } ) || $entry->{'content'} || '';
+        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'} || '';
+        }

     }
 
     }
 

-    %borrower = AddMember_Auto( %borrower );
-    C4::Members::Messaging::SetMessagingPreferencesFromDefaults( { borrowernumber => $borrower{'borrowernumber'}, categorycode => $borrower{'categorycode'} } );
+    my $patron = Koha::Patron->new( \%borrower )->store;
+    C4::Members::Messaging::SetMessagingPreferencesFromDefaults( { borrowernumber => $patron->borrowernumber, categorycode => $patron->categorycode } );

 
 

-    return ( 1, $borrower{'cardnumber'}, $borrower{'userid'} );
+    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://";
 }
 
 sub _get_uri {
 
     my $protocol = "https://";

+    my $interface = C4::Context->interface;
+
+    my $uri =
+      $interface eq 'intranet'
+      ? C4::Context->preference('staffClientBaseURL')
+      : C4::Context->preference('OPACBaseURL');
+
+    $uri or Koha::Logger->get->warn("Syspref staffClientBaseURL or OPACBaseURL not set!"); # FIXME We should die here
+
+    $uri ||= "";

 
 

-    my $uri = C4::Context->preference('OPACBaseURL') // '';
-    if ($uri eq '') {
-        $debug and warn 'OPACBaseURL not set!';
-    }

     if ($uri =~ /(.*):\/\/(.*)/) {
         my $oldprotocol = $1;
         if ($oldprotocol ne 'https') {
     if ($uri =~ /(.*):\/\/(.*)/) {
         my $oldprotocol = $1;
         if ($oldprotocol ne 'https') {

-            $debug
-                and warn
-                  'Shibboleth requires OPACBaseURL to use the https protocol!';
+            Koha::Logger->get->warn('Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!');

         }
         $uri = $2;
     }
         }
         $uri = $2;
     }

-

     my $return = $protocol . $uri;
     return $return;
 }
 
     my $return = $protocol . $uri;
     return $return;
 }
 

+sub _get_return {
+    my ($query) = @_;
+
+    my $uri_base_part = _get_uri() . get_script_name();
+
+    my $uri_params_part = '';
+    foreach my $param ( sort $query->url_param() ) {
+        # url_param() always returns parameters that were deleted by delete()
+        # This additional check ensure that parameter was not deleted.
+        my $uriPiece = $query->param($param);
+        if ($uriPiece) {
+            $uri_params_part .= '&' if $uri_params_part;
+            $uri_params_part .= $param . '=';
+            $uri_params_part .= $uriPiece;
+        }
+    }
+    $uri_base_part .= '%3F' if $uri_params_part;
+
+    return $uri_base_part . URI::Escape::uri_escape_utf8($uri_params_part);
+}
+

 sub _get_shib_config {
     my $config = C4::Context->config('shibboleth');
 
     if ( !$config ) {
 sub _get_shib_config {
     my $config = C4::Context->config('shibboleth');
 
     if ( !$config ) {

-        carp 'shibboleth config not defined';
+        Koha::Logger->get->warn('shibboleth config not defined');

         return 0;
     }
 
     if ( $config->{matchpoint}
         && defined( $config->{mapping}->{ $config->{matchpoint} }->{is} ) )
     {
         return 0;
     }
 
     if ( $config->{matchpoint}
         && defined( $config->{mapping}->{ $config->{matchpoint} }->{is} ) )
     {

-        if ($debug) {
-            warn "koha borrower field to match: " . $config->{matchpoint};
-            warn "shibboleth attribute to match: "
-              . $config->{mapping}->{ $config->{matchpoint} }->{is};
-        }
+        my $logger = Koha::Logger->get;
+        $logger->debug("koha borrower field to match: " . $config->{matchpoint});
+        $logger->debug("shibboleth attribute to match: " . $config->{mapping}->{ $config->{matchpoint} }->{is});

         return $config;
     }
     else {
         return $config;
     }
     else {


@@ -236,13 +284,24 @@ Map their attributes to what you want to see in koha
 
 Tell apache that we wish to allow koha to authenticate via shibboleth.
 
 
 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>
 
 
  <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.
 =item 5.
 
 Configure koha to listen for shibboleth environment variables.


@@ -256,7 +315,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>
 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>
    <mapping>
      <userid is="eduPersonID"></userid> <!-- koha borrower field to shibboleth attribute mapping -->
    </mapping>


@@ -296,11 +355,27 @@ Given a shib_login attribute, this routine checks for a matching local user and
 
   my ( $retval, $retcard, $retuserid ) = C4::Auth_with_shibboleth::checkpw_shib( $shib_login );
 
 
   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 );
 
 =head2 _autocreate
 
   my ( $retval, $retcard, $retuserid ) = _autocreate( $config, $match );
 

-Given a database handle, a shibboleth attribute reference and a userid this internal routine will add the given user to koha and return their user credentials
+Given a shibboleth attribute reference and a userid this internal routine will add the given user to Koha and return their user credentials.

 
 This routine is NOT exported
 
 
 This routine is NOT exported