View | Details | Raw Unified | Return to bug 15253
Collapse All | Expand All

(-)a/C4/SIP/ILS.pm (-15 / +15 lines)
Lines 6-12 package C4::SIP::ILS; Link Here
6
6
7
use warnings;
7
use warnings;
8
use strict;
8
use strict;
9
use C4::SIP::Sip qw(syslog);
9
use C4::SIP::Sip qw(siplog);
10
use Data::Dumper;
10
use Data::Dumper;
11
11
12
use C4::SIP::ILS::Item;
12
use C4::SIP::ILS::Item;
Lines 47-53 sub new { Link Here
47
    my $type = ref($class) || $class;
47
    my $type = ref($class) || $class;
48
    my $self = {};
48
    my $self = {};
49
	$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
49
	$debug and warn "new ILS: INSTITUTION: " . Dumper($institution);
50
    syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
50
    siplog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
51
    $self->{institution} = $institution;
51
    $self->{institution} = $institution;
52
    return bless $self, $type;
52
    return bless $self, $type;
53
}
53
}
Lines 82-88 sub supports { Link Here
82
sub check_inst_id {
82
sub check_inst_id {
83
    my ($self, $id, $whence) = @_;
83
    my ($self, $id, $whence) = @_;
84
    if ($id ne $self->{institution}->{id}) {
84
    if ($id ne $self->{institution}->{id}) {
85
        syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
85
        siplog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
86
        # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
86
        # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
87
    }
87
    }
88
}
88
}
Lines 167-179 sub checkout { Link Here
167
            push( @{ $patron->{items} }, { barcode => $item_id } );
167
            push( @{ $patron->{items} }, { barcode => $item_id } );
168
            $circ->desensitize( !$item->magnetic_media );
168
            $circ->desensitize( !$item->magnetic_media );
169
169
170
            syslog(
170
            siplog(
171
                "LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
171
                "LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
172
                $patron_id, join( ', ', map{ $_->{barcode} } @{ $patron->{items} } )
172
                $patron_id, join( ', ', map{ $_->{barcode} } @{ $patron->{items} } )
173
            );
173
            );
174
        }
174
        }
175
        else {
175
        else {
176
            syslog( "LOG_ERR", "ILS::Checkout Issue failed" );
176
            siplog( "LOG_ERR", "ILS::Checkout Issue failed" );
177
        }
177
        }
178
    }
178
    }
179
179
Lines 219-238 sub checkin { Link Here
219
219
220
    if ( !$circ->ok && $circ->alert_type && $circ->alert_type == 98 ) { # data corruption
220
    if ( !$circ->ok && $circ->alert_type && $circ->alert_type == 98 ) { # data corruption
221
        $circ->screen_msg("Checkin failed: data problem");
221
        $circ->screen_msg("Checkin failed: data problem");
222
        syslog( "LOG_WARNING", "Problem with issue_id in issues and old_issues; check the about page" );
222
        siplog( "LOG_WARNING", "Problem with issue_id in issues and old_issues; check the about page" );
223
    } elsif ( $data->{messages}->{withdrawn} && !$circ->ok && C4::Context->preference("BlockReturnOfWithdrawnItems") ) {
223
    } elsif ( $data->{messages}->{withdrawn} && !$circ->ok && C4::Context->preference("BlockReturnOfWithdrawnItems") ) {
224
            $circ->screen_msg("Item withdrawn, return not allowed");
224
            $circ->screen_msg("Item withdrawn, return not allowed");
225
            syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");
225
            siplog ("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");
226
    } elsif ( $data->{messages}->{WasLost} && !$circ->ok && C4::Context->preference("BlockReturnOfLostItems") ) {
226
    } elsif ( $data->{messages}->{WasLost} && !$circ->ok && C4::Context->preference("BlockReturnOfLostItems") ) {
227
            $circ->screen_msg("Item lost, return not allowed");
227
            $circ->screen_msg("Item lost, return not allowed");
228
            syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item lost");
228
            siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item lost");
229
    } elsif ( !$item->{patron} ) {
229
    } elsif ( !$item->{patron} ) {
230
        if ( $checked_in_ok ) { # Mark checkin ok although book not checked out
230
        if ( $checked_in_ok ) { # Mark checkin ok although book not checked out
231
            $circ->ok( 1 );
231
            $circ->ok( 1 );
232
            syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - using checked_in_ok");
232
            siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - using checked_in_ok");
233
        } else {
233
        } else {
234
            $circ->screen_msg("Item not checked out");
234
            $circ->screen_msg("Item not checked out");
235
            syslog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item not checked out");
235
            siplog("LOG_DEBUG", "C4::SIP::ILS::Checkin - item not checked out");
236
        }
236
        }
237
    } elsif ( $circ->ok ) {
237
    } elsif ( $circ->ok ) {
238
        $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron} ) );
238
        $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron} ) );
Lines 244-250 sub checkin { Link Here
244
        # Bug 10748 with pref BlockReturnOfLostItems adds another case to come
244
        # Bug 10748 with pref BlockReturnOfLostItems adds another case to come
245
        # here: returning a lost item when the pref is set.
245
        # here: returning a lost item when the pref is set.
246
        $circ->screen_msg("Checkin failed");
246
        $circ->screen_msg("Checkin failed");
247
        syslog( "LOG_WARNING", "Checkin failed: probably for Wrongbranch or withdrawn" );
247
        siplog( "LOG_WARNING", "Checkin failed: probably for Wrongbranch or withdrawn" );
248
    }
248
    }
249
249
250
    return $circ;
250
    return $circ;
