Classic Note Entries

Perl Script

#!/iiidb/software/tpp/perl/bin/perl -w
use Net::LDAP;
use Net::LDAPS;
use strict;
use CGI qw(unescape);
#
#-----------------------------------------------------------------------
# This perl script is provided as an example for libraries that want to
# employ Innovative's "plugin" model for External Patron Verification.
#
# The example script queries multiple LDAP servers depending on the type 
# of user, e.g. staff/faculty vs. student; campus1 vs. campus2; etc.
#
# This script is not intended to be "standalone" but is instead called by 
# the Innovative checkLDAP script.
#
# Innovative provides this example script as a courtesy to libraries that
# have multiple LDAP servers.  The library is responsible for customizing 
# this script with local values, enhanced functionality, etc. 
#-----------------------------------------------------------------------
#
my $debug = "yes";
open (DEBUG, ">>/tmp/checkLDAP_dlevy.log") if ($debug eq "yes");
#
# LDAP connection information is stored in arrays of size 2.
# The script assumes that the first location (0) in the array 
# contains the connection information for the student LDAP server, 
# i.e. the input extpatserver = student, if  extpatserver = staff the
# script uses the connection information from the second location (1)
# in the following arrays.
# If there is no value in extpatserver, the script queryies the student
# LDAP server.
# These arrays should be initialized here with the real values.
# To customize this script for you system, configure the following 
# arrays:
#
# m_sLDAPServer : contains the host domain name of the LDAP servers.
#
# m_nPort :  specifies the port used to connect to the LDAP server.
#
# m_bUseLDAPS : set to 1 if you use a secure connection i.e. port 636, 
#         set to 0 if you use a non-secure connection.
# m_sBindBase : contains a string that defines which database to use 
#         on the LDAP server on the first bind command; 
#        if empty use anonymous bind.
#
# m_sBindPassword : contains the password of the administrator account 
#                 you use to bind. Set the password unencrypted, 
#           i.e. use the string you received from the LDAP 
#           adminstartor as it is.  
# m_sBindUser : set the login of the administartor account, or an empty string
#
# m_bUseOneBind: set to 1 if you use user's credentials to bind.
#
# m_sSearchAttribute : contains the primary search attribute to be used 
#           (university ID, for example) when searching for 
#           a given patron on the LDAP server.
#
# m_sSearchBase : contains the search DN used to retrieve user records.
#
# m_sIDAttribute : contains the attribute in the data returned by the LDAP
#                  server which is used as the patron search key on the
#           Millennium server.    
#
my @m_sLDAPServer = ("","");
my @m_nPort = ("","");
my @m_bUseLDAPS = (0,0);
my @m_sBindBase = ("","");
my @m_sBindPassword = ("","");
my @m_sBindUser = ("","");
my @m_bUseOneBind = (0,0);
my @m_sSearchAttribute = ("","");
my @m_sSearchBase = ("","");
my @m_sIDAttribute = ("","");
my $m_bUseLDAPPassword = 1;
my $m_bTryMillenniumAfterBadVerify = 0;
my @m_nTimeOut = (3,3);
my $m_sLDAPVersion = 3;
#
# Input variables are stored in teh following variables
#
my $m_sUserName = "";
my $m_sUserId = "";
my $m_sPassword = "";
my $m_sServer= "";
my $m_hLDAP;
my $m_whichServer = 0; #Identifies which server to query by index, either 0 or 1
my $m_hSearchMessage;
my $m_bVerbose = 0;
#my $m_bVerbose = 1;
my $m_nTimeOut = 3;
my $m_sOriginalUserId;
my $m_sResult = "Failed";
my $m_sLogMessage = "";
my $m_sIIIDB = "";
#------------------------------------------------------------
# log a message for each verification to $IIIDB/errlog/ldap.log
# append if is used to wrap log so it doesn't grow to big
#------------------------------------------------------------
sub logger
{
my $sMessage = shift;
my $sOutName = $m_sIIIDB . "/errlog/ldap.log";
if( ( -e "$sOutName" ) && ( -s "$sOutName" ) > 100000 )
    {
    rename( "$sOutName", "$sOutName.old" );
    system( "touch $sOutName" );
    }
open( OUT, ">>$sOutName" ) ||
    die( "Cannot appendf $sOutName\sn" );
my ($nSec,$nMin,$nHr,$nDay,$nMonth,$nYear,$sRest) = localtime();
my $sDenseTime = sprintf "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d",
                $nYear + 1900, $nMonth + 1, $nDay, $nHr, $nMin, $nSec;
print OUT "$sDenseTime:$m_sOriginalUserId:$m_sUserId" .
          ":$m_sLogMessage:$sMessage\sn";
if( $m_bVerbose )
    {
    print "$sDenseTime:$m_sOriginalUserId:$m_sUserId" .
              ":$m_sLogMessage:$sMessage\sn";
    }
close( OUT );
}
#----------------------------------------------------------------
#
# Innovative checkLDAP script
# The Innovative Perl script sends the following name/value pairs
# via STDIN to this plugin script:
#
#    extpatid= is the patron ID number.
#
#    extpatpw= is the patron password.
#
#    extpatserver= indicates the patron's choice of 
#    "student" or "staff"
#
#----------------------------------------------------------------
sub parseInput
{
while( <> )
        {
        chomp;
        for( split /\s&/ )
                {
                if( /^extpatname=(.*)/ )
                        {
                        $m_sUserName = unescape($1);
                        }
                elsif( /^extpatid=(.*)/ )
                        {
                        $m_sUserId = unescape($1);
                        }
                elsif( /^extpatpw=(.*)/ )
                        {
                        $m_sPassword = unescape($1);
                        }
                elsif( /^extpatserver=(.*)/ )
                        {
                        $m_sServer= unescape($1);
                        }
                }
        }
}
#---------------------------------------------------------------
#
# Open a connection to the LDAP server.
#
#---------------------------------------------------------------
sub doConnect
{
my      @aLDAPArgs;
push( @aLDAPArgs, $m_sLDAPServer[$m_whichServer] );
push( @aLDAPArgs, port => $m_nPort[$m_whichServer] );
if( $m_bUseLDAPS[$m_whichServer] )
    {
      $m_hLDAP = new Net::LDAPS( @aLDAPArgs ) ||
                 systemError( "Cannot create session, args=@aLDAPArgs" );
     }
else
    {
    $m_hLDAP = Net::LDAP->new( @aLDAPArgs ) ||
               systemError( "Cannot create session, args=@aLDAPArgs" );
     }
if( ! defined( $m_hLDAP ) )
     {
       systemError( "Bad return from LDAP->new with args=@aLDAPArgs" );
      }
if( $m_bVerbose )
        {
        print "LDAP connection established args=@aLDAPArgs\sn";
        }
return 1;
}
#------------------------------------------------------------
sub doBind
{
#expects the following parameters
my $sBindBase = shift;
my $sBindUser = shift;
my $sBindPassword = shift;
my $sMessage = shift;
my $bReturnOnVerifyError = shift;
my @aBindArgs;
my $mesg;
if( $sBindBase ne "" )
    {
    push( @aBindArgs, dn => $sBindBase ) ;
    }
if( $sBindPassword ne "" )
    {
    push( @aBindArgs, password => $sBindPassword );
    }
if( $m_sLDAPVersion ne "" )
    {
    push( @aBindArgs, version => $m_sLDAPVersion );
    }
$mesg = $m_hLDAP->bind( @aBindArgs ) ||
     systemError("Failed to bind args=dn $sBindBase version $m_sLDAPVersion");
if( $m_bVerbose )
    {
    print "Bindargs = @aBindArgs\sn";
    }
if( $mesg->code() )
    {
    if( $bReturnOnVerifyError )
        {
        return( 0 );
        }
    else
        {
        verifyError( "$sMessage:bind failed:mesg=" .
          "(". $mesg->code() . "),args=dn $sBindBase version $m_sLDAPVersion" );
        exit( 0 );
        }
    }
if( $m_bVerbose )
    {
    print "Bind succeeded\sn";
    }
return( 1 );
}
#------------------------------------------------------------
# performs a search, if the count is not 1 and there exists
# a fallback search method try that.
#------------------------------------------------------------
sub doSearch
{
my @aSearchArgs;
push( @aSearchArgs, base => $m_sSearchBase[$m_whichServer] );
my $sFilter = "$m_sSearchAttribute[$m_whichServer]=$m_sUserId";
push( @aSearchArgs, filter => "$sFilter" );
alarm $m_nTimeOut;
$m_hSearchMessage = $m_hLDAP->search( @aSearchArgs ) ||
                     systemError ("Failed on search args=@aSearchArgs");
alarm 0;
if( $m_hSearchMessage->code() )
    {
    verifyError( "search failed mesg=" .
                 "(". $m_hSearchMessage->code() . "),args=@aSearchArgs" );
    return 0;
    }
if( $m_bVerbose )
    {
    printf( "Search done: args=@aSearchArgs\sn" );
    }
my @aList = $m_hSearchMessage->all_entries;
my $nCount = $#aList + 1;
if( $m_bVerbose ) { print "Search found $nCount matching patrons\sn"; }
return $nCount;
}
#------------------------------------------------------------
sub checkPassword
{
my $hEntry = shift;
if( $m_bUseLDAPPassword == 0 ) { return 1; }
my $sVerifyUserName = $m_sUserId;
if( ! doBind( $hEntry->dn(),
        $sVerifyUserName,
        $m_sPassword,
        "Bad password",
         $m_bTryMillenniumAfterBadVerify ) )
    {
    return( 0 );
    }
$m_sLogMessage .= "good password ";
if( $m_bVerbose )
    {
    print "Password check succeeded\sn";
    }
return( 1 );
}
#------------------------------------------------------------
# verification has failed log and exit with string Error
#------------------------------------------------------------
sub verifyError
{
my $sMessage = shift;
$m_sUserId = "Error"; # this is the string we will return to the webpac
if( defined $m_hLDAP )
    {
    $m_hLDAP->unbind;
    }
logger( $sMessage );
print "extvererr=$sMessage\sn";
}
#------------------------------------------------------------
# log an error message to the syserr file
#------------------------------------------------------------
sub logError
{
my $sMessage = shift;
my $sSyserr = $m_sIIIDB . "/errlog/syserr";
if( open( SYSERR, ">>$sSyserr" ) )
    {
    print SYSERR "$sMessage\sn";
    close( SYSERR );
    }
}
#------------------------------------------------------------
# log an error message to the syserr file and exit with Error
#------------------------------------------------------------
sub systemError
{
my $sMessage = shift;
$m_sUserId = "Error"; # this is the string we will return to the webpac
if( defined $m_hLDAP )
    {
    $m_hLDAP->unbind;
    }
logger( "$sMessage ($!)" );
logError( "$sMessage ($!)" );
print "extsyserr=$sMessage\sn";
exit 1;
}
#---------------------------------------------------------------
sub cleanUpAndExit
{
$m_hLDAP->unbind; # take down session
exit 0;
}
#---------------------------------------------------------------
sub notFound
{
my $sMessage = shift;
if( ! defined( $sMessage ) ) { $sMessage = "no message"; }
print "extvererr=$sMessage\sn";
cleanUpAndExit();
}
#------------------------------------------------------------
# catches alarm, we set alarm so we don't wait forever for the ldap server
#------------------------------------------------------------
sub catchAlarm
{
logError( "Timeout occurred" );
}
#------------------------------------------------------------
#
#   main() starts here
#
# it is CRITICAL that nothing read stdin that will be done by
# parseInput after the globals are loaded and a user script
# has been ruled out
#
#------------------------------------------------------------
$SIG{ALRM} = \s&catchAlarm;
parseInput();
 print DEBUG "The userID entered is: $m_sUserId\sn" if ($debug eq "yes");
