External Authentication
Adaptor Example
#!/usr/local/bin/perl -w
#############################################################
#
# Perl script: login.cgi
# Version: 1.3
#
# 2005-2006, Michael Doran, doran@uta.edu
# University of Texas at Arlington
#
# This script is a customer-created adaptor as required
# to implement Voyager external patron authentication.
#
# Designed to run on the Voyager database server.
# Accommodates a separate WebVoyage server.
#
# Requires these Perl modules:
# Net::LDAP
# DBI
# DBD::Oracle
#
# Relevant WebVoyage server opac.ini settings:
#
# [ExtAuthenticationSystem]
# ExtAuthSystemEnabled=Y
# ExtAuthBypassLoginScreen=Y
# ExtAuthSystemURL=http[s]://vygrdb.svr.edu/cgi-bin/login.cgi
# Best practice
use strict;
#
use DBI;
# Some script variables
my $this_script = "/cgi-bin/login.cgi";
my $page_title = "Patron Login";
my $version = "1.3";
# If run on a separate WebVoyage server
# Also modify the action attribute of the form tag in the
# login HTML form for the "traditional" way.
my $webvoyage_base_URL = "https://webvoyage.univ.edu";
my $pwebrecon_base_URL = "$webvoyage_base_URL/cgi-bin/Pwebrecon.cgi?";
#############################################################
#
# LDAP server variables
#
# University of Texas at Arlington LDAP servers:
# ldap.univ.edu - LDAP server load balancer
# ldap01.univ.edu - individual LDAP server
# ldap02.univ.edu - individual LDAP server
#
# Connection approaches:
# OK : Connect to an individual LDAP server.
# Better : Connect to a LDAP server load balancer (if your campus has
# one). This will distribute the load among available LDAP
# servers and authentication will succeed even if one of the
# individual LDAP servers is unavailable.
# Best : Per the Net::LDAP documentation, create a list (array) of
# LDAP servers, putting the LDAP load balancing host first,
# followed by the individual LDAP servers. Reference the
# array, and connect to the array reference. Each host in
# the list will be tried in order until a connection is made.
# This avoids a single point of failure of either an
# individual LDAP server *or* the LDAP load balancer.
# List (array) of LDAP servers and array reference
my @ldap_server = ('ldap.univ.edu',
'ldap01.univ.edu',
'ldap02.univ.edu');
my $rldap_server = \@ldap_server;
# Attribute from the LDAP record whose value will be matched
# against the values in PATRON.NORMAL_INSTITUTION_ID in Voyager
my $ldap_iid_attr = "univID";
##############################################################
#
# Voyager/Oracle variables
#
# This script executes an Oracle DML (Data Manipulation
# Language) statement (i.e. "insert"), so a "read-only"
# Oracle username and password can NOT be used. You
# MUST use the production username and password. Your
# production username/password are the values for USERPASS
# in your voyager.env file.
$ENV{ORACLE_SID} = "******";
$ENV{ORACLE_HOME} = "/oracle/app/oracle/product/9.2.0";
my $ora_db_username = "******";
my $ora_db_password = "******";
my $db_name = "******";
my $db_table = "wopac_pid_patron_keys";
my ($user_name,$pw);
# Parse form data
my %formdata;
&ReadParse;
##############################################################
#
# Input:
# - passed from WebVoyage (Pwebrecon), or
# - the login form
#
my $query_string;
if ($ENV{'QUERY_STRING'}) {
$query_string = $ENV{'QUERY_STRING'};
} else {
$query_string = $formdata{'query_string'};
}
my $pid = $formdata{'PID'};
my $seq = $formdata{'SEQ'};
my $pweb_page = $formdata{'PAGE'};
my $patron_ext_username = $formdata{'ext_id'};
my $patron_ext_password = $formdata{'ext_pw'};
my $external = $formdata{'external'};
my $cred_type = "NetID";
# Sometimes it's helpful to have this line towards the
# top of a script that normally outputs to the web...
#print "Content-type: text/html\n\n";
# Logic on what to do based on the input
if ($external) {
&AuthenticatePatron("$patron_ext_username", "$patron_ext_password");
} else {
if ($pid) {
&PrintLoginForm;
} else {
# If the login script URL is bookmarked, this will get it via
# a detour thru Pwebrecon.cgi in order to pick up a valid PID
print "Location: $webvoyage_base_URL/cgi-bin/Pwebrecon.cgi?DB=local&PAGE=pbLogon\n\n";
}
}
############################################################
# PrintLoginForm
############################################################
sub PrintLoginForm {
my ($message) = @_;
# Location of your HTML login form components, in
# relation to your Voyager cgi-bin directory
my $form_dir = "../html/adaptor";
print "Content-type: text/html\n\n";
print qq(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<link rel="stylesheet" type="text/css" href="/css/login.css" />
);
&PrintInc ("../html/header.htm");
if ($pid) {
&PrintButtons;
}
if ($message) {
print "<b>$message</b>" . "\n";
}
print qq(
<br />
<table align="center" cellpadding="12">
<tr>
<td class="tdform">
<form action="/cgi-bin/login.cgi" method="post">
<br />
<table cellpadding="8">
<tr>
<th>Students, faculty, & staff</th>
</tr>
<tr>
<td class="right">
<b>NetID:</b> <input name="ext_id" type="text" size="20" /><br />
<b>Password:</b> <input name="ext_pw" type="password" size="20" /><br />
</td>
</tr>
</table>
<br />
);
if ($pid) {
print qq(\t<input type="hidden" name="PID" value="$pid" />\n);
}
if ($query_string) {
print qq(\t<input type="hidden" name="query_string" value="$query_string" />\n);
}
print qq(
<input type="submit" value="NetID Login" name="external" />
</form>
</td>
<td class="divider">
OR
<br />
</td>
<td class="tdform">
<form name="logonpage" action="$webvoyage_base_URL/cgi-bin/Pwebrecon.cgi" method="post"
autocomplete="OFF" enctype="application/x-www-form-urlencoded">
<br />
<table cellpadding="8">
<tr>
<th><a href="http://someurl.edu">Guest Borrowers</a></th>
</tr>
<tr>
<td class="right">
Barcode: <input name="BC" type="password" size="20" /><br />
Last Name: <input name="LN" type="text" size="20" /><br />
</td>
</tr>
</table>
<br />
);
if ($pid) {
print qq(\t<input type="hidden" name="PID" value="$pid" />\n);
}
if ($seq) {
print qq(\t<input type="hidden" name="SEQ" value="$seq" />\n);
}
if ($pweb_page) {
print qq(\t<input type="hidden" name="PAGE" value="$pweb_page" />\n);
}
print qq(
<input type="hidden" name="LGNT" value="0" />
<input type="submit" value="Barcode Login" name="internal" />
</form>
</td>
</tr>
</table>
</body>
</html>
);
exit(0);
}
############################################################
# PrintButtons
############################################################
sub PrintButtons {
my $uta_prefix = "$webvoyage_base_URL/images/";
print <<EOFSTUFF;
<br />
<div align="center">
<a href="$pwebrecon_base_URL\PAGE=sbSearch&SEQ=$seq&PID=$pid">
<img src="${uta_prefix}UpSearch.gif" alt="Back to Catalog" border="0" /></a>
<img src="${uta_prefix}DownLogin.gif" alt="Login Page" border="0" />
<a href="$webvoyage_base_URL/help/login.htm">
<img src="${uta_prefix}UpHelp.gif" alt="Help" border="0" /></a>
<a href="$pwebrecon_base_URL\PAGE=Exit&SEQ=$seq&PID=$pid">
<img src="${uta_prefix}UpExit.gif" alt="Exit" border="0" /></a>
</div>
EOFSTUFF
}
############################################################
# AuthenticatePatron
############################################################
#
#
sub AuthenticatePatron {
my ($user_name, $pw) = @_;
if ((! $user_name) && (! $pw)) {
&AuthenticationFailure("2","No $cred_type username and password entered.");
} elsif (! $user_name) {
&AuthenticationFailure("2","No $cred_type username entered.");
} elsif (! $pw) {
&AuthenticationFailure("2","No $cred_type password entered.");
}
use Net::LDAP;
# Create a new Net::LDAP object and open a connection
# to an LDAP server.
my $ldap = Net::LDAP->new( $rldap_server,
version => 3,
port => 389,
debug => 0 )
or &AuthenticationFailure("1","$@");
# Uncomment these lines to determine the LDAP version(s).
# Note: LDAPv3 is required for the TLS encryption method below.
#my $dse = $ldap->root_dse();
#my $versions = $dse->get_value('supportedLDAPVersion', asref => 1);
#print "LDAP versions are @$versions\n";
# The start_tls method converts the existing connection to
# Transport Layer Security (TLS), which provides encrypted
# traffic. It is an alternative to using LDAPS.
# The verify options are 'none', 'optional', and 'require'.
# The most secure option is 'require'.
# If you set verify to optional or require, you must also set
# either cafile or capath. If you have installed Apache with
# SSL, you can probably use the ca-bundle.crt as your cafile
# file, but make sure it has the necessary read permissions.
my $mesg = $ldap->start_tls(
verify => 'require',
cafile => '/usr/local/apache/conf/ssl.crt/ca-bundle.crt'
);
# Uncomment this to see the type of server cipher being used
#print "$ldap_server cipher: " . $ldap->cipher . "\n";
my $user = "uid=$user_name, cn=accounts, dc=uta, dc=edu";
$mesg = $ldap->bind("$user", password => "$pw");
if ($mesg->code ne "0") {
my $error_message = $mesg->error;
&AuthenticationFailure("2","$error_message");
}
# These values are dependent on the particular LDAP
# implementation.
$mesg = $ldap->search(
base => 'cn=people, dc=uta, dc=edu',
scope => 'subtree',
filter => "(AccountName=$user_name)"
);
# For debugging
# warn $mesg->error if $mesg->code ne "0";
my $max = $mesg->count;
my $institution_id;
if ($max == 1) {
my @entries = $mesg->entries;
my $entr ;
foreach $entr ( @entries ) {
foreach my $attr (sort $entr->attributes) {
if ($attr eq "$ldap_iid_attr") {
$institution_id = $entr->get_value("$ldap_iid_attr");
}
}
}
if ($institution_id) {
&InsertPatronInfo($pid,$institution_id);
&Redirect("success");
} else {
&AuthenticationFailure(5,"LDAP record lacks required attribute.");
}
} else {
&Redirect("failure");
}
# For debugging...
# print "\$mesg->count is $max\n";
# foreach my $entry ($mesg->all_entries) {
# print "<pre>";
# $entry->dump;
# print "</pre>";
# }
$ldap->unbind();
}
##########################################################
# InsertPatronInfo
##########################################################
#
#
sub InsertPatronInfo {
my ($pid, $institution_id) = @_;
use DBI;
my ($dbh,$sth);
$dbh = DBI->connect('dbi:Oracle:', $ora_db_username, $ora_db_password,
{AutoCommit => 1}) || die "Could not connect: $DBI::errstr\n";
# Clean out any "orphan" entries in the wopac_pid_patron_keys table
# that are associated with this patron.
my $sql_string = "delete from $db_name.$db_table where
$db_name.$db_table.pid = '$pid' or
$db_name.$db_table.patron_key = '$institution_id'";
$sth = $dbh->prepare($sql_string) || warn $dbh->errstr;
$sth->execute || warn $dbh->errstr;
$sth->finish;
# Insert the PID and Institution ID values into the
# wopac_pid_patron_keys table.
$sql_string = "insert into $db_name.$db_table (pid, patron_key)
values ('$pid','$institution_id')";
$sth = $dbh->prepare($sql_string) || warn $dbh->errstr;
$sth->execute || warn $dbh->errstr;
$sth->finish;
$dbh->disconnect;
}
############################################################
# Redirect
############################################################
#
sub Redirect {
my ($result) = @_;
my $redirect_url = "$webvoyage_base_URL/cgi-bin/Pwebrecon.cgi?$query_string&authenticate=";
if ($result =~ /success/i) {
$redirect_url .= "Y";
} else {
$redirect_url .= "N";
}
print "Location: $redirect_url\n\n";
exit(0);
}
############################################################
# AuthenticationFailure
############################################################
#
# When called, this subroutine should be passed two
# parameters: 1) an exit code, and 2) an error message
sub AuthenticationFailure {
my ($exit_status, $error_message) = @_;
# Check that the value passed as an exit
# status makes sense (i.e. is a digit).
if (! ($exit_status =~ /\d/) ) {
$exit_status = 9;
}
&PrintLoginForm ("Authentication Failed: $error_message\n");
exit($exit_status);
}
############################################################
# PrintInc
############################################################
#
# Prints "include" files.
# Usage: &PrintInc ("../somefile.inc");
sub PrintInc {
my ($inc_file) = @_;
open (INCLUDE, "$inc_file") || warn "Can't open file.\n";
while (<INCLUDE>) {
print;
}
close (INCLUDE);
}
##########################################################
# ReadParse
##########################################################
#
# ReadParse reads in and parses the CGI input.
# It reads / QUERY_STRING ("get" method)
# \ STDIN ("post" method)
sub ReadParse {
my ($meth, $formdata, $pair, $name, $value);
# Retrieve useful ENVIRONMENT VARIABLES
$meth = $ENV{'REQUEST_METHOD'};
# If method unspecified or if method is GET
if ($meth eq '' || $meth eq 'GET') {
# Read in query string
$formdata = $ENV{'QUERY_STRING'};
}
# If method is POST
elsif ($meth eq 'POST') {
read(STDIN, $formdata, $ENV{'CONTENT_LENGTH'});
}
else {
die "Unknown request method: $meth\n";
}
# name-value pairs are separated and put into a list array
my @pairs = split(/&/, $formdata);
foreach $pair (@pairs) {
# names and values are split apart
($name, $value) = split(/=/, $pair);
# pluses (+'s) are translated into spaces
$value =~ tr/+/ /;
# hex values (%xx) are converted to alphanumeric
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if ( $name ne "PID") {
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
}
# The code below attempts to ferret out shell meta-characters
# in the form input. It replaces them with spaces.
# looking for the presence of shell meta-characters in $name
$name =~ s/[{}\!\$;><&\*'\|]/ /g;
# looking for the presence of shell meta-characters in $value
# NOTE: Removed "&" for the WebVoyage alternate login script!
# and also let password value bypass this check, since secure
# passwords will often have non alphanumeric values.
if ( $name ne "ext_pw" && $name ne "PID" ) {
$value =~ s/[{}\!\$;><\*'\|]/ /g;
}
# associative array of names and values created
$formdata{$name} = $value;
}
}
exit(0);