--- /dev/null
+#! /usr/bin/perl
+
+#
+# Copyright 2019 BC Libraries Cooperative,
+# contact Jeff Davis <jeff.davis@bc.libraries.coop>
+# Copyleft 2014 Jon Scott <mr.jonathon.scott@gmail.com>
+# Copyleft 2014 Mark Cooper <mark.c.cooper@outlook.com>
+# Copyright 2012-2013 Midwest Consortium for Library Services
+# Copyright 2013 Calvin College
+# contact Dan Wells <dbw2@calvin.edu>
+# Copyright 2013 Traverse Area District Library,
+# contact Jeff Godin <jgodin@tadl.org>
+#
+#
+# This code incorporates code (with modifications) from issa, "a small
+# command-line client to OpenILS/Evergreen". issa is licensed GPLv2 or (at your
+# option) any later version of the GPL.
+#
+# issa is copyright:
+#
+# Copyright 2011 Jason J.A. Stephenson <jason@sigio.com>
+# Portions Copyright 2012 Merrimack Valley Library Consortium
+# <jstephenson@mvlc.org>
+#
+#
+# This file is part of iNCIPit
+#
+# iNCIPit 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.
+#
+# iNCIPit 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 iNCIPit. If not, see <http://www.gnu.org/licenses/>.
+
+use warnings;
+use strict;
+use XML::LibXML;
+use XML::LibXML::ErrNo;
+use CGI;
+use HTML::Entities;
+use CGI::Carp;
+use OpenSRF::System;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/$logger/;
+use Digest::MD5 qw/md5_hex/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Const qw/:const/;
+use Scalar::Util qw(reftype blessed);
+use MARC::Record;
+use MARC::Field;
+use MARC::File::XML;
+use POSIX qw/strftime/;
+use DateTime;
+use Config::Tiny;
+use Digest::MD5 qw/md5_hex/;
+
+my $U = "OpenILS::Application::AppUtils";
+
+my $cgi = CGI->new();
+my $xml = $cgi->param('POSTDATA');# || $cgi->param('XForms:Model');
+my $host = $cgi->url(-base=>1);
+my $hostname = (split "/", $host)[2]; # base hostname i.e. www.example.org
+my $conffile = "$hostname.ini"; # hostname specific ini file i.e. www.example.org.ini
+my $conf;
+
+# attempt to load configuration file using matching request hostname, fallback to default
+if (-e $conffile) {
+ $conf = load_config($conffile);
+} else {
+ $conffile = "iNCIPit.ini";
+ $conf = load_config($conffile);
+}
+
+# Set some variables from config (or defaults)
+
+my @visid_types = ( "Barcode" );
+if ($conf->{behavior}->{visid_types}) {
+ @visid_types = split(/,\s*/, $conf->{behavior}->{visid_types});
+}
+
+# reject non-https access unless configured otherwise
+unless ($conf->{access}->{permit_plaintext} =~ m/^yes$/i) {
+ unless (defined($ENV{HTTPS}) && $ENV{HTTPS} eq 'on') {
+ print "Content-type: text/plain\n\n";
+ print "Access denied.\n";
+ exit 0;
+ }
+}
+
+# TODO: support for multiple load balancer IPs
+my $lb_ip = $conf->{access}->{load_balancer_ip};
+
+# check to see that the actual client IP is permitted
+my @allowed_ips = split(/ *, */, $conf->{access}->{allowed_client_ips});
+
+if (@allowed_ips) {
+ my @forwarded = split(/ *, */, $ENV{HTTP_X_FORWARDED_FOR});
+ my $ok = 0;
+
+ foreach my $check_ip (@allowed_ips) {
+ $ok = 1 if ( $ENV{REMOTE_ADDR} eq $check_ip or (grep $_ eq $check_ip, @forwarded) );
+ }
+
+ # if we have a load balancer IP and are relying on
+ # X-Forwarded-For, deny requests other than those
+ # from the load balancer
+ # TODO: support for chained X-Forwarded-For -- ignore all but last
+ unless ($ok && (!$lb_ip or $ENV{REMOTE_ADDR} eq $lb_ip)) {
+ print "Content-type: text/plain\n\n";
+ print "Access denied.\n";
+ exit 0;
+ }
+}
+
+# initialize the parser
+my $parser = new XML::LibXML;
+my $doc;
+
+# Attempt to parse XML without any modification
+eval {
+ $doc = $parser->load_xml( string => $xml );
+};
+
+# Attempt to gracefully handle invalid XML, including mitigations for known common issues.
+if ($@ && ref($@) ne 'XML::LibXML::Error') {
+ # We received an error, but it was not a LibXML error object
+ fail("Unknown error parsing XML: $@");
+} elsif ($@) {
+ # We received an error in the form of a LibXML error object
+
+ my $warning = sprintf("Unable to parse XML on the first try. LibXML error code: %s, message: %s", $@->code(), $@->message());
+ warn $warning;
+
+ # If the error was ERR_INVALID_CHAR, attempt to modify XML and try again
+ if ($@->code() == XML::LibXML::ErrNo::ERR_INVALID_CHAR) {
+
+ warn "Attempting to de-mangle by removing known invalid character(s).\n";
+
+ # This is based on actual invalid XML encountered in the wild
+ # in an INN-REACH environment.
+ $xml =~ s/\x04//g; # Remove ^D from xml
+
+ # Attempt to re-parse after de-mangling
+ eval {
+ $doc = $parser->load_xml( string => $xml );
+ };
+
+ if ($@ && ref($@) ne 'XML::LibXML::Error') {
+ # We received an error, but it was not a LibXML error object
+ fail("Unknown error parsing XML on second attempt: $@");
+ } elsif ($@) {
+ # We received an error in the form of a LibXML error object
+ my $error = sprintf("Unable to parse XML even after de-mangling. LibXML error code: %s, message: %s", $@->code(), $@->message());
+ fail($error);
+ }
+ warn "Success parsing XML after de-mangling.\n";
+ } else {
+ # This is not an error that we know how to recover from
+ fail("No known workaround for this error. Giving up.") unless $doc;
+ }
+}
+
+fail("XML parsing did not result in a document.") unless $doc && ref($doc) eq 'XML::LibXML::Document';
+
+my %session = login();
+
+if ( defined( $session{authtoken} ) ) {
+
+ if ($conf->{behavior}->{log_messages} =~ m/^yes$/i) {
+ $logger->info("NCIP: incoming request: $xml");
+ }
+
+ if ($doc->exists('/NCIPMessage/LookupUser')) {
+ lookupUser();
+ } else {
+ fail("UNKNOWN NCIPMessage");
+ }
+
+ logout();
+} else {
+ fail("Unable to perform action : Unknown Service Request");
+}
+
+# load and parse config file
+sub load_config {
+ my $file = shift;
+
+ my $Config = Config::Tiny->new;
+ $Config = Config::Tiny->read( $file ) ||
+ die( "Error reading config file ", $file, ": ", Config::Tiny->errstr, "\n" );
+ return $Config;
+}
+
+# load and parse userpriv_map file, returning a hashref
+sub load_map_file {
+ my $filename = shift;
+ my $map = {};
+ if (open(my $fh, "<", $filename)) {
+ while (my $entry = <$fh>) {
+ chomp($entry);
+ my ($from, $to) = split(m/:/, $entry);
+ $map->{$from} = $to;
+ }
+ close $fh;
+ }
+ return $map;
+}
+
+sub lookup_userpriv {
+ my $input = shift;
+ my $map = shift;
+ if (defined($map->{$input})) { # if we have a mapping for this profile
+ return $map->{$input}; # return value from mapping hash
+ } else {
+ return $input; # return original value
+ }
+}
+
+sub lookup_pickup_lib {
+ my $input = shift;
+ my $map = shift;
+ if (defined($map->{$input})) { # if we found this pickup lib
+ return $map->{$input}; # return value from mapping hash
+ } else {
+ return undef; # the original value does us no good -- return undef
+ }
+}
+
+sub lookupUser {
+ my $require_pin = ( $conf->{auth}->{require_pin} =~ m/^no$/i ) ? 0 : 1;
+
+ my $faidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
+ $faidScheme = HTML::Entities::encode($faidScheme);
+ my $faidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
+ my $taidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
+ $taidScheme = HTML::Entities::encode($taidScheme);
+ my $taidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
+
+ unless ($doc->findnodes('/NCIPMessage/LookupUser/AuthenticationInput')) {
+ $logger->warn("NCIP: received LookupUser request with no AuthenticationInput");
+ }
+
+ my ($id, $password);
+
+ # Usually we look for ID and password in AuthenticationInput.
+ foreach my $auth ($doc->findnodes('/NCIPMessage/LookupUser/AuthenticationInput')) {
+ my $type = $auth->findvalue('AuthenticationInputType/Value');
+ my $data = $auth->findvalue('AuthenticationInputData');
+ if ($type =~ m/^barcode/i) {
+ $id = $data;
+ } elsif ($type =~ m/^pin/i or $type =~ m/^password/i) {
+ $password = $data;
+ }
+ }
+
+ # If password is not required, ID may be in AuthenticationInput, UniqueUserId, or VisibleUserId.
+ if (!$id and !$require_pin) {
+ if ($doc->exists('/NCIPMessage/LookupUser/UniqueUserId')) {
+ $id = $doc->findvalue('/NCIPMessage/LookupUser/UniqueUserId/UserIdentifierValue');
+ } elsif ($doc->exists('/NCIPMessage/LookupUser/VisibleUserId')) {
+ $id = $doc->findvalue('/NCIPMessage/LookupUser/VisibleUserId/VisibleUserIdentifier');
+ }
+ }
+
+ fail("User ID or barcode not provided") unless $id;
+ fail("Password or PIN not provided") if ($require_pin and !$password);
+
+ # determine fields to include in response
+ my @requestedFields;
+ foreach my $f ($doc->findnodes('/NCIPMessage/LookupUser/UserElementType/Value')) {
+ push @requestedFields, $f->to_literal();
+ }
+
+ my $uidValue;
+
+ # Get user ID.
+ # If PIN is required, verify password.
+ # If PIN is not required, verify password if one was provided.
+ if ($require_pin or $password) {
+ $uidValue = do_patron_auth($id, $password);
+ } else {
+ $uidValue = user_id_from_barcode($id);
+ }
+
+ if ( !defined($uidValue)
+ || ( ref($uidValue) && reftype($uidValue) eq 'HASH' ) )
+ {
+ do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
+ die;
+ }
+
+ my ( $propername, $email, $good_until, $userpriv, $block_stanza ) =
+ ( "name here", "", "", "", "" ); # defaults
+
+ my $patron = flesh_user($uidValue);
+ if ( !$patron ) {
+ do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
+ die;
+ }
+
+ #if (blessed($patron)) {
+ my $patron_ok = 1;
+ my @penalties = @{ $patron->standing_penalties };
+
+ if ( $patron->deleted eq 't' ) {
+ do_lookup_user_error_stanza("PATRON_DELETED : $uidValue");
+ die;
+ } elsif ( $patron->barred eq 't' ) {
+ do_lookup_user_error_stanza("PATRON_BARRED : $uidValue");
+ die;
+ } elsif ( $patron->active eq 'f' ) {
+ do_lookup_user_error_stanza("PATRON_INACTIVE : $uidValue");
+ die;
+ }
+
+ elsif ( $#penalties > -1 ) {
+
+ # Block only on standing penalties that have CIRC or HOLD in their block list
+ my $block_types = [qw/CIRC HOLD/];
+
+ my $penalty;
+ foreach $penalty (@penalties) {
+ if (defined($penalty->standing_penalty->block_list)) {
+ my @block_list = split(/\|/, $penalty->standing_penalty->block_list);
+ foreach my $block (@block_list) {
+ foreach my $block_on (@$block_types) {
+ if ($block eq $block_on) {
+ $patron_ok = 0;
+ }
+ last unless ($patron_ok);
+ }
+ last unless ($patron_ok);
+ }
+ }
+ }
+ }
+ unless ($patron_ok) {
+ $block_stanza = qq(
+ <BlockOrTrap>
+ <UniqueAgencyId>
+ <Scheme>http://just.testing.now</Scheme>
+ <Value>$faidValue</Value>
+ </UniqueAgencyId>
+ <BlockOrTrapType>
+ <Scheme>http://just.testing.now</Scheme>
+ <Value>Block Hold</Value>
+ </BlockOrTrapType>
+ </BlockOrTrap>);
+ }
+
+ if ( defined( $patron->email ) && $conf->{behavior}->{omit_patron_email} !~ m/^y/i ) {
+ $email = qq(
+ <UserAddressInformation>
+ <UserAddressRoleType>
+ <Scheme>http://testing.now</Scheme>
+ <Value>Multi-Purpose</Value>
+ </UserAddressRoleType>
+ <ElectronicAddress>
+ <ElectronicAddressType>
+ <Scheme>http://testing.now</Scheme>
+ <Value>mailto</Value>
+ </ElectronicAddressType>
+ <ElectronicAddressData>)
+ . HTML::Entities::encode( $patron->email )
+ . qq(</ElectronicAddressData>
+ </ElectronicAddress>
+ </UserAddressInformation>);
+ }
+
+ $propername = $patron->first_given_name . " " . $patron->family_name;
+ $good_until = $patron->expire_date || "2000-01-01T00:00:00-08:00";
+ if ($good_until =~ /-\d\d\d\d$/) {
+ $good_until =~ s/-(\d\d)(\d\d)$/-\1:\2/;
+ }
+ $userpriv = $patron->profile->name;
+
+ my $userpriv_map = load_map_file( $conf->{path}->{userpriv_map} );
+
+ if ($userpriv_map) {
+ $userpriv = lookup_userpriv($userpriv, $userpriv_map);
+ }
+
+ #} else {
+ # do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
+ # die;
+ #}
+ my $uniqid = $patron->id;
+ my $barcode = $patron->card->barcode;
+ my $visid = $barcode;
+
+ my $userOptionalFields;
+
+ # NCIP v1.0 required order of UserOptionalFields, per DTD:
+ # VisibleUserId* , NameInformation? , UserAddressInformation* , DateOfBirth? , UserLanguage* , UserPrivilege* , BlockOrTrap*
+
+ if (grep 'Visible User Id', @requestedFields) {
+ if (grep 'Primary Key', @visid_types) {
+ $userOptionalFields .= qq(
+ <VisibleUserId>
+ <VisibleUserIdentifierType>
+ <Scheme>http://www.niso.org/ncip/v1_0/imp1/schemes/visibleuseridentifiertype/visibleuseridentifiertype.scm</Scheme>
+ <Value>Primary Key</Value>
+ </VisibleUserIdentifierType>
+ <VisibleUserIdentifier>$uniqid</VisibleUserIdentifier>
+ </VisibleUserId>);
+ };
+ if (grep 'Barcode', @visid_types) {
+ $userOptionalFields .= qq(
+ <VisibleUserId>
+ <VisibleUserIdentifierType>
+ <Scheme>http://www.niso.org/ncip/v1_0/imp1/schemes/visibleuseridentifiertype/visibleuseridentifiertype.scm</Scheme>
+ <Value>Barcode</Value>
+ </VisibleUserIdentifierType>
+ <VisibleUserIdentifier>$barcode</VisibleUserIdentifier>
+ </VisibleUserId>);
+ };
+ }
+ if (grep 'Name Information', @requestedFields) {
+ $userOptionalFields .= qq(
+ <NameInformation>
+ <PersonalNameInformation>
+ <UnstructuredPersonalUserName>$propername</UnstructuredPersonalUserName>
+ </PersonalNameInformation>
+ </NameInformation>);
+ }
+ if (grep 'User Address Information', @requestedFields) {
+ $userOptionalFields .= $email;
+ }
+ # 'Date of Birth' not currently supported
+ # 'User Language' not currently supported
+ if (grep 'User Privilege', @requestedFields) {
+ $userOptionalFields .= qq(
+ <UserPrivilege>
+ <UniqueAgencyId>
+ <Scheme>$faidScheme</Scheme>
+ <Value>$faidValue</Value>
+ </UniqueAgencyId>
+ <AgencyUserPrivilegeType>
+ <Scheme>http://testing.purposes.only</Scheme>
+ <Value>PROFILE</Value>
+ </AgencyUserPrivilegeType>
+ <ValidToDate datatype="dateTime">$good_until</ValidToDate>
+ <UserPrivilegeStatus>
+ <UserPrivilegeStatusType>
+ <Scheme>http://testing.purposes.only</Scheme>
+ <Value>$userpriv</Value>
+ </UserPrivilegeStatusType>
+ </UserPrivilegeStatus>
+ </UserPrivilege>);
+ }
+ if (grep 'Block Or Trap', @requestedFields) {
+ $userOptionalFields .= $block_stanza;
+ }
+
+ if ($userOptionalFields) {
+ $userOptionalFields = qq(
+ <UserOptionalFields> $userOptionalFields
+ </UserOptionalFields>);
+ } else {
+ $userOptionalFields = qq(
+ <UserOptionalFields>
+ <VisibleUserId>
+ <VisibleUserIdentifierType>
+ <Scheme>http://blah.com</Scheme>
+ <Value>Barcode</Value>
+ </VisibleUserIdentifierType>
+ <VisibleUserIdentifier>$visid</VisibleUserIdentifier>
+ </VisibleUserId>
+ <NameInformation>
+ <PersonalNameInformation>
+ <UnstructuredPersonalUserName>$propername</UnstructuredPersonalUserName>
+ </PersonalNameInformation>
+ </NameInformation> $email
+ <UserPrivilege>
+ <UniqueAgencyId>
+ <Scheme>$faidScheme</Scheme>
+ <Value>$faidValue</Value>
+ </UniqueAgencyId>
+ <AgencyUserPrivilegeType>
+ <Scheme>http://testing.purposes.only</Scheme>
+ <Value>$userpriv</Value>
+ </AgencyUserPrivilegeType>
+ <ValidToDate datatype="dateTime">$good_until</ValidToDate>
+ </UserPrivilege> $block_stanza
+ </UserOptionalFields>);
+ }
+
+ my $hd = <<LOOKUPUSERRESPONSE;
+Content-type: text/xml
+
+
+<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
+<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
+ <LookupUserResponse>
+ <ResponseHeader>
+ <FromAgencyId>
+ <UniqueAgencyId>
+ <Scheme>$taidScheme</Scheme>
+ <Value>$taidValue</Value>
+ </UniqueAgencyId>
+ </FromAgencyId>
+ <ToAgencyId>
+ <UniqueAgencyId>
+ <Scheme>$faidScheme</Scheme>
+ <Value>$faidValue</Value>
+ </UniqueAgencyId>
+ </ToAgencyId>
+ </ResponseHeader>
+ <UniqueUserId>
+ <UniqueAgencyId>
+ <Scheme>$taidScheme</Scheme>
+ <Value>$taidValue</Value>
+ </UniqueAgencyId>
+ <UserIdentifierValue>$uniqid</UserIdentifierValue>
+ </UniqueUserId> $userOptionalFields
+ </LookupUserResponse>
+</NCIPMessage>
+
+LOOKUPUSERRESPONSE
+
+ print $hd;
+ $logger->info("NCIP: $faidValue LookupUser request for $id returned user $uniqid");
+}
+
+sub fail {
+ my $error_msg =
+ shift || "THIS IS THE DEFAULT / DO NOT HANG III NCIP RESP MSG";
+ print "Content-type: text/xml\n\n";
+
+ print <<ITEMREQ;
+<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
+<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
+ <ItemRequestedResponse>
+ <ResponseHeader>
+ <FromAgencyId>
+ <UniqueAgencyId>
+ <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&scheme=UniqueAgencyId</Scheme>
+ <Value></Value>
+ </UniqueAgencyId>
+ </FromAgencyId>
+ <ToAgencyId>
+ <UniqueAgencyId>
+ <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&scheme=UniqueAgencyId</Scheme>
+ <Value>$error_msg</Value>
+ </UniqueAgencyId>
+ </ToAgencyId>
+ </ResponseHeader>
+ </ItemRequestedResponse>
+</NCIPMessage>
+
+ITEMREQ
+
+ # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
+ $logger->error("NCIP: request failed: $error_msg");
+ die;
+}
+
+sub do_lookup_user_error_stanza {
+
+ # XXX: we should include FromAgencyId and ToAgencyId values, but they are not available to the code at this point
+ my $error = shift;
+ my $hd = <<LOOKUPPROB;
+Content-type: text/xml
+
+
+<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
+<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
+ <LookupUserResponse>
+ <ResponseHeader>
+ <FromAgencyId>
+ <UniqueAgencyId>
+ <Scheme></Scheme>
+ <Value></Value>
+ </UniqueAgencyId>
+ </FromAgencyId>
+ <ToAgencyId>
+ <UniqueAgencyId>
+ <Scheme></Scheme>
+ <Value></Value>
+ </UniqueAgencyId>
+ </ToAgencyId>
+ </ResponseHeader>
+ <Problem>
+ <ProcessingError>
+ <ProcessingErrorType>
+ <Scheme>http://www.niso.org/ncip/v1_0/schemes/processingerrortype/lookupuserprocessingerror.scm</Scheme>
+ <Value>$error</Value>
+ </ProcessingErrorType>
+ <ProcessingErrorElement>
+ <ElementName>AuthenticationInput</ElementName>
+ </ProcessingErrorElement>
+ </ProcessingError>
+ </Problem>
+ </LookupUserResponse>
+</NCIPMessage>
+
+LOOKUPPROB
+
+ print $hd;
+ $logger->info("NCIP: request failed: $error");
+ die;
+}
+
+# Login to the OpenSRF system/Evergreen.
+#
+# Returns a hash with the authtoken, authtime, and expiration (time in
+# seconds since 1/1/1970).
+sub login {
+
+ # XXX: local opensrf core conf filename should be in config.
+ # XXX: STAFF account with ncip service related permissions should be in config.
+ my $bootstrap = $conf->{path}->{opensrf_core};
+ my $uname = $conf->{auth}->{username};
+ my $password = $conf->{auth}->{password};
+
+ # Bootstrap the client
+ OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+ my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
+ Fieldmapper->import( IDL => $idl );
+
+ # Initialize CStoreEditor:
+ OpenILS::Utils::CStoreEditor->init;
+
+ my $seed = OpenSRF::AppSession->create('open-ils.auth')
+ ->request( 'open-ils.auth.authenticate.init', $uname )->gather(1);
+
+ return undef unless $seed;
+
+ my $response = OpenSRF::AppSession->create('open-ils.auth')->request(
+ 'open-ils.auth.authenticate.complete',
+ {
+ username => $uname,
+ password => md5_hex( $seed . md5_hex($password) ),
+ type => 'staff'
+ }
+ )->gather(1);
+
+ return undef unless $response;
+
+ my %result;
+ $result{'authtoken'} = $response->{payload}->{authtoken};
+ $result{'authtime'} = $response->{payload}->{authtime};
+ $result{'expiration'} = time() + $result{'authtime'}
+ if ( defined( $result{'authtime'} ) );
+ return %result;
+}
+
+# Check the time versus the session expiration time and login again if
+# the session has expired, consequently resetting the session
+# paramters. We want to run this before doing anything that requires
+# us to have a current session in OpenSRF.
+#
+# Arguments
+# none
+#
+# Returns
+# Nothing
+sub check_session_time {
+ if ( time() > $session{'expiration'} ) {
+ %session = login();
+ if ( !%session ) {
+ die("Failed to reinitialize the session after expiration.");
+ }
+ }
+}
+
+# Retrieve the logged in user.
+#
+sub get_session {
+ my $response =
+ OpenSRF::AppSession->create('open-ils.auth')
+ ->request( 'open-ils.auth.session.retrieve', $session{authtoken} )
+ ->gather(1);
+ return $response;
+}
+
+# Logout/destroy the OpenSRF session
+#
+# Argument is
+# none
+#
+# Returns
+# Does not return anything
+sub logout {
+ if ( time() < $session{'expiration'} ) {
+ my $response =
+ OpenSRF::AppSession->create('open-ils.auth')
+ ->request( 'open-ils.auth.session.delete', $session{authtoken} )
+ ->gather(1);
+ if ($response) {
+
+ # strong.silent.success
+ exit(0);
+ } else {
+ fail("Logout unsuccessful. Good-bye, anyway.");
+ }
+ }
+}
+
+# Convert a MARC::Record to XML for Evergreen
+#
+# Copied from Dyrcona's issa framework which copied
+# it from MVLC's Safari Load program which copied it
+# from some code in the Open-ILS example import scripts.
+#
+# Argument
+# A MARC::Record object
+#
+# Returns
+# String with XML for the MARC::Record as Evergreen likes it
+sub convert2marcxml {
+ my $input = shift;
+ ( my $xml = $input->as_xml_record() ) =~ s/\n//sog;
+ $xml =~ s/^<\?xml.+\?\s*>//go;
+ $xml =~ s/>\s+</></go;
+ $xml =~ s/\p{Cc}//go;
+ $xml = $U->entityize($xml);
+ $xml =~ s/[\x00-\x1f]//go;
+ return $xml;
+}
+
+# Get actor.usr.id from barcode.
+# Arguments
+# patron barcode
+#
+# Returns
+# actor.usr.id
+# or hash on error
+sub user_id_from_barcode {
+ check_session_time();
+ my ($barcode) = @_;
+
+ my $response;
+
+ my $e = new_editor( authtoken => $session{authtoken} );
+ return $response unless ( $e->checkauth );
+
+ my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
+ return $e->event unless ($card);
+
+ $response = $card->[0]->usr if (@$card);
+
+ $e->finish;
+
+ return $response;
+}
+
+# Flesh user information
+# Arguments
+# actor.usr.id
+#
+# Returns
+# fieldmapped, fleshed user or
+# event hash on error
+sub flesh_user {
+ check_session_time();
+ my ($id) = @_;
+
+ my $e = new_editor( authtoken => $session{authtoken} );
+ return undef unless ( $e->checkauth );
+
+ my $usr_flesh = {
+ flesh => 2,
+ flesh_fields => {
+ au => [
+ "card",
+ "cards",
+ "standing_penalties",
+ "home_ou",
+ 'profile'
+ ],
+ ausp => [
+ "standing_penalty"
+ ]
+ }
+ };
+ my $user = $e->retrieve_actor_user([$id, $usr_flesh]);
+ if ($user) {
+ return $user unless ( defined($conf->{auth}->{org_units}) );
+ my @orgs = split(/,\s*/, $conf->{auth}->{org_units});
+ if ( grep { $_ eq $user->home_ou->id } @orgs ) {
+ return $user;
+ }
+ }
+ return undef;
+}
+
+sub do_patron_auth {
+ my ($id, $password) = @_;
+ my $args = {
+ type => 'opac', # XXX
+ username => $id,
+ password => $password
+ };
+
+ my $auth_proxy_enabled = 0;
+ eval {
+ $auth_proxy_enabled = $U->simplereq(
+ 'open-ils.auth_proxy',
+ 'open-ils.auth_proxy.enabled'
+ );
+ };
+
+ my $response;
+ if ($auth_proxy_enabled) {
+ $response = $U->simplereq(
+ 'open-ils.auth_proxy',
+ 'open-ils.auth_proxy.login', $args);
+ } else {
+ $response = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.login', $args);
+ }
+ if($U->event_code($response)) {
+ $logger->info("iNCIPit: failed to authenticate user $id: " . $response->{textcode});
+ return undef;
+ }
+
+ # get basic patron info via user authtoken
+ my $authtoken = $response->{payload}->{authtoken};
+ my $user = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.session.retrieve', $authtoken);
+ if (!$user or $U->event_code($user)) {
+ $logger->error("iNCIPit: failed to retrieve user for session $authtoken");
+ return undef;
+ }
+ # don't leave an extra session hanging around
+ # for this user
+ $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.session.delete', $authtoken);
+ return $user->id;
+}
+
+sub _naive_encode_xml {
+ my $val = shift;
+
+ $val =~ s/&/&/g;
+ $val =~ s/</</g;
+ $val =~ s/>/>/g;
+
+ return $val;
+}
projects / working / random.git / commitdiff