From 863db634db50054b74e632bb0a78a8c0ddc412cd Mon Sep 17 00:00:00 2001 From: djfiander Date: Thu, 9 Mar 2006 03:22:32 +0000 Subject: [PATCH] Initial revision --- ILS.pm | 16 + ILS/Item.pm | 35 ++ ILS/Patron.pm | 237 +++++++++ SIPServer.pm | 253 ++++++++++ SIPconfig.xml | 50 ++ Sip.pm | 31 ++ Sip/Checksum.pm | 54 ++ Sip/Configuration.pm | 100 ++++ Sip/Configuration/Account.pm | 43 ++ Sip/Configuration/Institution.pm | 31 ++ Sip/Configuration/Service.pm | 25 + Sip/Constants.pm | 323 ++++++++++++ Sip/MsgType.pm | 1016 ++++++++++++++++++++++++++++++++++++++ acstest.py | 42 ++ test.txt | 11 + xmlparse.pl | 28 ++ 16 files changed, 2295 insertions(+) create mode 100644 ILS.pm create mode 100644 ILS/Item.pm create mode 100644 ILS/Patron.pm create mode 100644 SIPServer.pm create mode 100644 SIPconfig.xml create mode 100644 Sip.pm create mode 100644 Sip/Checksum.pm create mode 100644 Sip/Configuration.pm create mode 100644 Sip/Configuration/Account.pm create mode 100644 Sip/Configuration/Institution.pm create mode 100644 Sip/Configuration/Service.pm create mode 100644 Sip/Constants.pm create mode 100644 Sip/MsgType.pm create mode 100644 acstest.py create mode 100644 test.txt create mode 100644 xmlparse.pl diff --git a/ILS.pm b/ILS.pm new file mode 100644 index 0000000..52759fb --- /dev/null +++ b/ILS.pm @@ -0,0 +1,16 @@ +# +# ILS.pm: Test ILS interface module +# + +package ILS; + +use Exporter; +use warnings; +use strict; +use Sys::Syslog qw(syslog); + +our (@ISA, @EXPORT_OK); + +@ISA = qw(Exporter); + +1; diff --git a/ILS/Item.pm b/ILS/Item.pm new file mode 100644 index 0000000..8f6a4b5 --- /dev/null +++ b/ILS/Item.pm @@ -0,0 +1,35 @@ +# +# ILS::Item.pm +# +# A Class for hiding the ILS's concept of the item from the OpenSIP +# system +# + +package ILS::Item; + +use strict; +use warnings; +use Exporter; + +our (@ISA, @EXPORT_OK); + +@ISA = qw(Exporter); + +our %item_db; + +sub new { + my ($class, $item_id) = @_; + my $type = ref($class) || $class; + my $self; + + if (!exists($item_db{$item_id})) { + return undef; + } + + $self = $item_db{$item_id}; + bless $self, $type; + return $self; +} + + +1; diff --git a/ILS/Patron.pm b/ILS/Patron.pm new file mode 100644 index 0000000..2b49774 --- /dev/null +++ b/ILS/Patron.pm @@ -0,0 +1,237 @@ +# +# ILS::Patron.pm +# +# A Class for hiding the ILS's concept of the patron from the OpenSIP +# system +# + +package ILS::Patron; + +use strict; +use warnings; +use Exporter; + +our (@ISA, @EXPORT_OK); + +@ISA = qw(Exporter); + +@EXPORT_OK = qw(invalid_patron); + +our %patron_db = ( + djfiander => { + name => "David J. Fiander", + id => 'djfiander', + password => '6789', + address => '2 Meadowvale Dr. St Thomas, ON', + charge_ok => 'Y', + renew_ok => 'Y', + recall_ok => 'N', + hold_ok => 'Y', + card_lost => 'N', + items_charged => 5, + items_overdue => 1, + claims_returned => 0, + fines => 100, + fees => 0, + recall_overdue => 0, + items_billed => 0, + }, + ); + +sub new { + my ($class, $patron_id) = @_; + my $type = ref($class) || $class; + my $self; + + if (!exists($patron_db{$patron_id})) { + return undef; + } + + $self = $patron_db{$patron_id}; + bless $self, $type; + return $self; +} + +sub id { + my $self = shift; + + return $self->{id}; +} + +sub name { + my $self = shift; + + return $self->{name}; +} + +sub address { + my $self = shift; + + return $self->{address}; +} + + + +sub charge_ok { + my $self = shift; + + return $self->{charge_ok}; +} + +sub renew_ok { + my $self = shift; + + return $self->{renew_ok}; +} + +sub recall_ok { + my $self = shift; + + return $self->{recall_ok}; +} + +sub hold_ok { + my $self = shift; + + return $self->{hold_ok}; +} + +sub card_lost { + my $self = shift; + + return $self->{card_lost}; +} + +sub items_charged { + my $self = shift; + + return $self->{items_charged}; +} + +sub items_overdue { + my $self = shift; + + return $self->{items_overdue}; +} + +sub claims_returned { + my $self = shift; + + return $self->{claims_returned}; +} + +sub fines { + my $self = shift; + + return $self->{fines}; +} + +sub fees { + my $self = shift; + + return $self->{fees}; +} + +sub recall_overdue { + my $self = shift; + + return $self->{recall_overdue}; +} + +sub items_billed { + my $self = shift; + + return $self->{items_billed}; +} + +sub check_password { + my ($self, $pwd) = @_; + + return ($self->{password} eq $pwd); +} + +sub currency { + my $self = shift; + + return $self->{currency}; +} + +sub fee_amount { + my $self = shift; + + return $self->{fee_amount} || undef; +} + +sub screen_msg { + my $self = shift; + + return $self->{screen_msg}; +} + +sub print_line { + my $self = shift; + + return $self->{print_line}; +} + +sub too_many_charged { + my $self = shift; + + return $self->{too_many_charged}; +} + +sub too_many_overdue { + my $self = shift; + + return $self->{too_many_overdue}; +} + +sub too_many_renewal { + my $self = shift; + + return $self->{too_many_renewal}; +} + +sub too_many_claim_return { + my $self = shift; + + return $self->{too_many_claim_return}; +} + +sub too_many_lost { + my $self = shift; + + return $self->{too_many_lost}; +} + +sub excessive_fines { + my $self = shift; + + return $self->{excessive_fines}; +} + +sub excessive_fees { + my $self = shift; + + return $self->{excessive_fees}; +} + +sub too_many_billed { + my $self = shift; + + return $self->{too_many_billed}; +} + +# +# Messages +# + +sub invalid_patron { + return "Please contact library staff"; +} + +sub charge_denied { + return "Please contact library staff"; +} + +1; diff --git a/SIPServer.pm b/SIPServer.pm new file mode 100644 index 0000000..5b95f6a --- /dev/null +++ b/SIPServer.pm @@ -0,0 +1,253 @@ +package ACSServer; + +use strict; +use warnings; +use Exporter; +use Sys::Syslog qw(syslog); +use Net::Server::PreFork; +use IO::Socket::INET; +use Data::Dumper; # For debugging + +#use Sip qw(readline); +use Sip::Constants qw(:all); +use Sip::Configuration; +use Sip::Checksum qw(checksum verify_cksum); +use Sip::MsgType; + +use constant LOG_SIP => "local6"; # Local alias for the logging facility + +our @ISA = qw(Net::Server::PreFork); +# +# Main +# + +my %transports = ( + RAW => \&raw_transport, + telnet => \&telnet_transport, + http => \&http_transport, +); + +# Read configuration + +my $config = new Sip::Configuration $ARGV[0]; + +my @parms; + +# +# Ports to bind +# +foreach my $svc (keys %{$config->{listeners}}) { + push @parms, "port=" . $svc; +} + +# +# Logging +# +push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server", + "syslog_facility=" . LOG_SIP; + + +print Dumper(@parms); + +# +# This is the main event. +ACSServer->run(@parms); + +# +# Child +# + +# process_request is the callback used by Net::Server to handle +# an incoming connection request. + +sub process_request { + my $self = shift; + my $service; + my ($sockaddr, $port, $proto); + my $transport; + + $self->{config} = $config; + + $sockaddr = $self->{server}->{sockaddr}; + $port = $self->{server}->{sockport}; + $proto = $self->{server}->{proto}; + + $self->{service} = $config->find_service($sockaddr, $port, $proto); + + if (!defined($self->{service})) { + syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); + die "process_request: Bad server connection"; + } + + $transport = $transports{$self->{service}->{transport}}; + + if (!defined($transport)) { + syslog("LOG_WARN", "Unknown transport '%s', dropping", $service->{transport}); + return; + } else { + &$transport($self); + } +} + +# +# Transports +# + +sub raw_transport { + my $self = shift; + my ($uid, $pwd); + my $input; + my $service = $self->{service}; + my $strikes = 3; + my $expect; + my $inst; + local $/ = "\r"; + + eval { + local $SIG{ALRM} = sub { die "alarm\n"; }; + syslog("LOG_DEBUG", "raw_transport: timeout is %d", + $service->{timeout}); + while ($strikes--) { + alarm $service->{timeout}; + $input = ; + alarm 0; + + if (!$input) { + # EOF on the socket + syslog("LOG_INFO", "raw_transport: shutting down"); + return; + } + + $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator + + last if Sip::MsgType::handle($input, $self, LOGIN); + } + }; + + if ($@) { + syslog("LOG_ERR", "raw_transport: LOGIN TIMED OUT: '$@'"); + die "raw_transport: login timed out, exiting"; + } elsif (!$self->{account}) { + syslog("LOG_ERR", "raw_transport: LOGIN FAILED"); + die "raw_transport: Login failed, exiting"; + } + + syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", + $self->{account}->{id}, + $self->{account}->{institution}); + + $inst = $self->{account}->{institution}; + $self->{institution} = $self->{config}->{institutions}->{$inst}; + $self->{policy} = $self->{institution}->{policy}; + + $self->sip_protocol_loop(); + + syslog("LOG_INFO", "raw_transport: shutting down"); +} + +sub telnet_transport { + my $self = shift; + my ($uid, $pwd); + my $strikes = 3; + my $account = undef; + my $input; + my $config = $self->{config}; + local $/ = "\n"; + + # Until the terminal has logged in, we don't trust it + # so use a timeout to protect ourselves from hanging. + eval { + local $SIG{ALRM} = sub { die "alarm\n"; }; + local $|; + my $timeout = 0; + + $| = 1; # Unbuffered output + $timeout = $config->{timeout} if (exists($config->{timeout})); + + while ($strikes--) { + print "login: "; + alarm $timeout; + $uid = ; + alarm 0; + + print "password: "; + alarm $timeout; + $pwd = ; + alarm 0; + + $uid =~ s/[\r\n]+$//; + $pwd =~ s/[\r\n]+$//; + + if (exists($config->{accounts}->{$uid}) + && ($pwd eq $config->{accounts}->{$uid}->password())) { + $account = $config->{accounts}->{$uid}; + last; + } else { + syslog("LOG_WARNING", "Invalid login attempt: '%s'", $uid); + print("Invalid login\n"); + } + } + }; # End of eval + + if ($@) { + syslog("LOG_ERR", "telnet_transport: Login timed out"); + die "Telnet Login Timed out"; + } elsif (!defined($account)) { + syslog("LOG_ERR", "telnet_transport: Login Failed"); + die "Login Failure"; + } else { + print "Login OK. Initiating SIP\n"; + } + + $self->{account} = $account; + + $self->sip_protocol_loop(); + syslog("LOG_INFO", "telnet_transport: shutting down"); +} + +# +# The terminal has logged in, using either the SIP login process +# over a raw socket, or via the pseudo-unix login provided by the +# telnet transport. From that point on, both the raw and the telnet +# processes are the same: +sub sip_protocol_loop { + my $self = shift; + my $expect; + my $service = $self->{service}; + my $input; + + local $/ = "\r"; # SIP protocol message terminator + + # Now that the terminal has logged in, the first message + # we recieve must be an SC_STATUS message. But it might be + # an SC_REQUEST_RESEND. So, as long as we keep receiving + # SC_REQUEST_RESEND, we keep waiting for an SC_STATUS + $expect = SC_STATUS; + + while ($input = ) { + my $status; + + $input =~ s/[\r\n]+$//sm; # Strip off any trailing line ends + + $status = Sip::MsgType::handle($input, $self, $expect); + next if $status eq REQUEST_ACS_RESEND; + + if (!$status) { + syslog("LOG_ERR", "raw_transport: failed to handle %s", + substr($input, 0, 2)); + die "raw_transport: dying"; + } elsif ($expect && ($status ne $expect)) { + # We received a non-"RESEND" that wasn't what we were + # expecting. + syslog("LOG_ERR", + "raw_transport: expected %s, received %s, exiting", + $expect, $input); + die "raw_transport: exiting: expected '$expect', received '$status'"; + } + # We successfully received and processed what we were expecting + # to receive + $expect = ''; + } +} +sub http_transport { +} diff --git a/SIPconfig.xml b/SIPconfig.xml new file mode 100644 index 0000000..a53b846 --- /dev/null +++ b/SIPconfig.xml @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Sip.pm b/Sip.pm new file mode 100644 index 0000000..6729ce2 --- /dev/null +++ b/Sip.pm @@ -0,0 +1,31 @@ +# +# Sip.pm: General Sip utility functions +# + +package Sip; + +use strict; +use warnings; +use English; +use Exporter; +use POSIX qw(strftime); +use Sip::Constants qw(SIP_DATETIME); +our @ISA = qw(Exporter); + +our @EXPORT_OK = qw(y_or_n timestamp); + +sub y_or_n { + my $bool = shift; + + $bool = uc $bool; + if (!$bool || ($bool eq 'NO') || ($bool eq 'FALSE')) { + return 'N'; + } else { + return 'Y'; + } +} + +sub timestamp { + return strftime(SIP_DATETIME, localtime()); +} +1; diff --git a/Sip/Checksum.pm b/Sip/Checksum.pm new file mode 100644 index 0000000..dd5776b --- /dev/null +++ b/Sip/Checksum.pm @@ -0,0 +1,54 @@ + +package Sip::Checksum; + +use Exporter; +use strict; +use warnings; + +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(checksum verify_cksum); + +sub checksum { + my $pkt = shift; + + return (-unpack("%16C*", $pkt)) & 0xFFFF; +} + +sub verify_cksum { + my $pkt = shift; + my $cksum; + my $shortsum; + + return 0 if (substr($pkt, -6, 2) ne "AZ"); # No checksum at end + + # Convert the checksum back to hex and calculate the sum of the + # pack without the checksum. + $cksum = hex(substr($pkt, -4)); + $shortsum = unpack("%16C*", substr($pkt, 0, -4)); + + # The checksum is valid if the hex sum, plus the checksum of the + # base packet short when truncated to 16 bits. + return (($cksum + $shortsum) & 0xFFFF) == 0; +} + +{ + no warnings qw(once); + eval join('',) || die $@ unless caller(); +} +__END__ + +# +# Some simple test data +# +sub test { + my $testpkt = shift; + my $cksum = checksum($testpkt); + my $fullpkt = sprintf("%s%4X", $testpkt, $cksum); + + print $fullpkt, "\n"; +} + +while (<>) { + chomp; + test($_); +} diff --git a/Sip/Configuration.pm b/Sip/Configuration.pm new file mode 100644 index 0000000..75c83f0 --- /dev/null +++ b/Sip/Configuration.pm @@ -0,0 +1,100 @@ +# +# parse-config: Parse an XML-format +# ACS configuration file and build the configuration +# structure. +# + +package Sip::Configuration; + +use strict; +use English; +use warnings; +use XML::Simple qw(:strict); + +use Sip::Configuration::Institution; +use Sip::Configuration::Account; +use Sip::Configuration::Service; + +my $parser = new XML::Simple( KeyAttr => { login => '+id', + institution => '+id', + service => '+port' }, + GroupTags => { listeners => 'service', + accounts => 'login', + institutions => 'institution', }, + ForceArray=> [ 'service', + 'login', + 'institution' ], + ValueAttr => [ 'error-detect', + 'enabled' ] ); + +sub new { + my ($class, $config_file) = @_; + my $cfg = $parser->XMLin($config_file); + + foreach my $acct (values %{$cfg->{accounts}}) { + new Sip::Configuration::Account $acct; + } + + foreach my $service (values %{$cfg->{listeners}}) { + new Sip::Configuration::Service $service; + } + + foreach my $inst (values %{$cfg->{institutions}}) { + new Sip::Configuration::Institution $inst; + } + + return bless $cfg, $class; +} + +sub error_detect { + my $self = shift; + + return $self->{'error-detect'}; +} + +sub accounts { + my $self = shift; + + return values %{$self->{accounts}}; +} + +sub find_service { + my ($self, $sockaddr, $port, $proto) = @_; + my $portstr; + + if ($sockaddr eq '127.0.0.1') { + foreach my $addr ('', '*:', 'localhost:', '127.0.0.1:') { + $portstr = sprintf("%s%s/%s", $addr, $port, $proto); + Sys::Syslog::syslog("LOG_DEBUG", "Configuration::find_service: Trying $portstr"); + last if (exists(($self->{listeners})->{$portstr})); + } + } else { + $portstr = sprintf("%s:%s/%s", $sockaddr, $port, $proto); + Sys::Syslog::syslog("LOG_DEBUG", "Configuration::find_service: Trying $portstr"); + } + + return $self->{listeners}->{$portstr}; +} + +# +# Testing +# + + +{ + no warnings qw(once); + eval join('',) || die $@ unless caller(); +} + +1; +__END__ + + my $config = new Sip::Configuration $ARGV[0]; + + +foreach my $acct ($config->accounts) { + print "Found account '", $acct->name, "', part of '" + print $acct->institution, "'\n"; +} + +1; diff --git a/Sip/Configuration/Account.pm b/Sip/Configuration/Account.pm new file mode 100644 index 0000000..8b2a0e7 --- /dev/null +++ b/Sip/Configuration/Account.pm @@ -0,0 +1,43 @@ +# +# +# +# + +package Sip::Configuration::Account; + +use strict; +use warnings; +use English; +use Exporter; + +sub new { + my ($class, $obj) = @_; + my $type = ref($class) || $class; + + if (ref($obj) eq "HASH") { + # Just bless the object + return bless $obj, $type; + } + + return bless {}, $type; +} + +sub id { + my $self = shift; + + return $self->{id}; +} + +sub institution { + my $self = shift; + + return $self->{institution}; +} + +sub password { + my $self = shift; + + return $self->{password}; +} + +1; diff --git a/Sip/Configuration/Institution.pm b/Sip/Configuration/Institution.pm new file mode 100644 index 0000000..f31ecc8 --- /dev/null +++ b/Sip/Configuration/Institution.pm @@ -0,0 +1,31 @@ +# +# +# +# + +package Sip::Configuration::Institution; + +use strict; +use warnings; +use English; +use Exporter; + +sub new { + my ($class, $obj) = @_; + my $type = ref($class) || $class; + + if (ref($obj) eq "HASH") { + # Just bless the object + return bless $obj, $type; + } + + return bless {}, $type; +} + +sub name { + my $self = shift; + + return $self->{name}; +} + +1; diff --git a/Sip/Configuration/Service.pm b/Sip/Configuration/Service.pm new file mode 100644 index 0000000..11fa8ab --- /dev/null +++ b/Sip/Configuration/Service.pm @@ -0,0 +1,25 @@ +# +# +# +# + +package Sip::Configuration::Service; + +use strict; +use warnings; +use English; +use Exporter; + +sub new { + my ($class, $obj) = @_; + my $type = ref($class) || $class; + + if (ref($obj) eq "HASH") { + # Just bless the object + return bless $obj, $type; + } + + return bless {}, $type; +} + +1; diff --git a/Sip/Constants.pm b/Sip/Constants.pm new file mode 100644 index 0000000..996e8a5 --- /dev/null +++ b/Sip/Constants.pm @@ -0,0 +1,323 @@ +# +# Sip::Constants.pm +# +# Various protocol constant values for 3M's Standard Interchange +# Protocol for communication between a library's Automated +# Checkout System (ACS) and stand-alone Self-Check (SC) units + +package Sip::Constants; + +use strict; +use warnings; +use Exporter; + +our (@ISA, @EXPORT_OK, %EXPORT_TAGS); + +@ISA = qw(Exporter); + +@EXPORT_OK = qw(PATRON_STATUS_REQ CHECKOUT CHECKIN BLOCK_PATRON + SC_STATUS REQUEST_ACS_RESEND LOGIN PATRON_INFO + END_PATRON_SESSION FEE_PAID ITEM_INFORMATION + ITEM_STATUS_UPDATE PATRON_ENABLE HOLD RENEW + RENEW_ALL PATRON_STATUS_RESP CHECKOUT_RESP + CHECKIN_RESP ACS_STATUS REQUEST_SC_RESEND + LOGIN_RESP PATRON_INFO_RESP END_SESSION_RESP + FEE_PAID_RESP ITEM_INFO_RESP + ITEM_STATUS_UPDATE_RESP PATRON_ENABLE_RESP + HOLD_RESP RENEW_RESP RENEW_ALL_RESP + REQUEST_ACS_RESEND_CKSUM REQUEST_SC_RESEND_CKSUM + FID_PATRON_ID FID_ITEM_ID FID_TERMINAL_PWD + FID_PATRON_PWD FID_PERSONAL_NAME FID_SCREEN_MSG + FID_PRINT_LINE FID_DUE_DATE FID_TITLE_ID + FID_BLOCKED_CARD_MSG FID_LIBRARY_NAME + FID_TERMINAL_LOCN FID_INST_ID FID_CURRENT_LOCN + FID_PERM_LOCN FID_HOLD_ITEMS FID_OVERDUE_ITEMS + FID_CHARGED_ITEMS FID_FINE_ITEMS FID_SEQNO + FID_CKSUM FID_HOME_ADDR FID_EMAIL FID_HOME_PHONE + FID_OWNER FID_CURRENCY FID_CANCEL + FID_TRANSACTION_ID FID_VALID_PATRON + FID_RENEWED_ITEMS FID_UNRENEWED_ITEMS FID_FEE_ACK + FID_START_ITEM FID_END_ITEM FID_QUEUE_POS + FID_PICKUP_LOCN FID_FEE_TYPE FID_RECALL_ITEMS + FID_FEE_AMT FID_EXPIRATION FID_SUPPORTED_MSGS + FID_HOLD_TYPE FID_HOLD_ITEMS_LMT + FID_OVERDUE_ITEMS_LMT FID_CHARDED_ITEMS_LMT + FID_FEE_LMT FID_UNAVAILABLE_HOLD_ITEMS + FID_HOLD_QUEUE_LEN FID_FEE_ID FID_ITEM_PROPS + FID_SECURITY_INHIBIT FID_RECALL_DATE + FID_MEDIA_TYPE FID_SORT_BIN FID_HOLD_PICKUP_DATE + FID_LOGIN_UID FID_LOGIN_PWD FID_LOCATION_CODE + FID_VALID_PATRON_PWD + SC_STATUS_OK SC_STATUS_PAPER SC_STATUS_SHUTDOWN + SIP_DATETIME); + +%EXPORT_TAGS = ( + + SC_msgs => [qw(PATRON_STATUS_REQ CHECKOUT CHECKIN + BLOCK_PATRON SC_STATUS + REQUEST_ACS_RESEND LOGIN + PATRON_INFO + END_PATRON_SESSION FEE_PAID + ITEM_INFORMATION + ITEM_STATUS_UPDATE + PATRON_ENABLE HOLD RENEW + RENEW_ALL)], + + ACS_msgs => [qw(PATRON_STATUS_RESP CHECKOUT_RESP + CHECKIN_RESP ACS_STATUS + REQUEST_SC_RESEND LOGIN_RESP + PATRON_INFO_RESP + END_SESSION_RESP + FEE_PAID_RESP ITEM_INFO_RESP + ITEM_STATUS_UPDATE_RESP + PATRON_ENABLE_RESP HOLD_RESP + RENEW_RESP RENEW_ALL_RESP)], + + constant_msgs => [qw(REQUEST_ACS_RESEND_CKSUM + REQUEST_SC_RESEND_CKSUM)], + + field_ids => [qw( FID_PATRON_ID FID_ITEM_ID + FID_TERMINAL_PWD + FID_PATRON_PWD + FID_PERSONAL_NAME + FID_SCREEN_MSG + FID_PRINT_LINE FID_DUE_DATE + FID_TITLE_ID + FID_BLOCKED_CARD_MSG + FID_LIBRARY_NAME + FID_TERMINAL_LOCN + FID_INST_ID + FID_CURRENT_LOCN + FID_PERM_LOCN + FID_HOLD_ITEMS + FID_OVERDUE_ITEMS + FID_CHARGED_ITEMS + FID_FINE_ITEMS FID_SEQNO + FID_CKSUM FID_HOME_ADDR + FID_EMAIL FID_HOME_PHONE + FID_OWNER FID_CURRENCY + FID_CANCEL + FID_TRANSACTION_ID + FID_VALID_PATRON + FID_RENEWED_ITEMS + FID_UNRENEWED_ITEMS + FID_FEE_ACK FID_START_ITEM + FID_END_ITEM FID_QUEUE_POS + FID_PICKUP_LOCN + FID_FEE_TYPE + FID_RECALL_ITEMS + FID_FEE_AMT FID_EXPIRATION + FID_SUPPORTED_MSGS + FID_HOLD_TYPE + FID_HOLD_ITEMS_LMT + FID_OVERDUE_ITEMS_LMT + FID_CHARDED_ITEMS_LMT + FID_FEE_LMT + FID_UNAVAILABLE_HOLD_ITEMS + FID_HOLD_QUEUE_LEN + FID_FEE_ID FID_ITEM_PROPS + FID_SECURITY_INHIBIT + FID_RECALL_DATE + FID_MEDIA_TYPE FID_SORT_BIN + FID_HOLD_PICKUP_DATE + FID_LOGIN_UID FID_LOGIN_PWD + FID_LOCATION_CODE + FID_VALID_PATRON_PWD)], + + SC_status => [qw(SC_STATUS_OK SC_STATUS_PAPER + SC_STATUS_SHUTDOWN)], + + formats => [qw(SIP_DATETIME)], + + all => [qw(PATRON_STATUS_REQ CHECKOUT CHECKIN + BLOCK_PATRON SC_STATUS + REQUEST_ACS_RESEND LOGIN PATRON_INFO + END_PATRON_SESSION FEE_PAID + ITEM_INFORMATION ITEM_STATUS_UPDATE + PATRON_ENABLE HOLD RENEW RENEW_ALL + PATRON_STATUS_RESP CHECKOUT_RESP + CHECKIN_RESP ACS_STATUS + REQUEST_SC_RESEND LOGIN_RESP + PATRON_INFO_RESP END_SESSION_RESP + FEE_PAID_RESP ITEM_INFO_RESP + ITEM_STATUS_UPDATE_RESP + PATRON_ENABLE_RESP HOLD_RESP + RENEW_RESP RENEW_ALL_RESP + REQUEST_ACS_RESEND_CKSUM + REQUEST_SC_RESEND_CKSUM FID_PATRON_ID + FID_ITEM_ID FID_TERMINAL_PWD + FID_PATRON_PWD FID_PERSONAL_NAME + FID_SCREEN_MSG FID_PRINT_LINE + FID_DUE_DATE FID_TITLE_ID + FID_BLOCKED_CARD_MSG FID_LIBRARY_NAME + FID_TERMINAL_LOCN FID_INST_ID + FID_CURRENT_LOCN FID_PERM_LOCN + FID_HOLD_ITEMS FID_OVERDUE_ITEMS + FID_CHARGED_ITEMS FID_FINE_ITEMS + FID_SEQNO FID_CKSUM FID_HOME_ADDR + FID_EMAIL FID_HOME_PHONE FID_OWNER + FID_CURRENCY FID_CANCEL + FID_TRANSACTION_ID FID_VALID_PATRON + FID_RENEWED_ITEMS FID_UNRENEWED_ITEMS + FID_FEE_ACK FID_START_ITEM + FID_END_ITEM FID_QUEUE_POS + FID_PICKUP_LOCN FID_FEE_TYPE + FID_RECALL_ITEMS FID_FEE_AMT + FID_EXPIRATION FID_SUPPORTED_MSGS + FID_HOLD_TYPE FID_HOLD_ITEMS_LMT + FID_OVERDUE_ITEMS_LMT + FID_CHARDED_ITEMS_LMT FID_FEE_LMT + FID_UNAVAILABLE_HOLD_ITEMS + FID_HOLD_QUEUE_LEN FID_FEE_ID + FID_ITEM_PROPS FID_SECURITY_INHIBIT + FID_RECALL_DATE FID_MEDIA_TYPE + FID_SORT_BIN FID_HOLD_PICKUP_DATE + FID_LOGIN_UID FID_LOGIN_PWD + FID_LOCATION_CODE FID_VALID_PATRON_PWD + SC_STATUS_OK SC_STATUS_PAPER SC_STATUS_SHUTDOWN + SIP_DATETIME + )]); + +# +# Declare message types +# + +# Messages from SC to ACS +use constant { + PATRON_STATUS_REQ => '23', + CHECKOUT => '11', + CHECKIN => '09', + BLOCK_PATRON => '01', + SC_STATUS => '99', + REQUEST_ACS_RESEND => '97', + LOGIN => '93', + PATRON_INFO => '63', + END_PATRON_SESSION => '35', + FEE_PAID => '37', + ITEM_INFORMATION => '17', + ITEM_STATUS_UPDATE => '19', + PATRON_ENABLE => '25', + HOLD => '15', + RENEW => '29', + RENEW_ALL => '65', +}; + +# Message responses from ACS to SC +use constant { + PATRON_STATUS_RESP => '24', + CHECKOUT_RESP => '12', + CHECKIN_RESP => '10', + ACS_STATUS => '98', + REQUEST_SC_RESEND => '96', + LOGIN_RESP => '94', + PATRON_INFO_RESP => '64', + END_SESSION_RESP => '36', + FEE_PAID_RESP => '38', + ITEM_INFO_RESP => '18', + ITEM_STATUS_UPDATE_RESP => '20', + PATRON_ENABLE_RESP => '26', + HOLD_RESP => '16', + RENEW_RESP => '30', + RENEW_ALL_RESP => '66', +}; + +# +# Some messages are short and invariant, so they're constant's too +# +use constant { + REQUEST_ACS_RESEND_CKSUM => '97AZFEF5', + REQUEST_SC_RESEND_CKSUM => '96AZFEF6', +}; + +# +# Field Identifiers +# +use constant { + FID_PATRON_ID => 'AA', + FID_ITEM_ID => 'AB', + FID_TERMINAL_PWD => 'AC', + FID_PATRON_PWD => 'AD', + FID_PERSONAL_NAME => 'AE', + FID_SCREEN_MSG => 'AF', + FID_PRINT_LINE => 'AG', + FID_DUE_DATE => 'AH', + # UNUSED AI + FID_TITLE_ID => 'AJ', + # UNUSED AK + FID_BLOCKED_CARD_MSG => 'AL', + FID_LIBRARY_NAME => 'AM', + FID_TERMINAL_LOCN => 'AN', + FID_INST_ID => 'AO', + FID_CURRENT_LOCN => 'AP', + FID_PERM_LOCN => 'AQ', + # UNUSED AR + FID_HOLD_ITEMS => 'AS', # SIP 2.0 + FID_OVERDUE_ITEMS => 'AT', # SIP 2.0 + FID_CHARGED_ITEMS => 'AU', # SIP 2.0 + FID_FINE_ITEMS => 'AV', # SIP 2.0 + # UNUSED AW + # UNUSED AX + FID_SEQNO => 'AY', + FID_CKSUM => 'AZ', + + # SIP 2.0 Fields + # UNUSED BA + # UNUSED BB + # UNUSED BC + FID_HOME_ADDR => 'BD', + FID_EMAIL => 'BE', + FID_HOME_PHONE => 'BF', + FID_OWNER => 'BG', + FID_CURRENCY => 'BH', + FID_CANCEL => 'BI', + # UNUSED BJ + FID_TRANSACTION_ID => 'BK', + FID_VALID_PATRON => 'BL', + FID_RENEWED_ITEMS => 'BM', + FID_UNRENEWED_ITEMS => 'BN', + FID_FEE_ACK => 'BO', + FID_START_ITEM => 'BP', + FID_END_ITEM => 'BQ', + FID_QUEUE_POS => 'BR', + FID_PICKUP_LOCN => 'BS', + FID_FEE_TYPE => 'BT', + FID_RECALL_ITEMS => 'BU', + FID_FEE_AMT => 'BV', + FID_EXPIRATION => 'BW', + FID_SUPPORTED_MSGS => 'BX', + FID_HOLD_TYPE => 'BY', + FID_HOLD_ITEMS_LMT => 'BZ', + FID_OVERDUE_ITEMS_LMT => 'CA', + FID_CHARDED_ITEMS_LMT => 'CB', + FID_FEE_LMT => 'CC', + FID_UNAVAILABLE_HOLD_ITEMS => 'CD', + # UNUSED CE + FID_HOLD_QUEUE_LEN => 'CF', + FID_FEE_ID => 'CG', + FID_ITEM_PROPS => 'CH', + FID_SECURITY_INHIBIT => 'CI', + FID_RECALL_DATE => 'CJ', + FID_MEDIA_TYPE => 'CK', + FID_SORT_BIN => 'CL', + FID_HOLD_PICKUP_DATE => 'CM', + FID_LOGIN_UID => 'CN', + FID_LOGIN_PWD => 'CO', + FID_LOCATION_CODE => 'CP', + FID_VALID_PATRON_PWD => 'CQ', +}; + +# +# SC Status Codes +# +use constant { + SC_STATUS_OK => '0', + SC_STATUS_PAPER => '1', + SC_STATUS_SHUTDOWN => '2', +}; + +# +# Various format strings +# +use constant { + SIP_DATETIME => "%Y%m%d %H%M%S", +}; diff --git a/Sip/MsgType.pm b/Sip/MsgType.pm new file mode 100644 index 0000000..3daefa6 --- /dev/null +++ b/Sip/MsgType.pm @@ -0,0 +1,1016 @@ +# +# Sip::MsgType.pm +# +# A Class for handing SIP messages +# + +package Sip::MsgType; + +use strict; +use warnings; +use Exporter; +use Sys::Syslog qw(syslog); + +use Sip; +use Sip::Constants qw(:all); +use Sip::Checksum qw(checksum verify_cksum); + +use ILS; +use ILS::Patron; +use ILS::Item; + +our (@ISA, @EXPORT_OK); + +@ISA = qw(Exporter); +@EXPORT_OK = qw(handle); + +# Predeclare handler subroutines +use subs qw(handle_patron_status handle_checkout handle_checkin + handle_block_patron handle_sc_status handle_request_acs_resend + handle_login handle_patron_info handle_end_patron_session + handle_fee_paid handle_item_information handle_item_status_update + handle_patron_enable handle_hold handle_renew handle_renew_all); + +# +# For the most part, Version 2.00 of the protocol just adds new +# variable fields, but sometimes it changes the fixed header. +# +# In general, if there's no '2.00' protocol entry for a handler, that's +# because 2.00 didn't extend the 1.00 version of the protocol. This will +# be handled by the module initialization code following the declaration, +# which goes through the handlers table and creates a '2.00' entry that +# points to the same place as the '1.00' entry. If there's a 2.00 entry +# but no 1.00 entry, then that means that it's a completely new service +# in 2.00, so 1.00 shouldn't recognize it. + +my %handlers = ( + (PATRON_STATUS_REQ) => { + name => "Patron Status Request", + handler => \&handle_patron_status, + protocol => { + "1.00" => { + template => "A3A18", + template_len => 21, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_TERMINAL_PWD), (FID_PATRON_PWD)], + } + } + }, + (CHECKOUT) => { + name => "Checkout", + handler => \&handle_checkout, + protocol => { + "1.00" => { + template => "CCA18A18", + template_len => 38, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_ITEM_ID), (FID_TERMINAL_PWD)], + }, + "2.00" => { + template => "CCA18A18", + template_len => 38, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_ITEM_ID), (FID_TERMINAL_PWD), + (FID_ITEM_PROPS), (FID_PATRON_PWD), + (FID_FEE_ACK), (FID_CANCEL)], + }, + } + }, + (CHECKIN) => { + name => "Checkin", + handler => \&handle_checkin, + protocol => { + "1.00" => { + template => "CA18A18", + template_len => 37, + fields => [(FID_CURRENT_LOCN), (FID_INST_ID), + (FID_ITEM_ID), (FID_TERMINAL_PWD)], + }, + "2.00" => { + template => "CA18A18", + template_len => 37, + fields => [(FID_CURRENT_LOCN), (FID_INST_ID), + (FID_ITEM_ID), (FID_TERMINAL_PWD), + (FID_ITEM_PROPS), (FID_CANCEL)], + } + } + }, + (BLOCK_PATRON) => { + name => "Block Patron", + handler => \&handle_block_patron, + protocol => { + "1.00" => { + template => "CA18", + template_len => 19, + fields => [(FID_INST_ID), (FID_BLOCKED_CARD_MSG), + (FID_PATRON_ID), (FID_TERMINAL_PWD)], + }, + } + }, + (SC_STATUS) => { + name => "SC Status", + handler => \&handle_sc_status, + protocol => { + "1.00" => { + template =>"CA3A4", + template_len => 8, + fields => [], + } + } + }, + (REQUEST_ACS_RESEND) => { + name => "Request ACS Resend", + handler => \&handle_request_acs_resend, + protocol => { + "1.00" => { + template => "", + template_len => 0, + fields => [], + } + } + }, + (LOGIN) => { + name => "Login", + handler => \&handle_login, + protocol => { + "2.00" => { + template => "A1A1", + template_len => 2, + fields => [(FID_LOGIN_UID), (FID_LOGIN_PWD), + (FID_LOCATION_CODE)], + } + } + }, + (PATRON_INFO) => { + name => "Patron Info", + handler => \&handle_patron_info, + protocol => { + "2.00" => { + template => "A3A18A10", + template_len => 21, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_TERMINAL_PWD), (FID_PATRON_PWD), + (FID_START_ITEM), (FID_END_ITEM)], + } + } + }, + (END_PATRON_SESSION) => { + name => "End Patron Session", + handler => \&handle_end_patron_session, + protocol => { + "2.00" => { + template => "A18", + template_len => 18, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_TERMINAL_PWD), (FID_PATRON_PWD)], + } + } + }, + (FEE_PAID) => { + name => "Fee Paid", + handler => \&handle_fee_paid, + protocol => { + "2.00" => { + template => "A18A2A3", + template_len => 0, + fields => [(FID_FEE_AMT), (FID_INST_ID), + (FID_PATRON_ID), (FID_TERMINAL_PWD), + (FID_PATRON_PWD), (FID_FEE_ID), + (FID_TRANSACTION_ID)], + } + } + }, + (ITEM_INFORMATION) => { + name => "Item Information", + handler => \&handle_item_information, + protocol => { + "2.00" => { + template => "A18", + template_len => 18, + fields => [(FID_INST_ID), (FID_ITEM_ID), + (FID_TERMINAL_PWD)], + } + } + }, + (ITEM_STATUS_UPDATE) => { + name => "Item Status Update", + handler => \&handle_item_status_update, + protocol => { + "2.00" => { + template => "A18", + template_len => 18, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_ITEM_ID), (FID_TERMINAL_PWD), + (FID_ITEM_PROPS)], + } + } + }, + (PATRON_ENABLE) => { + name => "Patron Enable", + handler => \&handle_patron_enable, + protocol => { + "2.00" => { + template => "A18", + template_len => 18, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_TERMINAL_PWD), (FID_PATRON_PWD)], + } + } + }, + (HOLD) => { + name => "Hold", + handler => \&handle_hold, + protocol => { + "2.00" => { + template => "CA18", + template_len => 19, + fields => [(FID_EXPIRATION), (FID_PICKUP_LOCN), + (FID_HOLD_TYPE), (FID_INST_ID), + (FID_PATRON_ID), (FID_ITEM_ID), + (FID_TITLE_ID), (FID_TERMINAL_PWD), + (FID_FEE_ACK)], + } + } + }, + (RENEW) => { + name => "Renew", + handler => \&handle_renew, + protocol => { + "2.00" => { + template => "CCA18A18", + template_len => 38, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_PATRON_PWD), (FID_ITEM_ID), + (FID_TITLE_ID), (FID_TERMINAL_PWD), + (FID_ITEM_PROPS), (FID_FEE_ACK)], + } + } + }, + (RENEW_ALL) => { + name => "Renew All", + handler => \&handle_renew_all, + protocol => { + "2.00" => { + template => "A18", + template_len => 18, + fields => [(FID_INST_ID), (FID_PATRON_ID), + (FID_TERMINAL_PWD), (FID_FEE_ACK)], + } + } + } + ); + +# +# Now, initialize some of the missing bits of %handlers +# +foreach my $i (keys(%handlers)) { + if (!exists($handlers{$i}->{protocol}->{"2.00"})) { + + $handlers{$i}->{protocol}->{"2.00"} = $handlers{$i}->{protocol}->{"1.00"}; + } +} + +my $error_detection = 0; +my $protocol_version = "1.00"; +my $field_delimiter = '|'; # Protocol Default + +sub new { + my ($class, $msg, $seqno) = @_; + my $self = {}; + my $msgtag = substr($msg, 0, 2); + + syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s', '%s'): msgtag '%s'", + $class, substr($msg, 0, 10), $msgtag, $seqno); + if ($msgtag eq LOGIN) { + # If the client is using the 2.00-style "Login" message + # to authenticate to the server, then we get the Login message + # _before_ the client has indicated that it supports 2.00, but + # it's using the 2.00 login process, so it must support 2.00, + # so we'll just do it. + $protocol_version = "2.00"; + } + if (!exists($handlers{$msgtag})) { + syslog("LOG_WARNING", + "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", + $msgtag, $msg); + return(undef); + } elsif (!exists($handlers{$msgtag}->{protocol}->{$protocol_version})) { + syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%s'", + $msgtag, $protocol_version); + return(undef); + } + + bless $self, $class; + + $self->{seqno} = $seqno; + $self->_initialize(substr($msg,2), $handlers{$msgtag}); + + return($self); +} + +sub _initialize { + my ($self, $msg, $control_block) = @_; + my ($fs, $fn, $fe); + my $proto = $control_block->{protocol}->{$protocol_version}; + + $self->{name} = $control_block->{name}; + $self->{handler} = $control_block->{handler}; + + $self->{fields} = {}; + $self->{fixed_fields} = []; + + syslog("LOG_DEBUG", "Sip::MsgType:_initialize('%s', '%s...')", + $self->{name}, substr($msg, 0, 20)); + + foreach my $field (@{$proto->{fields}}) { + $self->{fields}->{$field} = undef; + } + + syslog("LOG_DEBUG", + "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...", + $self->{name}, $msg, $proto->{template}, + $proto->{template_len}); + + $self->{fixed_fields} = [ unpack($proto->{template}, $msg) ]; + + for ($fs = $proto->{template_len}; $fs < length($msg); $fs = $fe + 1) { + $fn = substr($msg, $fs, 2); + $fs += 2; + syslog("LOG_DEBUG", + "_initialize: msg: '%s', field_delimiter: '%s', fs: '%s'", + $msg, $field_delimiter, $fs); + $fe = index($msg, $field_delimiter, $fs); + + if ($fe == -1) { + syslog("LOG_WARNING", "Unterminated %s field in %s message '%s'", + $fn, $self->{name}, $msg); + $fe = length($msg); + } + + if (!exists($self->{fields}->{$fn})) { + syslog("LOG_WARNING", + "Unsupported field '%s' at offset %d in %s message '%s'", + $fn, $fs, $self->{name}, $msg); + } elsif (defined($self->{fields}->{$fn})) { + syslog("LOG_WARNING", + "Duplicate field '%s' at offset %d (previous value '%s') in %s message '%s'", + $fn, $fs, $self->{fields}->{$fn}, $self->{name}, $msg); + } else { + $self->{fields}->{$fn} = substr($msg, $fs, $fe - $fs); + } + } + + return($self); +} + +# We need to keep a copy of the last message we sent to the SC, +# in case there's a transmission error and the SC sends us a +# REQUEST_ACS_RESEND. If we receive a REQUEST_ACS_RESEND before +# we've ever sent anything, then we are to respond with a +# REQUEST_SC_RESEND (p.16) + +my $last_response = ''; + +sub handle { + my ($msg, $server, $req) = @_; + my $config = $server->{config}; + my $self; + + + # + # What's the field delimiter for variable length fields? + # This can't be based on the account, since we need to know + # the field delimiter to parse a SIP login message + # + if (defined($server->{config}->{delimiter})) { + $field_delimiter = $server->{config}->{delimiter}; + } + + # error detection is active if this is a REQUEST_ACS_RESEND + # message with a checksum, or if the message is long enough + # and the last nine characters begin with a sequence number + # field + if ($msg eq REQUEST_ACS_RESEND_CKSUM) { + # Special case + + $error_detection = 1; + $self = new Sip::MsgType ((REQUEST_ACS_RESEND), 0); + } elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) { + $error_detection = 1; + + if (!verify_cksum($msg)) { + syslog("LOG_WARNING", "Checksum failed on message '%s'", $msg); + # REQUEST_SC_RESEND with error detection + $last_response = REQUEST_SC_RESEND_CKSUM; + print("$last_response\r"); + return REQUEST_ACS_RESEND; + } else { + # Save the sequence number, then strip off the + # error detection data to process the message + $self = new Sip::MsgType (substr($msg, 0, -9), substr($msg, -7, 1)); + } + } elsif ($error_detection) { + # We've receive a non-ED message when ED is supposed + # to be active. Warn about this problem, then process + # the message anyway. + syslog("LOG_WARNING", + "Received message without error detection: '%s'", $msg); + $error_detection = 0; + $self = new Sip::MsgType ($msg, 0); + } else { + $self = new Sip::MsgType ($msg, 0); + } + + if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) && + $req && (substr($msg, 0, 2) ne $req)) { + return substr($msg, 0, 2); + } + return($self->{handler}->($self, $server)); +} + +## +## Message Handlers +## + +sub handle_patron_status { + my ($self, $server) = @_; + my ($lang, $date); + my $fields; + my $patron; + my $resp = (PATRON_STATUS_RESP); + my $account = $server->{account}; + + ($lang, $date) = @{$self->{fixed_fields}}; + $fields = $self->{fields}; + + syslog("LOG_DEBUG", "handle_patron_status:"); + syslog("LOG_DEBUG", " LANG = '%s'", $lang); + syslog("LOG_DEBUG", " DATE = '%s'", $date); + syslog("LOG_DEBUG", " inst_id = '%s'", $fields->{(FID_INST_ID)}); + syslog("LOG_DEBUG", " patron_id = '%s'", $fields->{(FID_PATRON_ID)}); + syslog("LOG_DEBUG", " terminal_pwd = '%s'", $fields->{(FID_TERMINAL_PWD)}); + syslog("LOG_DEBUG", " patron_pwd = '%s'", $fields->{(FID_PATRON_PWD)}); + + if ($fields->{(FID_INST_ID)} ne $account->{institution}) { + syslog("LOG_WARN", "handle_patron_status: Inst-ID from SC, %s, doesn't match account Inst-ID, %s", + $fields->{(FID_INST_ID)}, $account->{institution}); + } + + $patron = new ILS::Patron $fields->{(FID_PATRON_ID)}; + if (!defined($patron)) { + # Invalid patron id: he has no privileges, has + # no personal name, and is invalid (if we're using 2.00) + $resp .= (' ' x 14) . $lang . Sip::timestamp(); + $resp .= FID_PERSONAL_NAME . $field_delimiter; + + # the patron ID is invalid, but it's a required field, so + # just echo it back + $resp .= FID_PATRON_ID . $fields->{(FID_PATRON_ID)} . $field_delimiter; + + if ($protocol_version eq '2.00') { + $resp .= FID_VALID_PATRON . 'N' . $field_delimiter; + } + } else { + # Valid patron + $resp .= $self->build_patron_status($patron); + $resp .= $lang . Sip::timestamp(); + $resp .= FID_PERSONAL_NAME . $patron->name . $field_delimiter; + + # while the patron ID we got from the SC is valid, let's + # use the one returned from the ILS, just in case... + $resp .= FID_PATRON_ID . $patron->id . $field_delimiter; + if ($protocol_version eq '2.00') { + $resp .= FID_VALID_PATRON . 'Y'; + # If the patron password field doesn't exist, we don't know if + # it's valid or not. Or do we have to match an empty password? + if (exists($fields->{(FID_PATRON_PWD)})) { + $resp .= FID_VALID_PATRON_PWD + . $patron->check_password($fields->{(FID_PATRON_PWD)}) + . $field_delimiter; + } + $resp .= maybe_add(FID_CURRENCY, $patron->currency); + $resp .= maybe_add(FID_FEE_AMT, $patron->fee_amount); + } + $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg); + $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line); + } + + $resp .= FID_INST_ID . $account->{institution} . $field_delimiter; + + $self->write_msg($resp, $server); + + return (PATRON_STATUS_REQ); +} + +# +# Build and send a checkout failure message +# +sub checkout_failed { + my ($self, $server, $patron, $item, $status) = @_; + my $account = $server->{account}; + my $fields = $self->{fields}; + my $resp; + + # Checkout Response: not ok, no renewal, don't know mag. media, + # no desensitize + $resp = sprintf("120NUN%s", Sip::timestamp); + $resp .= FID_INST_ID . $account->{institution} . $field_delimiter; + $resp .= FID_PATRON_ID . $fields->{(FID_PATRON_ID)} . $field_delimiter; + $resp .= FID_ITEM_ID . $fields->{(FID_ITEM_ID)} . $field_delimiter; + # We don't know the title, but it's required, so leave it blank + $resp .= FID_TITLE_ID . $field_delimiter; + # Due date is required. Since it didn't get checked out, + # it's not due, so leave the date blank + $resp .= FID_DUE_DATE . $field_delimiter; + + # Screen message. Let the ILS define the message, and if there's + # a distinction between invalid patron and permission denied. + if (!$patron) { + $resp .= FID_SCREEN_MSG . ILS::Patron::invalid_patron . $field_delimiter; + } elsif (!$patron->charge_ok) { + $resp .= FID_SCREEN_MSG . ILS::Patron::charge_denied . $field_delimiter; + } + + if ($protocol_version eq '2.00') { + # Is the patron ID valid? + $resp .= FID_VALID_PATRON . ($patron ? 'Y' : 'N') . $field_delimiter; + + if ($patron && exists($self->{fields}->{FID_PATRON_PWD})) { + # Password provided, so we can tell if it was valid or not + $resp .= FID_VALID_PATRON_PWD + . $patron->check_password($self->{fields}->{(FID_PATRON_PWD)}) + . $field_delimiter; + } + } + + $self->write_msg($resp, $server); +} + +sub handle_checkout { + my ($self, $server) = @_; + my $account = $server->{account}; + my ($sc_renewal_policy, $no_block, $trans_date, $nb_due_date); + my $fields; + my ($patron, $item, $status); + + # Response field values + #my ($ok, $renew_ok, $mag_media, $desensitize, $inst_id, $patron_id); + #my ($item_id, $title_id, $due, $fee_type, $sec_inh, $currency, $fee_amt); + #my ($media, $item_props, $trans_id, $screen_msg, $print_line); + + ($sc_renewal_policy, $no_block, $trans_date, $nb_due_date) = + @{$self->{fixed_fields}}; + $fields = $self->{fields}; + + $patron = new ILS::Patron($fields->{(FID_PATRON_ID)}); + if (!$patron || !$patron->charge_ok) { + checkout_failed($self, $server, $patron, undef, undef); + return(CHECKOUT); + } + + $item = new ILS::Item($fields->{(FID_ITEM_ID)}); + # If the item ID is valid, then we have to attempt the + # checkout, since different users may have different checkout + # permissions. So, let the ILS figure out if the checkout's + # OK. + if (!$item) { + checkout_failed($self, $server, $patron, undef, undef); + return(CHECKOUT); + } + + # XXX FINISH THIS STUFF UP!!! + # Mike says ACS checks whether this is a renewal or a checkout + # I think that's a mistake. There are transactional issues: + # what happens if somebody places a hold between the time I check + # the item status above and the time that I perform the renewal below? +} + +sub handle_checkin { + my ($self, $server) = @_; + my ($no_block, $trans_date, $return_date); + my $fields; + + ($no_block, $trans_date, $return_date) = @{$self->{fixed_fields}}; + $fields = $self->{fields}; + + printf("handle_checkin:\n"); + printf(" no_block : %c\n", $no_block); + printf(" trans_date : %s\n", $trans_date); + printf(" return_date: %s\n", $return_date); + + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } + +} + +sub handle_block_patron { + my ($self, $server) = @_; + my ($card_retained, $trans_date); + my $fields; + + ($card_retained, $trans_date) = @{$self->{fixed_fields}}; + $fields = $self->{fields}; + + printf("handle_block_patron:\n"); + printf(" card_retained: %c\n", $card_retained); + printf(" trans_date : %s\n", $trans_date); + + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } + +} + +sub handle_sc_status { + my ($self, $server) = @_; + my ($status, $print_width, $sc_protocol_version); + + ($status, $print_width, $sc_protocol_version) = @{$self->{fixed_fields}}; + + if ($sc_protocol_version ne $protocol_version) { + syslog("LOG_INFO", "Setting protocol level to $sc_protocol_version"); + $protocol_version = $sc_protocol_version; + } + + if ($status == SC_STATUS_PAPER) { + syslog("LOG_WARN", "Self-Check unit '%s@%s' out of paper", + $self->{account}->{id}, $self->{account}->{institution}); + } elsif ($status == SC_STATUS_SHUTDOWN) { + syslog("LOG_WARN", "Self-Check unit '%s@%s' shutting down", + $self->{account}->{id}, $self->{account}->{institution}); + } + + $self->{account}->{print_width} = $print_width; + + return send_acs_status($self, $server) ? SC_STATUS : ''; +} + +sub handle_request_acs_resend { + my ($self, $server) = @_; + + if (!$last_response) { + # We haven't sent anything yet, so respond with a + # REQUEST_SC_RESEND msg (p. 16) + $self->write_msg(REQUEST_SC_RESEND, $server); + } elsif ((length($last_response) < 9) + || substr($last_response, -9, 2) ne 'AY') { + # When resending a message, we aren't supposed to include + # a sequence number, even if the original had one (p. 4). + # If the last message didn't have a sequence number, then + # we can just send it. + print("$last_response\r"); + } else { + my $rebuilt; + + # Cut out the sequence number and checksum, since the old + # checksum is wrong for the resent message. + $rebuilt = substr($last_response, 0, -9); + $self->write_msg($rebuilt, $server); + } + + return REQUEST_ACS_RESEND; +} + +sub handle_login { + my ($self, $server) = @_; + my ($uid_algorithm, $pwd_algorithm); + my ($uid, $pwd); + my $fields; + my $status = 1; # Assume it all works + + $fields = $self->{fields}; + ($uid_algorithm, $pwd_algorithm) = @{$self->{fixed_fields}}; + + $uid = $fields->{(FID_LOGIN_UID)}; + $pwd = $fields->{(FID_LOGIN_PWD)}; + + if ($uid_algorithm || $pwd_algorithm) { + syslog("LOG_ERR", "LOGIN: Can't cope with non-zero encryption methods: uid = $uid_algorithm, pwd = $pwd_algorithm"); + $status = 0; + } + + if (!exists($server->{config}->{accounts}->{$uid})) { + syslog("LOG_WARNING", "MsgType::handle_login: Unknown login '$uid'"); + $status = 0; + } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) { + syslog("LOG_WARNING", + "MsgType::handle_login: Invalid password for login '$uid'"); + $status = 0; + } + + # Store the active account someplace handy for everybody else to find. + if ($status) { + $server->{account} = $server->{config}->{accounts}->{$uid}; + syslog("LOG_INFO", "Successful login for '%s' of '%s'", + $server->{account}->{id}, $server->{account}->{institution}); + } + + $self->write_msg(LOGIN_RESP . $status, $server); + + return $status ? LOGIN : ''; +} + +sub handle_patron_info { + my ($self, $server) = @_; + my ($lang, $trans_date, $summary) = $self->{fixed_fields}; + my $fields = $self->{fields}; + +} + +sub handle_end_patron_session { + my ($self, $server) = @_; + my $trans_date; + my $fields; + + # No tagged fields are required. + ($trans_date) = @{$self->{fixed_fields}}; + $fields = $self->{fields}; + + printf("handle_end_patron_session\n"); + printf(" trans_date: %s\n", $trans_date); + + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } +} + +sub handle_fee_paid { + my ($self, $server) = @_; + my ($trans_date, $fee_type, $pay_type, $currency) = $self->{fixed_fields}; + my $fields = $self->{fields}; +} + +sub handle_item_information { + my ($self, $server) = @_; + my $trans_date; + my $fields; + + ($trans_date) = @{$self->{fixed_fields}}; + + printf("handle_item_information:\n"); + printf(" trans_date: %s\n", $trans_date); + + $fields = $self->{fields}; + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } +} + +sub handle_item_status_update { + my ($self, $server) = @_; + my $trans_date; + my $fields; + + ($trans_date) = @{$self->{fixed_fields}}; + + printf("handle_item_status_update:\n"); + printf(" trans_date: %s\n", $trans_date); + + $fields = $self->{fields}; + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } +} + +sub handle_patron_enable { + my ($self, $server) = @_; + my $trans_date; + my $fields; + + ($trans_date) = @{$self->{fixed_fields}}; + + printf("handle_patron_enable:\n"); + printf(" trans_date: %s\n", $trans_date); + + $fields = $self->{fields}; + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } +} + +sub handle_hold { + my ($self, $server) = @_; + my ($hold_mode, $trans_date); + my $fields; + + ($hold_mode, $trans_date) = @{$self->{fixed_fields}}; + + + printf("handle_hold:\n"); + printf(" hold_mode : %c\n", $hold_mode); + printf(" trans_date: %s\n", $trans_date); + + $fields = $self->{fields}; + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } +} + +sub handle_renew { + my ($self, $server) = @_; + my ($third_party, $no_block, $trans_date, $nb_due_date); + my $fields; + + ($third_party, $no_block, $trans_date, $nb_due_date) = + @{$self->{fixed_fields}}; + + printf("handle_renew:\n"); + printf(" 3d party : %c\n", $third_party); + printf(" no_block : %c\n", $no_block); + printf(" trans date : %s\n", $trans_date); + printf(" nb_due_date: %s\n", $nb_due_date); + + $fields = $self->{fields}; + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } + +} + +sub handle_renew_all { + my ($self, $server) = @_; + my $trans_date; + my $fields; + + ($trans_date) = @{$self->{fixed_fields}}; + + printf("handle_renew_all:\n"); + printf(" trans_date: %s\n", $trans_date); + + $fields = $self->{fields}; + foreach my $key (keys(%$fields)) { + printf(" $key : %s\n", + defined($fields->{$key}) ? $fields->{$key} : 'UNDEF' ); + } +} + +# +# send_acs_status($self, $server) +# +# Send an ACS Status message, which is contains lots of little fields +# of information gleaned from all sorts of places. +# +sub send_acs_status { + my ($self, $server, $screen_msg, $print_line) = @_; + my $msg = ACS_STATUS; + my $account = $server->{account}; + my $policy = $server->{policy}; + my ($online_status, $checkin_ok, $checkout_ok, $ACS_renewal_policy); + my ($status_update_ok, $offline_ok, $timeout, $retries); + + $online_status = 'Y'; + $checkout_ok = 'Y'; + $ACS_renewal_policy = Sip::y_or_n($policy->{renewal}); + $checkin_ok = Sip::y_or_n($policy->{checkin}); + $status_update_ok = Sip::y_or_n($policy->{status_update}); + $offline_ok = Sip::y_or_n($policy->{offline}); + $timeout = sprintf("%03d", $policy->{timeout}); + $retries = sprintf("%03d", $policy->{retries}); + + if (length($timeout) != 3) { + syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'", + $timeout); + $timeout = '000'; + } + + if (length($retries) != 3) { + syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", + $retries); + $retries = '000'; + } + + $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy"; + $msg .= "$status_update_ok$offline_ok$timeout$retries"; + $msg .= Sip::timestamp(); + $msg .= $protocol_version; + + # Institution ID + $msg .= FID_INST_ID . $account->{institution} . $field_delimiter; + + if ($protocol_version eq '2.00') { + # Supported messages: we do it all + $msg .= FID_SUPPORTED_MSGS . 'YYYYYYYYYYYYYYYY' . $field_delimiter; + } + + $msg .= maybe_add(FID_SCREEN_MSG, $screen_msg); + + if (defined($account->{print_width}) && defined($print_line) + && $account->{print_width} < length($print_line)) { + syslog("LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating", + $print_line); + $print_line = substr($print_line, 0, $account->{print_width}); + } + + $msg .= maybe_add(FID_PRINT_LINE, $print_line); + + # Do we want to tell the terminal its location? + + $self->write_msg($msg, $server); + return 1; +} + +# +# maybe_add(field_id, value): +# If value is defined and non-empty, then return the +# constructed field value, otherwise return the empty string +# +sub maybe_add { + my ($fid, $value) = @_; + + return (defined($value) && $value) ? $fid . $value . $field_delimiter : ''; +} + +# +# build_patron_status: create the 14-char patron status +# string for the Patron Status message +# +sub build_patron_status { + my ($self, $patron) = @_; + my $fields = $self->{fields}; + my $patron_status; + + $patron_status = sprintf('%s%s%s%s%s%s%s%s%s%s%s%s%s%s', + denied($patron->charge_ok), + denied($patron->renew_ok), + denied($patron->recall_ok), + denied($patron->hold_ok), + boolspace($patron->card_lost), + boolspace($patron->too_many_charged), + boolspace($patron->too_many_overdue), + boolspace($patron->too_many_renewal), + boolspace($patron->too_many_claim_return), + boolspace($patron->too_many_lost), + boolspace($patron->excessive_fines), + boolspace($patron->excessive_fees), + boolspace($patron->recall_overdue), + boolspace($patron->too_many_billed)); + return $patron_status; +} + +# +# denied($bool) +# if $bool is false, return true. This is because SIP statuses +# are inverted: we report that something has been denied, not that +# it's permitted. For example, 'renewal priv. denied' of 'Y' means +# that the user's not permitted to renew. I assume that the ILS has +# real positive tests. +# +sub denied { + my $bool = shift; + + if (!$bool || ($bool eq 'N') || $bool eq 'False') { + return 'Y'; + } else { + return ' '; + } +} + +# +# spacebool: ' ' is false, 'Y' is true. (don't ask) +# +sub boolspace { + my $bool = shift; + + if (!$bool || ($bool eq 'N' || $bool eq 'False')) { + return ' '; + } else { + return 'Y'; + } +} +# +# write_msg($msg, $server) +# +# Send $msg to the SC. If error detection is active, then +# add the sequence number (if $seqno is non-zero) and checksum +# to the message, and save the whole thing as $last_response +# + +sub write_msg { + my ($self, $msg, $server) = @_; + my $cksum; + + if ($error_detection) { + if ($self->{seqno}) { + $msg .= 'AY' . $self->{seqno}; + } + $msg .= 'AZ'; + $cksum = checksum($msg); + $msg .= sprintf('%4X', $cksum); + } + + syslog("LOG_DEBUG", "OUTPUT MSG: '$msg'"); + + print "$msg\r"; + $last_response = $msg; +} + +1; diff --git a/acstest.py b/acstest.py new file mode 100644 index 0000000..02eb4bd --- /dev/null +++ b/acstest.py @@ -0,0 +1,42 @@ +import operator +import socket +from time import strftime; + +def SipSocket(host='localhost', port=5300): + so = socket.socket() + so.connect((host, port)) + return so + +def login(so, uname='scclient', passwd='clientpwd', locn='The basement', + seqno=0): + port = so.getpeername()[1] + if port == 5300: + resp = send(so, '9300CN%s|CO%s|CP%s|' % (uname, passwd, locn), seqno) + print "Received", repr(resp) + print "Verified: ", verify(resp) + else: + raise "Logging in is only support for the raw transport on port 5300" + +def send(so, msg, seqno=0): + if seqno: + msg += 'AY' + str(seqno)[0] + 'AZ' + msg += ('%04X' % calculate_cksum(msg)) + msg += '\r' + print 'Sending', repr(msg) + so.send(msg) + resp = so.recv(1000) + return resp, verify(resp) + +def calculate_cksum(msg): + return (-reduce(operator.add, map(ord, msg)) & 0xFFFF) + +def sipdate(): + return(strftime("%Y%m%d %H%M%S")) + +def verify(msg): + if msg[-1] == '\r': msg = msg[:-2] + if msg[-6:-4] == 'AZ': + cksum = calculate_cksum(msg[:-4]) + return (msg[-4:] == ('%04X' % cksum)) + # If there's no checksum, then the message is ok + return True diff --git a/test.txt b/test.txt new file mode 100644 index 0000000..4ea3df1 --- /dev/null +++ b/test.txt @@ -0,0 +1,11 @@ +97AZFEF5 +2300120060101 084235AOUWOLS|AAdjfiander|ACterminal password|ADuser password +2300120060101 084236AOUWOLS|AAmjandkilde|ACterminal password|ADuser password| +2300120060101 084237AOUWOLS|AAdjfiander|ACterminal password|ADuser password|AY5AZE4D1 +9300CNLoginUserID|COLoginPassword|CPLocationCode|AY5AZEC7B +11YN20060102 08423520060116 084235AOUWOLS|AAdjfiander|ABSex and the single programmer|ACterminal password|AY3AZDBED +09Y20060102 08423620060113 084235APUnder the bed|AOUWOLS|ABSex and the single programmer|ACterminal password|AY3AZDB24 +01N20060102 084238AOUWOLS|ALHe's a jerk|AAdjfiander|ACterminal password|AY8AZE6C9 +9910302.00AY3AZFCA2 +3520060110 084237AOUWOLS|AAdjfiander|AY2AZF3A4 +1720060110 215612AOUWOLS|ABSex and the single programmer|AY3AZEC6E diff --git a/xmlparse.pl b/xmlparse.pl new file mode 100644 index 0000000..296dbbc --- /dev/null +++ b/xmlparse.pl @@ -0,0 +1,28 @@ +# +# This file reads a SIPServer xml-format configuration file and dumps it +# to stdout. Just to see what the structures look like. +# +# The 'new XML::Simple' option must agree exactly with the configuration +# in Sip::Configuration.pm +# +use strict; +use English; + +use XML::Simple qw(:strict); +use Data::Dumper; + +my $parser = new XML::Simple( KeyAttr => { login => '+id', + institution => '+id', + service => '+port', }, + GroupTags => { listeners => 'service', + accounts => 'login', + institutions => 'institution', }, + ForceArray=> [ 'service', + 'login', + 'institution' ], + ValueAttr => [ 'error-detect', + 'enabled' ] ); + +my $ref = $parser->XMLin($ARGV[0]); + +print Dumper($ref); -- 2.11.0