use Modern::Perl;
-use C4::Debug;
use C4::Context;
-use Koha::AuthUtils qw(get_script_name);
+use Koha::AuthUtils qw( get_script_name );
use Koha::Database;
use Koha::Patrons;
+use C4::Letters qw( GetPreparedLetter EnqueueLetter SendQueuedMessages );
use C4::Members::Messaging;
-use Carp;
-use CGI;
-use List::Util qw(any);
+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;
- $debug = $ENV{DEBUG};
@ISA = qw(Exporter);
- @EXPORT =
+ @EXPORT_OK =
qw(shib_ok logout_shib login_shib_url checkpw_shib get_login_shib);
}
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) = @_;
- 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;
}
my $matchAttribute = $config->{mapping}->{ $config->{matchpoint} }->{is};
- if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
- $debug and warn $matchAttribute . " value: " . $ENV{"HTTP_".uc($matchAttribute)};
+ if ( C4::Context->psgi_env ) {
return $ENV{"HTTP_".uc($matchAttribute)} || '';
} else {
- $debug and warn $matchAttribute . " value: " . $ENV{$matchAttribute};
return $ENV{$matchAttribute} || '';
}
}
# 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();
- $debug and warn "User Shibboleth-authenticated as: $match";
# 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 ($config->{'sync'}) {
+ _sync($borrower->borrowernumber, $config, $match);
+ }
return ( 1, $borrower->get_column('cardnumber'), $borrower->get_column('userid') );
}
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;
}
}
my %borrower = ( $config->{matchpoint} => $match );
while ( my ( $key, $entry ) = each %{$config->{'mapping'}} ) {
- $borrower{$key} = ( $entry->{'is'} && $ENV{ $entry->{'is'} } ) || $entry->{'content'} || '';
+ if ( C4::Context->psgi_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 } );
-
+ C4::Members::Messaging::SetMessagingPreferencesFromDefaults(
+ {
+ borrowernumber => $patron->borrowernumber,
+ categorycode => $patron->categorycode
+ }
+ );
+
+ # Send welcome email if enabled
+ if ( $config->{welcome} ) {
+ my $emailaddr = $patron->notice_email_address;
+
+ # if we manage to find a valid email address, send notice
+ if ($emailaddr) {
+ my $letter = C4::Letters::GetPreparedLetter(
+ module => 'members',
+ letter_code => 'WELCOME',
+ branchcode => $patron->branchcode,
+ ,
+ lang => $patron->lang || 'default',
+ tables => {
+ 'branches' => $patron->branchcode,
+ 'borrowers' => $patron->borrowernumber,
+ },
+ want_librarian => 1,
+ ) or return;
+
+ my $message_id = C4::Letters::EnqueueLetter(
+ {
+ letter => $letter,
+ borrowernumber => $patron->id,
+ to_address => $emailaddr,
+ message_transport_type => 'email'
+ }
+ );
+ C4::Letters::SendQueuedMessages( { message_id => $message_id } );
+ }
+ }
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 ( C4::Context->psgi_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' ) {
+ my $uri =
+ $interface eq 'intranet'
+ ? C4::Context->preference('staffClientBaseURL')
+ : C4::Context->preference('OPACBaseURL');
- $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!';
- }
- }
+ $uri or Koha::Logger->get->warn("Syspref staffClientBaseURL or OPACBaseURL not set!"); # FIXME We should die here
+
+ $uri ||= "";
if ($uri =~ /(.*):\/\/(.*)/) {
my $oldprotocol = $1;
if ($oldprotocol ne 'https') {
- $debug
- and warn
- 'Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!';
+ Koha::Logger->get->warn('Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!');
}
$uri = $2;
}
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 ) {
- carp 'shibboleth config not defined' if $debug;
+ Koha::Logger->get->warn('shibboleth config not defined');
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 {