$m_sOriginalUserId = $m_sUserId;
if( $m_sPassword eq "" )
        {
        verifyError( "password not specified" );
        exit( 0 );
        }
if( $m_sUserId eq "" )
        {
        verifyError( "got empty lookup field" );
        exit( 0 );
        }
if( $m_sServer eq "staff" )
    {
    $m_whichServer = 1;
    }
else
    {
    $m_whichServer = 0;
    }
if( ! doConnect() )
    {
    exit 0;
    }
if( $m_bUseOneBind[$m_whichServer] )
    {
    my $sTempUserName = $m_sUserId;
    }
if( ! doBind($m_sBindBase[$m_whichServer], $m_sBindUser[$m_whichServer], 
     $m_sBindPassword[$m_whichServer] ,"",$m_bUseOneBind[$m_whichServer] ))
    {
    notFound( "no bind" );
    }
my $nMatchCount = doSearch();
if( $nMatchCount == 0 )
    {
    $m_sLogMessage .= "not on LDAP, ";
    notFound( "not found" );
    }
elsif( $nMatchCount == 1 )
    {
    $m_sLogMessage .= "on LDAP ";
    my @aList = $m_hSearchMessage->all_entries;
    my $hEntry = pop @aList;
    if( $m_bVerbose )
        {
        print "Entry dn= " . $hEntry->dn() . "\sn";
        $hEntry->dump;
        }
    if( ! $m_bUseOneBind[$m_whichServer] && ! checkPassword( $hEntry ) )
        {
        $m_sLogMessage .= "failed password on LDAP, ";
        notFound( "failed password" );
        }
    else
        {
        my @sID = $hEntry->get_value( $m_sIDAttribute[$m_whichServer] );
        my $sID;
        if( ! @sID )
        {
        verifyError("Could not find attribute $m_sIDAttribute[$m_whichServer]");
            notFound( "no attribute" );
        }
        $sID = $sID[0];
        if( ! defined( $sID ) || $sID eq "" )
        {
        verifyError("Could not get attribute $m_sIDAttribute[$m_whichServer]");
            notFound( "no attribute" );
        }
        $m_sUserId = $sID;
        }
    }
else
    {
    $m_sLogMessage .= "many on LDAP ";
    verifyError( "$m_sUserId had $nMatchCount matches on LDAP server" );
    }
logger( "OK" );
print "extid=$m_sUserId\sn";
cleanUpAndExit();
1;