Lines 461-470 sub renew { Link Here
461
		my $count = scalar @{$patron->{items}};
461
		my $count = scalar @{$patron->{items}};
462
		foreach my $i (@{$patron->{items}}) {
462
		foreach my $i (@{$patron->{items}}) {
463
            unless (defined $i->{barcode}) {    # FIXME: using data instead of objects may violate the abstraction layer
463
            unless (defined $i->{barcode}) {    # FIXME: using data instead of objects may violate the abstraction layer
464
                syslog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
464
                siplog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
465
                next;
465
                next;
466
            }
466
            }
467
            syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
467
            siplog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
468
            if ($i->{barcode} eq $item_id) {
468
            if ($i->{barcode} eq $item_id) {
469
				# We have it checked out
469
				# We have it checked out
470
				$item = C4::SIP::ILS::Item->new( $item_id );
470
				$item = C4::SIP::ILS::Item->new( $item_id );
Lines 498-506 sub renew_all { Link Here
498
498
499
    $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
499
    $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
500
    if (defined $patron) {
500
    if (defined $patron) {
501
        syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
501
        siplog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
502
    } else {
502
    } else {
503
        syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
503
        siplog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
504
    }
504
    }
505
505
506
    if (!defined($patron)) {
506
    if (!defined($patron)) {
(-)a/C4/SIP/ILS/Item.pm (-4 / +4 lines)
Lines 9-15 package C4::SIP::ILS::Item; Link Here
9
use strict;
9
use strict;
10
use warnings;
10
use warnings;
11
11
12
use C4::SIP::Sip qw(syslog);
12
use C4::SIP::Sip qw(siplog);
13
use Carp;
13
use Carp;
14
use Template;
14
use Template;
15
15
Lines 77-83 sub new { Link Here
77
    my $type = ref($class) || $class;
77
    my $type = ref($class) || $class;
78
    my $item = Koha::Items->find( { barcode => barcodedecode( $item_id ) } );
78
    my $item = Koha::Items->find( { barcode => barcodedecode( $item_id ) } );
79
    unless ( $item ) {
79
    unless ( $item ) {
80
        syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
80
        siplog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
81
        warn "new ILS::Item($item_id) : No item '$item_id'.";
81
        warn "new ILS::Item($item_id) : No item '$item_id'.";
82
        return;
82
        return;
83
    }
83
    }
Lines 107-113 sub new { Link Here
107
    $self->{author} = $biblio->author;
107
    $self->{author} = $biblio->author;
108
    bless $self, $type;
108
    bless $self, $type;
109
109
110
    syslog( "LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
110
    siplog( "LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
111
        $item_id, $self->{title} // '' );
111
        $item_id, $self->{title} // '' );
112
112
113
    return $self;
113
    return $self;
Lines 181-187 sub hold_patron_name { Link Here
181
181
182
    my $holder = Koha::Patrons->find( $borrowernumber );
182
    my $holder = Koha::Patrons->find( $borrowernumber );
183
    unless ($holder) {
183
    unless ($holder) {
184
        syslog("LOG_ERR", "While checking hold, failed to retrieve the patron with borrowernumber '$borrowernumber'");
184
        siplog("LOG_ERR", "While checking hold, failed to retrieve the patron with borrowernumber '$borrowernumber'");
185
        return;
185
        return;
186
    }
186
    }
187
    my $email = $holder->email || '';
187
    my $email = $holder->email || '';
(-)a/C4/SIP/ILS/Patron.pm (-5 / +5 lines)
Lines 12-18 use warnings; Link Here
12
use Exporter;
12
use Exporter;
13
use Carp;
13
use Carp;
14
14
15
use C4::SIP::Sip qw(syslog);
15
use C4::SIP::Sip qw(siplog);
16
use Data::Dumper;
16
use Data::Dumper;
17
17
18
use C4::SIP::Sip qw(add_field maybe_add);
18
use C4::SIP::Sip qw(add_field maybe_add);
Lines 42-48 sub new { Link Here
42
      || Koha::Patrons->find( { userid => $patron_id } );
42
      || Koha::Patrons->find( { userid => $patron_id } );
43
    $debug and warn "new Patron: " . Dumper($patron->unblessed) if $patron;
43
    $debug and warn "new Patron: " . Dumper($patron->unblessed) if $patron;
44
    unless ($patron) {
44
    unless ($patron) {
45
        syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
45
        siplog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
46
        return;
46
        return;
47
    }
47
    }
48
    $kp = $patron->unblessed;
48
    $kp = $patron->unblessed;
Lines 149-155 sub new { Link Here
149
149
150
    $self = \%ilspatron;
150
    $self = \%ilspatron;
151
    $debug and warn Dumper($self);
151
    $debug and warn Dumper($self);
152
    syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
152
    siplog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
153
    bless $self, $type;
153
    bless $self, $type;
154
    return $self;
154
    return $self;
155
}
155
}
Lines 239-245 sub format { Link Here
239
            $tt->process( \$template, { patron => $patron }, \$output );
239
            $tt->process( \$template, { patron => $patron }, \$output );
240
        };
240
        };
241
        if ( $@ ){
241
        if ( $@ ){
242
            syslog("LOG_DEBUG", "Error processing template: $template");
242
            siplog("LOG_DEBUG", "Error processing template: $template");
243
            return "";
243
            return "";
244
        }
244
        }
245
        return $output;
245
        return $output;
Lines 414-420 sub enable { Link Here
414
    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
414
    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
415
        $self->{$field} = 1;
415
        $self->{$field} = 1;
416
    }
416
    }
417
    syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
417
    siplog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
418
       $self->{id}, $self->{charge_ok}, $self->{renew_ok},
418
       $self->{id}, $self->{charge_ok}, $self->{renew_ok},
419
       $self->{recall_ok}, $self->{hold_ok});
419
       $self->{recall_ok}, $self->{hold_ok});
420
    $self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored.";   # TODO: not really affecting patron record
420
    $self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored.";   # TODO: not really affecting patron record
(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-3 / +3 lines)
Lines 8-14 use warnings; Link Here
8
use strict;
8
use strict;
9
9
10
use POSIX qw(strftime);
10
use POSIX qw(strftime);
11
use C4::SIP::Sip qw(syslog);
11
use C4::SIP::Sip qw(siplog);
12
use Data::Dumper;
12
use Data::Dumper;
13
use CGI qw ( -utf8 );
13
use CGI qw ( -utf8 );
14
14
Lines 47-53 sub new { Link Here
47
47
48
sub do_checkout {
48
sub do_checkout {
49
	my $self = shift;
49
	my $self = shift;
50
	syslog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
50
	siplog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
51
	my $shelf          = $self->{item}->hold_shelf;
51
	my $shelf          = $self->{item}->hold_shelf;
52
	my $barcode        = $self->{item}->id;
52
	my $barcode        = $self->{item}->id;
53
	my $patron_barcode = $self->{patron}->id;
53
	my $patron_barcode = $self->{patron}->id;
Lines 103-109 sub do_checkout { Link Here
103
                # We've been returned a case other than those above
103
                # We've been returned a case other than those above
104
                $self->screen_msg("Item cannot be issued: $confirmation");
104
                $self->screen_msg("Item cannot be issued: $confirmation");
105
                $noerror = 0;
105
                $noerror = 0;
106
                syslog('LOG_DEBUG', "Blocking checkout Reason:$confirmation");
106
                siplog('LOG_DEBUG', "Blocking checkout Reason:$confirmation");
107
                last;
107
                last;
108
            }
108
            }
109
        }
109
        }
(-)a/C4/SIP/ILS/Transaction/RenewAll.pm (-2 / +2 lines)
Lines 6-12 package C4::SIP::ILS::Transaction::RenewAll; Link Here
6
use strict;
6
use strict;
7
use warnings;
7
use warnings;
8
8
9
use C4::SIP::Sip qw(syslog);
9
use C4::SIP::Sip qw(siplog);
10
10
11
use C4::SIP::ILS::Item;
11
use C4::SIP::ILS::Item;
12
12
Lines 42-48 sub do_renew_all { Link Here
42
        my $item_id = $itemx->{barcode};
42
        my $item_id = $itemx->{barcode};
43
        my $item    = C4::SIP::ILS::Item->new($item_id);
43
        my $item    = C4::SIP::ILS::Item->new($item_id);
44
        if ( !defined($item) ) {
44
        if ( !defined($item) ) {
45
            syslog(
45
            siplog(
46
                'LOG_WARNING',
46
                'LOG_WARNING',
47
                q|renew_all: Invalid item id '%s' associated with patron '%s'|,
47
                q|renew_all: Invalid item id '%s' associated with patron '%s'|,
48
                $item_id,
48
                $item_id,
(-)a/C4/SIP/README (-7 / +1 lines)
Lines 14-24 perl modules to run: Link Here
14
14
15
LOGGING
15
LOGGING
16
16
17
SIPServer uses syslog() for status and debugging messages.  All
17
SIPServer uses Koha::Logger for status and debugging messages.
18
syslog messages are logged using the syslog facility 'local6'.
19
If you need to change this, because something else on your system
20
is already using that facililty, just change the definition of
21
'LOG_SIP' at the top of the file SIPServer.pm
22
18
23
Make sure to update your syslog configuration to capture facility
24
'local6' and record it.
(-)a/C4/SIP/SIPServer.pm (-27 / +27 lines)
Lines 12-18 use Scalar::Util qw(blessed); Link Here
12
require UNIVERSAL::require;
12
require UNIVERSAL::require;
13
13
14
use C4::Context;
14
use C4::Context;
15
use C4::SIP::Sip qw(syslog);
15
use C4::SIP::Sip qw(siplog);
16
use C4::SIP::Sip::Constants qw(:all);
16
use C4::SIP::Sip::Constants qw(:all);
17
use C4::SIP::Sip::Configuration;
17
use C4::SIP::Sip::Configuration;
18
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
18
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
Lines 125-138 sub process_request { Link Here
125
    $self->{service} = $config->find_service($sockaddr, $port, $proto);
125
    $self->{service} = $config->find_service($sockaddr, $port, $proto);
126
126
127
    if (!defined($self->{service})) {
127
    if (!defined($self->{service})) {
128
		syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
128
		siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
129
		die "process_request: Bad server connection";
129
		die "process_request: Bad server connection";
130
    }
130
    }
131
131
132
    $transport = $transports{$self->{service}->{transport}};
132
    $transport = $transports{$self->{service}->{transport}};
133
133
134
    if (!defined($transport)) {
134
    if (!defined($transport)) {
135
		syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
135
		siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
136
		return;
136
		return;
137
    } else {
137
    } else {
138
		&$transport($self);
138
		&$transport($self);
Lines 158-170 sub raw_transport { Link Here
158
    # In practice it should only iterate once but be prepared
158
    # In practice it should only iterate once but be prepared
159
    local $SIG{ALRM} = sub { die 'raw transport Timed Out!' };
159
    local $SIG{ALRM} = sub { die 'raw transport Timed Out!' };
160
    my $timeout = $self->get_timeout({ transport => 1 });
160
    my $timeout = $self->get_timeout({ transport => 1 });
161
    syslog('LOG_DEBUG', "raw_transport: timeout is $timeout");
161
    siplog('LOG_DEBUG', "raw_transport: timeout is $timeout");
162
    alarm $timeout;
162
    alarm $timeout;
163
    while (!$self->{account}) {
163
    while (!$self->{account}) {
164
        $input = read_request();
164
        $input = read_request();
165
        if (!$input) {
165
        if (!$input) {
166
            # EOF on the socket
166
            # EOF on the socket
167
            syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
167
            siplog("LOG_INFO", "raw_transport: shutting down: EOF during login");
168
            return;
168
            return;
169
        }
169
        }
170
        $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)
170
        $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)
Lines 187-215 sub raw_transport { Link Here
187
    Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
187
    Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
188
    Log::Log4perl::MDC->put( "peeraddr",  $self->{server}->{peeraddr} );
188
    Log::Log4perl::MDC->put( "peeraddr",  $self->{server}->{peeraddr} );
189
189
190
    syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
190
    siplog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
191
        $self->{account}->{id},
191
        $self->{account}->{id},
192
        $self->{account}->{institution});
192
        $self->{account}->{institution});
193
    if (! $self->{account}->{id}) {
193
    if (! $self->{account}->{id}) {
194
        syslog("LOG_ERR","Login failed shutting down");
194
        siplog("LOG_ERR","Login failed shutting down");
195
        return;
195
        return;
196
    }
196
    }
197
197
198
    $self->sip_protocol_loop();
198
    $self->sip_protocol_loop();
199
    syslog("LOG_INFO", "raw_transport: shutting down");
199
    siplog("LOG_INFO", "raw_transport: shutting down");
200
    return;
200
    return;
201
}
201
}
202
202
203
sub get_clean_string {
203
sub get_clean_string {
204
	my $string = shift;
204
	my $string = shift;
205
	if (defined $string) {
205
	if (defined $string) {
206
		syslog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
206
		siplog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
207
		chomp($string);
207
		chomp($string);
208
		$string =~ s/^[^A-z0-9]+//;
208
		$string =~ s/^[^A-z0-9]+//;
209
		$string =~ s/[^A-z0-9]+$//;
209
		$string =~ s/[^A-z0-9]+$//;
210
		syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
210
		siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
211
	} else {
211
	} else {
212
		syslog("LOG_INFO", "get_clean_string called on undefined");
212
		siplog("LOG_INFO", "get_clean_string called on undefined");
213
	}
213
	}
214
	return $string;
214
	return $string;
215
}
215
}
Lines 219-225 sub get_clean_input { Link Here
219
	my $in = <STDIN>;
219
	my $in = <STDIN>;
220
	$in = get_clean_string($in);
220
	$in = get_clean_string($in);
221
	while (my $extra = <STDIN>){
221
	while (my $extra = <STDIN>){
222
		syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
222
		siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
223
	}
223
	}
224
	return $in;
224
	return $in;
225
}
225
}
Lines 232-238 sub telnet_transport { Link Here
232
    my $input;
232
    my $input;
233
    my $config  = $self->{config};
233
    my $config  = $self->{config};
234
    my $timeout = $self->get_timeout({ transport => 1 });
234
    my $timeout = $self->get_timeout({ transport => 1 });
235
    syslog("LOG_DEBUG", "telnet_transport: timeout is $timeout");
235
    siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout");
236
236
237
    eval {
237
    eval {
238
	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
238
	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
Lines 251-260 sub telnet_transport { Link Here
251
		$pwd = <STDIN>;
251
		$pwd = <STDIN>;
252
		alarm 0;
252
		alarm 0;
253
253
254
		syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
254
		siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
255
		$uid = get_clean_string ($uid);
255
		$uid = get_clean_string ($uid);
256
		$pwd = get_clean_string ($pwd);
256
		$pwd = get_clean_string ($pwd);
257
		syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
257
		siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
258
258
259
	    if (exists ($config->{accounts}->{$uid})
259
	    if (exists ($config->{accounts}->{$uid})
260
		&& ($pwd eq $config->{accounts}->{$uid}->{password})) {
260
		&& ($pwd eq $config->{accounts}->{$uid}->{password})) {
Lines 263-287 sub telnet_transport { Link Here
263
                last;
263
                last;
264
            }
264
            }
265
	    }
265
	    }
266
		syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
266
		siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
267
		print("Invalid login$CRLF");
267
		print("Invalid login$CRLF");
268
	}
268
	}
269
    }; # End of eval
269
    }; # End of eval
270
270
271
    if ($@) {
271
    if ($@) {
272
		syslog("LOG_ERR", "telnet_transport: Login timed out");
272
		siplog("LOG_ERR", "telnet_transport: Login timed out");
273
		die "Telnet Login Timed out";
273
		die "Telnet Login Timed out";
274
    } elsif (!defined($account)) {
274
    } elsif (!defined($account)) {
275
		syslog("LOG_ERR", "telnet_transport: Login Failed");
275
		siplog("LOG_ERR", "telnet_transport: Login Failed");
276
		die "Login Failure";
276
		die "Login Failure";
277
    } else {
277
    } else {
278
		print "Login OK.  Initiating SIP$CRLF";
278
		print "Login OK.  Initiating SIP$CRLF";
279
    }
279
    }
280
280
281
    $self->{account} = $account;
281
    $self->{account} = $account;
282
    syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
282
    siplog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
283
    $self->sip_protocol_loop();
283
    $self->sip_protocol_loop();
284
    syslog("LOG_INFO", "telnet_transport: shutting down");
284
    siplog("LOG_INFO", "telnet_transport: shutting down");
285
    return;
285
    return;
286
}
286
}
287
287
Lines 311-317 sub sip_protocol_loop { Link Here
311
    # In short, we'll take any valid message here.
311
    # In short, we'll take any valid message here.
312
    eval {
312
    eval {
313
        local $SIG{ALRM} = sub {
313
        local $SIG{ALRM} = sub {
314
            syslog( 'LOG_DEBUG', 'Inactive: timed out' );
314
            siplog( 'LOG_DEBUG', 'Inactive: timed out' );
315
            die "Timed Out!\n";
315
            die "Timed Out!\n";
316
        };
316
        };
317
        my $previous_alarm = alarm($timeout);
317
        my $previous_alarm = alarm($timeout);
Lines 323-336 sub sip_protocol_loop { Link Here
323
            alarm($timeout);
323
            alarm($timeout);
324
324
325
            unless ($inputbuf) {
325
            unless ($inputbuf) {
326
                syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" );
326
                siplog( "LOG_ERR", "sip_protocol_loop: empty input skipped" );
327
                print("96$CR");
327
                print("96$CR");
328
                next;
328
                next;
329
            }
329
            }
330
330
331
            my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} );
331
            my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} );
332
            if ( !$status ) {
332
            if ( !$status ) {
333
                syslog(
333
                siplog(
334
                    "LOG_ERR",
334
                    "LOG_ERR",
335
                    "sip_protocol_loop: failed to handle %s",
335
                    "sip_protocol_loop: failed to handle %s",
336
                    substr( $inputbuf, 0, 2 )
336
                    substr( $inputbuf, 0, 2 )
Lines 369-384 sub read_request { Link Here
369
    # treat as one line to include the extra linebreaks we are trying to remove!
369
    # treat as one line to include the extra linebreaks we are trying to remove!
370
      }
370
      }
371
      else {
371
      else {
372
          syslog( 'LOG_DEBUG', 'EOF returned on read' );
372
          siplog( 'LOG_DEBUG', 'EOF returned on read' );
373
          return;
373
          return;
374
      }
374
      }
375
      my $len = length $buffer;
375
      my $len = length $buffer;
376
      if ( $len != $raw_length ) {
376
      if ( $len != $raw_length ) {
377
          my $trim = $raw_length - $len;
377
          my $trim = $raw_length - $len;
378
          syslog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
378
          siplog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
379
      }
379
      }
380
380
381
      syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" );
381
      siplog( 'LOG_INFO', "INPUT MSG: '$buffer'" );
382
      return $buffer;
382
      return $buffer;
383
}
383
}
384
384
Lines 414-420 sub get_timeout { Link Here
414
        my $policy = $server->{policy} // {};
414
        my $policy = $server->{policy} // {};
415
        my $rv = sprintf( "%03d", $policy->{timeout} // 0 );
415
        my $rv = sprintf( "%03d", $policy->{timeout} // 0 );
416
        if( length($rv) != 3 ) {
416
        if( length($rv) != 3 ) {
417
            syslog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv );
417
            siplog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv );
418
            return '000';
418
            return '000';
419
        }
419
        }
420
        return $rv;
420
        return $rv;
(-)a/C4/SIP/Sip.pm (-6 / +6 lines)
Lines 22-34 use base qw(Exporter); Link Here
22
our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
22
our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
23
    denied sipbool boolspace write_msg
23
    denied sipbool boolspace write_msg
24
    $error_detection $protocol_version $field_delimiter
24
    $error_detection $protocol_version $field_delimiter
25
    $last_response syslog);
25
    $last_response siplog);
26
26
27
our %EXPORT_TAGS = (
27
our %EXPORT_TAGS = (
28
    all => [qw(y_or_n timestamp add_field maybe_add
28
    all => [qw(y_or_n timestamp add_field maybe_add
29
        add_count denied sipbool boolspace write_msg
29
        add_count denied sipbool boolspace write_msg
30
        $error_detection $protocol_version
30
        $error_detection $protocol_version
31
        $field_delimiter $last_response syslog)]);
31
        $field_delimiter $last_response siplog)]);
32
32
33
our $error_detection = 0;
33
our $error_detection = 0;
34
our $protocol_version = 1;
34
our $protocol_version = 1;
Lines 68-74 sub add_field { Link Here
68
    my ($i, $ent);
68
    my ($i, $ent);
69
69
70
    if (!defined($value)) {
70
    if (!defined($value)) {
71
	syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
71
	siplog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
72
	       $field_id);
72
	       $field_id);
73
		$value = '';
73
		$value = '';
74
    }
74
    }
Lines 127-133 sub add_count { Link Here
127
127
128
    $count = sprintf("%04d", $count);
128
    $count = sprintf("%04d", $count);
129
    if (length($count) != 4) {
129
    if (length($count) != 4) {
130
		syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
130
		siplog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
131
	       $label, $count);
131
	       $label, $count);
132
		$count = ' ' x 4;
132
		$count = ' ' x 4;
133
    }
133
    }
Lines 198-210 sub write_msg { Link Here
198
    } else {
198
    } else {
199
        STDOUT->autoflush(1);
199
        STDOUT->autoflush(1);
200
        print $msg, $terminator;
200
        print $msg, $terminator;
201
        syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
201
        siplog("LOG_INFO", "OUTPUT MSG: '$msg'");
202
    }
202
    }
203
203
204
    $last_response = $msg;
204
    $last_response = $msg;
205
}
205
}
206
206
207
sub syslog {
207
sub siplog {
208
    my ( $level, $mask, @args ) = @_;
208
    my ( $level, $mask, @args ) = @_;
209
209
210
    my $method =
210
    my $method =
(-)a/C4/SIP/Sip/Configuration.pm (-2 / +2 lines)
Lines 10-16 use strict; Link Here
10
use warnings;
10
use warnings;
11
use XML::Simple qw(:strict);
11
use XML::Simple qw(:strict);
12
12
13
use C4::SIP::Sip qw(syslog);
13
use C4::SIP::Sip qw(siplog);
14
14
15
my $parser = new XML::Simple(
15
my $parser = new XML::Simple(
16
    KeyAttr => {
16
    KeyAttr => {
Lines 65-71 sub find_service { Link Here
65
    my $portstr;
65
    my $portstr;
66
    foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
66
    foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
67
        $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
67
        $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
68
        syslog( "LOG_DEBUG",
68
        siplog( "LOG_DEBUG",
69
            "Configuration::find_service: Trying $portstr" );
69
            "Configuration::find_service: Trying $portstr" );
70
        last if ( exists( ( $self->{listeners} )->{$portstr} ) );
70
        last if ( exists( ( $self->{listeners} )->{$portstr} ) );
71
    }
71
    }
(-)a/C4/SIP/Sip/MsgType.pm (-35 / +34 lines)
Lines 266-279 sub new { Link Here
266
        # it's using the 2.00 login process, so it must support 2.00.
266
        # it's using the 2.00 login process, so it must support 2.00.
267
        $protocol_version = 2;
267
        $protocol_version = 2;
268
    }
268
    }
269
    syslog( "LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s", $class, substr( $msg, 0, 10 ), $msgtag, $seqno, $protocol_version );
269
    siplog( "LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s", $class, substr( $msg, 0, 10 ), $msgtag, $seqno, $protocol_version );
270
270
271
    # warn "SIP PROTOCOL: $protocol_version";
271
    # warn "SIP PROTOCOL: $protocol_version";
272
    if ( !exists( $handlers{$msgtag} ) ) {
272
    if ( !exists( $handlers{$msgtag} ) ) {
273
        syslog( "LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", $msgtag, $msg );
273
        siplog( "LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", $msgtag, $msg );
274
        return;
274
        return;
275
    } elsif ( !exists( $handlers{$msgtag}->{protocol}->{$protocol_version} ) ) {
275
    } elsif ( !exists( $handlers{$msgtag}->{protocol}->{$protocol_version} ) ) {
276
        syslog( "LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'", $msgtag, $protocol_version );
276
        siplog( "LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'", $msgtag, $protocol_version );
277
        return;
277
        return;
278
    }
278
    }
279
279
Lines 305-311 sub _initialize { Link Here
305
        $self->{fields}->{$field} = undef;
305
        $self->{fields}->{$field} = undef;
306
    }
306
    }
307
307
308
    syslog( "LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)", $self->{name}, $msg, $proto->{template}, $proto->{template_len} );
308
    siplog( "LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)", $self->{name}, $msg, $proto->{template}, $proto->{template_len} );
309
309
310
    $self->{fixed_fields} = [ unpack( $proto->{template}, $msg ) ];    # see http://perldoc.perl.org/5.8.8/functions/unpack.html
310
    $self->{fixed_fields} = [ unpack( $proto->{template}, $msg ) ];    # see http://perldoc.perl.org/5.8.8/functions/unpack.html
311
311
Lines 315-323 sub _initialize { Link Here
315
        $fn = substr( $field, 0, 2 );
315
        $fn = substr( $field, 0, 2 );
316
316
317
        if ( !exists( $self->{fields}->{$fn} ) ) {
317
        if ( !exists( $self->{fields}->{$fn} ) ) {
318
            syslog( "LOG_WARNING", "Unsupported field '%s' in %s message '%s'", $fn, $self->{name}, $msg );
318
            siplog( "LOG_WARNING", "Unsupported field '%s' in %s message '%s'", $fn, $self->{name}, $msg );
319
        } elsif ( defined( $self->{fields}->{$fn} ) ) {
319
        } elsif ( defined( $self->{fields}->{$fn} ) ) {
320
            syslog( "LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'", $fn, $self->{fields}->{$fn}, $self->{name}, $msg );
320
            siplog( "LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'", $fn, $self->{fields}->{$fn}, $self->{name}, $msg );
321
        } else {
321
        } else {
322
            $self->{fields}->{$fn} = substr( $field, 2 );
322
            $self->{fields}->{$fn} = substr( $field, 2 );
323
        }
323
        }
Lines 366-372 sub handle { Link Here
366
        $error_detection = 1;
366
        $error_detection = 1;
367
367
368
        if ( !verify_cksum($msg) ) {
368
        if ( !verify_cksum($msg) ) {
369
            syslog( "LOG_WARNING", "Checksum failed on message '%s'", $msg );
369
            siplog( "LOG_WARNING", "Checksum failed on message '%s'", $msg );
370
370
371
            # REQUEST_SC_RESEND with error detection
371
            # REQUEST_SC_RESEND with error detection
372
            $last_response = REQUEST_SC_RESEND_CKSUM;
372
            $last_response = REQUEST_SC_RESEND_CKSUM;
Lines 382-388 sub handle { Link Here
382
382
383
        # We received a non-ED message when ED is supposed to be active.
383
        # We received a non-ED message when ED is supposed to be active.
384
        # Warn about this problem, then process the message anyway.
384
        # Warn about this problem, then process the message anyway.
385
        syslog( "LOG_WARNING", "Received message without error detection: '%s'", $msg );
385
        siplog( "LOG_WARNING", "Received message without error detection: '%s'", $msg );
386
        $error_detection = 0;
386
        $error_detection = 0;
387
        $self = C4::SIP::Sip::MsgType->new( $msg, 0 );
387
        $self = C4::SIP::Sip::MsgType->new( $msg, 0 );
388
    } else {
388
    } else {
Lines 395-401 sub handle { Link Here
395
        return substr( $msg, 0, 2 );
395
        return substr( $msg, 0, 2 );
396
    }
396
    }
397
    unless ( $self->{handler} ) {
397
    unless ( $self->{handler} ) {
398
        syslog( "LOG_WARNING", "No handler defined for '%s'", $msg );
398
        siplog( "LOG_WARNING", "No handler defined for '%s'", $msg );
399
        $last_response = REQUEST_SC_RESEND;
399
        $last_response = REQUEST_SC_RESEND;
400
        print("$last_response\r");
400
        print("$last_response\r");
401
        return REQUEST_ACS_RESEND;
401
        return REQUEST_ACS_RESEND;
Lines 526-532 sub handle_checkout { Link Here
526
526
527
        # Off-line transactions need to be recorded, but there's
527
        # Off-line transactions need to be recorded, but there's
528
        # not a lot we can do about it
528
        # not a lot we can do about it
529
        syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
529
        siplog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
530
530
531
        $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
531
        $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
532
    } else {
532
    } else {
Lines 653-659 sub handle_checkin { Link Here
653
    if ( $no_block eq 'Y' ) {
653
    if ( $no_block eq 'Y' ) {
654
654
655
        # Off-line transactions, ick.
655
        # Off-line transactions, ick.
656
        syslog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
656
        siplog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
657
        $status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
657
        $status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
658
    } else {
658
    } else {
659
        $status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );
659
        $status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );
Lines 772-790 sub handle_sc_status { Link Here
772
    } elsif ( $sc_protocol_version =~ /^2\./ ) {
772
    } elsif ( $sc_protocol_version =~ /^2\./ ) {
773
        $new_proto = 2;
773
        $new_proto = 2;
774
    } else {
774
    } else {
775
        syslog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
775
        siplog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
776
        $new_proto = 1;
776
        $new_proto = 1;
777
    }
777
    }
778
778
779
    if ( $new_proto != $protocol_version ) {
779
    if ( $new_proto != $protocol_version ) {
780
        syslog( "LOG_INFO", "Setting protocol level to $new_proto" );
780
        siplog( "LOG_INFO", "Setting protocol level to $new_proto" );
781
        $protocol_version = $new_proto;
781
        $protocol_version = $new_proto;
782
    }
782
    }
783
783
784
    if ( $status == SC_STATUS_PAPER ) {
784
    if ( $status == SC_STATUS_PAPER ) {
785
        syslog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
785
        siplog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
786
    } elsif ( $status == SC_STATUS_SHUTDOWN ) {
786
    } elsif ( $status == SC_STATUS_SHUTDOWN ) {
787
        syslog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
787
        siplog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
788
    }
788
    }
789
789
790
    $self->{account}->{print_width} = $print_width;
790
    $self->{account}->{print_width} = $print_width;
Lines 824-833 sub login_core { Link Here
824
    my $pwd    = shift;
824
    my $pwd    = shift;
825
    my $status = 1;                 # Assume it all works
825
    my $status = 1;                 # Assume it all works
826
    if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
826
    if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
827
        syslog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
827
        siplog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
828
        $status = 0;
828
        $status = 0;
829
    } elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
829
    } elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
830
        syslog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
830
        siplog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
831
        $status = 0;
831
        $status = 0;
832
    } else {
832
    } else {
833
833
Lines 841-856 sub login_core { Link Here
841
841
842
        my $auth_status = api_auth( $uid, $pwd, $inst );
842
        my $auth_status = api_auth( $uid, $pwd, $inst );
843
        if ( !$auth_status or $auth_status !~ /^ok$/i ) {
843
        if ( !$auth_status or $auth_status !~ /^ok$/i ) {
844
            syslog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status || 'unknown' ) );
844
            siplog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status || 'unknown' ) );
845
            $status = 0;
845
            $status = 0;
846
        } else {
846
        } else {
847
            syslog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
847
            siplog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
848
848
849
            #
849
            #
850
            # initialize connection to ILS
850
            # initialize connection to ILS
851
            #
851
            #
852
            my $module = $server->{config}->{institutions}->{$inst}->{implementation};
852
            my $module = $server->{config}->{institutions}->{$inst}->{implementation};
853
            syslog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );
853
            siplog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );
854
854
855
            # Suspect this is always ILS but so we don't break any eccentic install (for now)
855
            # Suspect this is always ILS but so we don't break any eccentic install (for now)
856
            if ( $module eq 'ILS' ) {
856
            if ( $module eq 'ILS' ) {
Lines 858-871 sub login_core { Link Here
858
            }
858
            }
859
            $module->use;
859
            $module->use;
860
            if ($@) {
860
            if ($@) {
861
                syslog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
861
                siplog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
862
                die("Failed to load ILS implementation '$module' for $inst");
862
                die("Failed to load ILS implementation '$module' for $inst");
863
            }
863
            }
864
864
865
            # like   ILS->new(), I think.
865
            # like   ILS->new(), I think.
866
            $server->{ils} = $module->new( $server->{institution}, $server->{account} );
866
            $server->{ils} = $module->new( $server->{institution}, $server->{account} );
867
            if ( !$server->{ils} ) {
867
            if ( !$server->{ils} ) {
868
                syslog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
868
                siplog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
869
                die("Unable to connect to ILS '$inst'");
869
                die("Unable to connect to ILS '$inst'");
870
            }
870
            }
871
        }
871
        }
Lines 888-894 sub handle_login { Link Here
888
    $pwd = $fields->{ (FID_LOGIN_PWD) };    # Terminal PWD, not patron PWD.
888
    $pwd = $fields->{ (FID_LOGIN_PWD) };    # Terminal PWD, not patron PWD.
889
889
890
    if ( $uid_algorithm || $pwd_algorithm ) {
890
    if ( $uid_algorithm || $pwd_algorithm ) {
891
        syslog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
891
        siplog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
892
        $status = 0;
892
        $status = 0;
893
    } else {
893
    } else {
894
        $status = login_core( $server, $uid, $pwd );
894
        $status = login_core( $server, $uid, $pwd );
Lines 927-939 sub summary_info { Link Here
927
        return '';    # No detailed information required
927
        return '';    # No detailed information required
928
    }
928
    }
929
929
930
    syslog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );
930
    siplog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );
931
931
932
    my $func     = $summary_map[$summary_type]->{func};
932
    my $func     = $summary_map[$summary_type]->{func};
933
    my $fid      = $summary_map[$summary_type]->{fid};
933
    my $fid      = $summary_map[$summary_type]->{fid};
934
    my $itemlist = &$func( $patron, $start, $end, $server );
934
    my $itemlist = &$func( $patron, $start, $end, $server );
935
935
936
    syslog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );
936
    siplog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );
937
    foreach my $i ( @{$itemlist} ) {
937
    foreach my $i ( @{$itemlist} ) {
938
        $resp .= add_field( $fid, $i->{barcode}, $server );
938
        $resp .= add_field( $fid, $i->{barcode}, $server );
939
    }
939
    }
Lines 1256-1262 sub handle_item_status_update { Link Here
1256
    $item_props = $fields->{ (FID_ITEM_PROPS) };
1256
    $item_props = $fields->{ (FID_ITEM_PROPS) };
1257
1257
1258
    if ( !defined($item_id) ) {
1258
    if ( !defined($item_id) ) {
1259
        syslog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1259
        siplog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1260
    } else {
1260
    } else {
1261
        $item = $ils->find_item($item_id);
1261
        $item = $ils->find_item($item_id);
1262
    }
1262
    }
Lines 1301-1307 sub handle_patron_enable { Link Here
1301
    $patron_id  = $fields->{ (FID_PATRON_ID) };
1301
    $patron_id  = $fields->{ (FID_PATRON_ID) };
1302
    $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1302
    $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1303
1303
1304
    syslog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1304
    siplog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1305
1305
1306
    $patron = $ils->find_patron($patron_id);
1306
    $patron = $ils->find_patron($patron_id);
1307
1307
Lines 1371-1377 sub handle_hold { Link Here
1371
    } elsif ( $hold_mode eq '*' ) {
1371
    } elsif ( $hold_mode eq '*' ) {
1372
        $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1372
        $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1373
    } else {
1373
    } else {
1374
        syslog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1374
        siplog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1375
        $status = $ils->Transaction::Hold;    # new?
1375
        $status = $ils->Transaction::Hold;    # new?
1376
        $status->screen_msg("System error. Please contact library staff.");
1376
        $status->screen_msg("System error. Please contact library staff.");
1377
    }
1377
    }
Lines 1419-1425 sub handle_renew { Link Here
1419
    $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1419
    $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1420
1420
1421
    if ( $no_block eq 'Y' ) {
1421
    if ( $no_block eq 'Y' ) {
1422
        syslog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1422
        siplog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1423
    }
1423
    }
1424
1424
1425
    $patron_id  = $fields->{ (FID_PATRON_ID) };
1425
    $patron_id  = $fields->{ (FID_PATRON_ID) };
Lines 1586-1592 sub send_acs_status { Link Here
1586
    $retries            = sprintf( "%03d", $policy->{retries} );
1586
    $retries            = sprintf( "%03d", $policy->{retries} );
1587
1587
1588
    if ( length($retries) != 3 ) {
1588
    if ( length($retries) != 3 ) {
1589
        syslog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1589
        siplog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1590
        $retries = '000';
1590
        $retries = '000';
1591
    }
1591
    }
1592
1592
Lines 1599-1605 sub send_acs_status { Link Here
1599
    } elsif ( $protocol_version == 2 ) {
1599
    } elsif ( $protocol_version == 2 ) {
1600
        $msg .= '2.00';
1600
        $msg .= '2.00';
1601
    } else {
1601
    } else {
1602
        syslog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1602
        siplog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1603
        $msg .= '1.00';
1603
        $msg .= '1.00';
1604
    }
1604
    }
1605
1605
Lines 1619-1625 sub send_acs_status { Link Here
1619
            }
1619
            }
1620
        }
1620
        }
1621
        if ( length($supported_msgs) < 16 ) {
1621
        if ( length($supported_msgs) < 16 ) {
1622
            syslog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1622
            siplog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1623
        }
1623
        }
1624
        $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1624
        $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1625
    }
1625
    }
Lines 1629-1635 sub send_acs_status { Link Here
1629
    if (   defined( $account->{print_width} )
1629
    if (   defined( $account->{print_width} )
1630
        && defined($print_line)
1630
        && defined($print_line)
1631
        && $account->{print_width} < length($print_line) ) {
1631
        && $account->{print_width} < length($print_line) ) {
1632
        syslog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1632
        siplog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1633
        $print_line = substr( $print_line, 0, $account->{print_width} );
1633
        $print_line = substr( $print_line, 0, $account->{print_width} );
1634
    }
1634
    }
1635
1635
Lines 1649-1655 sub patron_status_string { Link Here
1649
    my $patron = shift;
1649
    my $patron = shift;
1650
    my $patron_status;
1650
    my $patron_status;
1651
1651
1652
    syslog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1652
    siplog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1653
    $patron_status = sprintf(
1653
    $patron_status = sprintf(
1654
        '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1654
        '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1655
        denied( $patron->charge_ok ),
1655
        denied( $patron->charge_ok ),
1656
- 

Return to bug 15253