Initial revision

diff --git a/ILS.pm b/ILS.pm
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
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 = <STDIN>;
+           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 = <STDIN>;
+           alarm 0;
+
+           print "password: ";
+           alarm $timeout;
+           $pwd = <STDIN>;
+           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 = <STDIN>) {
+       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 (file)
index 0000000..a53b846
--- /dev/null
+++ b/SIPconfig.xml
@@ -0,0 +1,50 @@
+<acsconfig xmlns="http://openncip.org/acs-config/1.0/">
+
+  <error-detect enabled="true" />
+  
+  <listeners>
+    <service
+      port="192.168.1.101:8080/tcp"
+      transport="http"
+      protocol="NCIP/1.0" />
+
+    <service
+      port="8023/tcp"
+      transport="telnet"
+      protocol="SIP/1.00"
+      timeout="60" />
+
+    <service
+      port="127.0.0.1:5300/tcp"
+      transport="RAW" 
+      protocol="SIP/2.00"
+      timeout="60" />
+  </listeners>
+
+  <accounts>
+      <login id="scclient" password="clientpwd" institution="UWOLS">
+      </login>
+      <login id="scclient-2" password="clientpwd-2"
+             institution="UWOLS" />
+      <login id="lpl-sc" password="1234" institution="LPL" />
+      <login id="lpl-sc-beacock" password="xyzzy"
+             delimiter="|" error-detect="enabled" institution="LPL" />
+  </accounts>
+
+<!-- Institution tags will hold stuff used to interface to -->
+<!-- the rest of the ILS: authentication parameters, etc.  I -->
+<!-- don't know what yet, so it'll just be blank.  But there -->
+<!-- needs to be one institution stanza for each institution -->
+<!-- named in the accounts above. -->
+<institutions>
+    <institution id="UWOLS" >
+          <policy checkin="true" renewal="false"
+                 status_update="false" offline="false"
+                 timeout="600"
+                 retries="3" />
+    </institution>
+
+    <institution id="LPL">
+    </institution>
+</institutions>
+</acsconfig>
\ No newline at end of file

diff --git a/Sip.pm b/Sip.pm
new file mode 100644 (file)
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 (file)
index 0000000..dd5776b
--- /dev/null
+++ b/Sip/Checksum.pm
@@ -0,0 +1,54 @@
+\r
+package Sip::Checksum;\r
+\r
+use Exporter;\r
+use strict;\r
+use warnings;\r
+\r
+our @ISA = qw(Exporter);\r
+our @EXPORT_OK = qw(checksum verify_cksum);\r
+\r
+sub checksum {\r
+    my $pkt = shift;\r
+\r
+    return (-unpack("%16C*", $pkt)) & 0xFFFF;\r
+}\r
+\r
+sub verify_cksum {\r
+    my $pkt = shift;\r
+    my $cksum;\r
+    my $shortsum;\r
+\r
+    return 0 if (substr($pkt, -6, 2) ne "AZ"); # No checksum at end\r
+\r
+    # Convert the checksum back to hex and calculate the sum of the\r
+    # pack without the checksum.\r
+    $cksum = hex(substr($pkt, -4));\r
+    $shortsum = unpack("%16C*", substr($pkt, 0, -4));\r
+\r
+    # The checksum is valid if the hex sum, plus the checksum of the \r
+    # base packet short when truncated to 16 bits.\r
+    return (($cksum + $shortsum) & 0xFFFF) == 0;\r
+}\r
+\r
+{\r
+    no warnings qw(once);\r
+    eval join('',<main::DATA>) || die $@ unless caller();\r
+}\r
+__END__\r
+\r
+#\r
+# Some simple test data\r
+#\r
+sub test {\r
+    my $testpkt = shift;\r
+    my $cksum = checksum($testpkt);\r
+    my $fullpkt = sprintf("%s%4X", $testpkt, $cksum);\r
+\r
+    print $fullpkt, "\n";\r
+}\r
+\r
+while (<>) {\r
+    chomp;\r
+    test($_);\r
+}\r

diff --git a/Sip/Configuration.pm b/Sip/Configuration.pm
new file mode 100644 (file)
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('',<main::DATA>) || 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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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);