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(log);
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
    log("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
        log("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
            log(
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
            log( "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
        log( "LOG_WARNING", "Problem with issue_id in issues and old_issues; check the about page" );
223
    } elsif ( $data->{messages}->{withdrawn} && !$circ->ok ) {
223
    } elsif ( $data->{messages}->{withdrawn} && !$circ->ok ) {
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
            log("LOG_DEBUG", "C4::SIP::ILS::Checkin - item withdrawn");
226
    } elsif ( $data->{messages}->{WasLost} && !$circ->ok ) {
226
    } elsif ( $data->{messages}->{WasLost} && !$circ->ok ) {
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
            log("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
            log("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
            log("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
        log( "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
                log("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
            log("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
        log("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
        log("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(log);
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
        log("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
    log( "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
        log("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 (-4 / +4 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(log);
16
use Data::Dumper;
16
use Data::Dumper;
17
17
18
use C4::SIP::Sip qw(add_field);
18
use C4::SIP::Sip qw(add_field);
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
        log("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
    log("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 404-410 sub enable { Link Here
404
    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
404
    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
405
        $self->{$field} = 1;
405
        $self->{$field} = 1;
406
    }
406
    }
407
    syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
407
    log("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
408
       $self->{id}, $self->{charge_ok}, $self->{renew_ok},
408
       $self->{id}, $self->{charge_ok}, $self->{renew_ok},
409
       $self->{recall_ok}, $self->{hold_ok});
409
       $self->{recall_ok}, $self->{hold_ok});
410
    $self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored.";   # TODO: not really affecting patron record
410
    $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(log);
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
	log('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
                log('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(log);
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
            log(
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 (-8 / +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
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(log);
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
		log("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
		log("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
    log('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
            log("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
    log("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
        log("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
    log("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
		log("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
		log("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
		log("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
		log("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
    log("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
		log("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
		log("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
		log("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
		log("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
		log("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
    log("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
    log("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
            log( '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
                log( "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
                log(
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
          log( '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
          log( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
379
      }
379
      }
380
380
381
      syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" );
381
      log( '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
            log( "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 log);
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 log)]);
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
	log("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
72
	       $field_id);
72
	       $field_id);
73
		$value = '';
73
		$value = '';
74
    }
74
    }
Lines 128-134 sub add_count { Link Here
128
128
129
    $count = sprintf("%04d", $count);
129
    $count = sprintf("%04d", $count);
130
    if (length($count) != 4) {
130
    if (length($count) != 4) {
131
		syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
131
		log("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
132
	       $label, $count);
132
	       $label, $count);
133
		$count = ' ' x 4;
133
		$count = ' ' x 4;
134
    }
134
    }
Lines 199-211 sub write_msg { Link Here
199
    } else {
199
    } else {
200
        STDOUT->autoflush(1);
200
        STDOUT->autoflush(1);
201
        print $msg, $terminator;
201
        print $msg, $terminator;
202
        syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
202
        log("LOG_INFO", "OUTPUT MSG: '$msg'");
203
    }
203
    }
204
204
205
    $last_response = $msg;
205
    $last_response = $msg;
206
}
206
}
207
207
208
sub syslog {
208
sub log {
209
    my ( $level, $mask, @args ) = @_;
209
    my ( $level, $mask, @args ) = @_;
210
210
211
    my $method =
211
    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(log);
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
        log( "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
    log( "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
        log( "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
        log( "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
    log( "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
            log( "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
            log( "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
            log( "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
        log( "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
        log( "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 520-526 sub handle_checkout { Link Here
520
520
521
        # Off-line transactions need to be recorded, but there's
521
        # Off-line transactions need to be recorded, but there's
522
        # not a lot we can do about it
522
        # not a lot we can do about it
523
        syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
523
        log( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
524
524
525
        $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
525
        $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
526
    } else {
526
    } else {
Lines 647-653 sub handle_checkin { Link Here
647
    if ( $no_block eq 'Y' ) {
647
    if ( $no_block eq 'Y' ) {
648
648
649
        # Off-line transactions, ick.
649
        # Off-line transactions, ick.
650
        syslog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
650
        log( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
651
        $status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
651
        $status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
652
    } else {
652
    } else {
653
        $status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );
653
        $status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok}, $account->{cv_triggers_alert} );
Lines 766-784 sub handle_sc_status { Link Here
766
    } elsif ( $sc_protocol_version =~ /^2\./ ) {
766
    } elsif ( $sc_protocol_version =~ /^2\./ ) {
767
        $new_proto = 2;
767
        $new_proto = 2;
768
    } else {
768
    } else {
769
        syslog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
769
        log( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
770
        $new_proto = 1;
770
        $new_proto = 1;
771
    }
771
    }
772
772
773
    if ( $new_proto != $protocol_version ) {
773
    if ( $new_proto != $protocol_version ) {
774
        syslog( "LOG_INFO", "Setting protocol level to $new_proto" );
774
        log( "LOG_INFO", "Setting protocol level to $new_proto" );
775
        $protocol_version = $new_proto;
775
        $protocol_version = $new_proto;
776
    }
776
    }
777
777
778
    if ( $status == SC_STATUS_PAPER ) {
778
    if ( $status == SC_STATUS_PAPER ) {
779
        syslog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
779
        log( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
780
    } elsif ( $status == SC_STATUS_SHUTDOWN ) {
780
    } elsif ( $status == SC_STATUS_SHUTDOWN ) {
781
        syslog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
781
        log( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
782
    }
782
    }
783
783
784
    $self->{account}->{print_width} = $print_width;
784
    $self->{account}->{print_width} = $print_width;
Lines 818-827 sub login_core { Link Here
818
    my $pwd    = shift;
818
    my $pwd    = shift;
819
    my $status = 1;                 # Assume it all works
819
    my $status = 1;                 # Assume it all works
820
    if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
820
    if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
821
        syslog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
821
        log( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
822
        $status = 0;
822
        $status = 0;
823
    } elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
823
    } elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
824
        syslog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
824
        log( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
825
        $status = 0;
825
        $status = 0;
826
    } else {
826
    } else {
827
827
Lines 835-850 sub login_core { Link Here
835
835
836
        my $auth_status = api_auth( $uid, $pwd, $inst );
836
        my $auth_status = api_auth( $uid, $pwd, $inst );
837
        if ( !$auth_status or $auth_status !~ /^ok$/i ) {
837
        if ( !$auth_status or $auth_status !~ /^ok$/i ) {
838
            syslog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status || 'unknown' ) );
838
            log( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status || 'unknown' ) );
839
            $status = 0;
839
            $status = 0;
840
        } else {
840
        } else {
841
            syslog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
841
            log( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
842
842
843
            #
843
            #
844
            # initialize connection to ILS
844
            # initialize connection to ILS
845
            #
845
            #
846
            my $module = $server->{config}->{institutions}->{$inst}->{implementation};
846
            my $module = $server->{config}->{institutions}->{$inst}->{implementation};
847
            syslog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );
847
            log( "LOG_DEBUG", 'login_core: ' . Dumper($module) );
848
848
849
            # Suspect this is always ILS but so we don't break any eccentic install (for now)
849
            # Suspect this is always ILS but so we don't break any eccentic install (for now)
850
            if ( $module eq 'ILS' ) {
850
            if ( $module eq 'ILS' ) {
Lines 852-865 sub login_core { Link Here
852
            }
852
            }
853
            $module->use;
853
            $module->use;
854
            if ($@) {
854
            if ($@) {
855
                syslog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
855
                log( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
856
                die("Failed to load ILS implementation '$module' for $inst");
856
                die("Failed to load ILS implementation '$module' for $inst");
857
            }
857
            }
858
858
859
            # like   ILS->new(), I think.
859
            # like   ILS->new(), I think.
860
            $server->{ils} = $module->new( $server->{institution}, $server->{account} );
860
            $server->{ils} = $module->new( $server->{institution}, $server->{account} );
861
            if ( !$server->{ils} ) {
861
            if ( !$server->{ils} ) {
862
                syslog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
862
                log( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
863
                die("Unable to connect to ILS '$inst'");
863
                die("Unable to connect to ILS '$inst'");
864
            }
864
            }
865
        }
865
        }
Lines 882-888 sub handle_login { Link Here
882
    $pwd = $fields->{ (FID_LOGIN_PWD) };    # Terminal PWD, not patron PWD.
882
    $pwd = $fields->{ (FID_LOGIN_PWD) };    # Terminal PWD, not patron PWD.
883
883
884
    if ( $uid_algorithm || $pwd_algorithm ) {
884
    if ( $uid_algorithm || $pwd_algorithm ) {
885
        syslog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
885
        log( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
886
        $status = 0;
886
        $status = 0;
887
    } else {
887
    } else {
888
        $status = login_core( $server, $uid, $pwd );
888
        $status = login_core( $server, $uid, $pwd );
Lines 921-933 sub summary_info { Link Here
921
        return '';    # No detailed information required
921
        return '';    # No detailed information required
922
    }
922
    }
923
923
924
    syslog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );
924
    log( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );
925
925
926
    my $func     = $summary_map[$summary_type]->{func};
926
    my $func     = $summary_map[$summary_type]->{func};
927
    my $fid      = $summary_map[$summary_type]->{fid};
927
    my $fid      = $summary_map[$summary_type]->{fid};
928
    my $itemlist = &$func( $patron, $start, $end, $server );
928
    my $itemlist = &$func( $patron, $start, $end, $server );
929
929
930
    syslog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );
930
    log( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", map{ $_->{barcode} } @{$itemlist} ) );
931
    foreach my $i ( @{$itemlist} ) {
931
    foreach my $i ( @{$itemlist} ) {
932
        $resp .= add_field( $fid, $i->{barcode}, $server );
932
        $resp .= add_field( $fid, $i->{barcode}, $server );
933
    }
933
    }
Lines 1245-1251 sub handle_item_status_update { Link Here
1245
    $item_props = $fields->{ (FID_ITEM_PROPS) };
1245
    $item_props = $fields->{ (FID_ITEM_PROPS) };
1246
1246
1247
    if ( !defined($item_id) ) {
1247
    if ( !defined($item_id) ) {
1248
        syslog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1248
        log( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1249
    } else {
1249
    } else {
1250
        $item = $ils->find_item($item_id);
1250
        $item = $ils->find_item($item_id);
1251
    }
1251
    }
Lines 1290-1296 sub handle_patron_enable { Link Here
1290
    $patron_id  = $fields->{ (FID_PATRON_ID) };
1290
    $patron_id  = $fields->{ (FID_PATRON_ID) };
1291
    $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1291
    $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1292
1292
1293
    syslog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1293
    log( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1294
1294
1295
    $patron = $ils->find_patron($patron_id);
1295
    $patron = $ils->find_patron($patron_id);
1296
1296
Lines 1360-1366 sub handle_hold { Link Here
1360
    } elsif ( $hold_mode eq '*' ) {
1360
    } elsif ( $hold_mode eq '*' ) {
1361
        $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1361
        $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1362
    } else {
1362
    } else {
1363
        syslog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1363
        log( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1364
        $status = $ils->Transaction::Hold;    # new?
1364
        $status = $ils->Transaction::Hold;    # new?
1365
        $status->screen_msg("System error. Please contact library staff.");
1365
        $status->screen_msg("System error. Please contact library staff.");
1366
    }
1366
    }
Lines 1408-1414 sub handle_renew { Link Here
1408
    $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1408
    $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1409
1409
1410
    if ( $no_block eq 'Y' ) {
1410
    if ( $no_block eq 'Y' ) {
1411
        syslog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1411
        log( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1412
    }
1412
    }
1413
1413
1414
    $patron_id  = $fields->{ (FID_PATRON_ID) };
1414
    $patron_id  = $fields->{ (FID_PATRON_ID) };
Lines 1575-1581 sub send_acs_status { Link Here
1575
    $retries            = sprintf( "%03d", $policy->{retries} );
1575
    $retries            = sprintf( "%03d", $policy->{retries} );
1576
1576
1577
    if ( length($retries) != 3 ) {
1577
    if ( length($retries) != 3 ) {
1578
        syslog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1578
        log( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1579
        $retries = '000';
1579
        $retries = '000';
1580
    }
1580
    }
1581
1581
Lines 1588-1594 sub send_acs_status { Link Here
1588
    } elsif ( $protocol_version == 2 ) {
1588
    } elsif ( $protocol_version == 2 ) {
1589
        $msg .= '2.00';
1589
        $msg .= '2.00';
1590
    } else {
1590
    } else {
1591
        syslog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1591
        log( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1592
        $msg .= '1.00';
1592
        $msg .= '1.00';
1593
    }
1593
    }
1594
1594
Lines 1608-1614 sub send_acs_status { Link Here
1608
            }
1608
            }
1609
        }
1609
        }
1610
        if ( length($supported_msgs) < 16 ) {
1610
        if ( length($supported_msgs) < 16 ) {
1611
            syslog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1611
            log( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1612
        }
1612
        }
1613
        $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1613
        $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1614
    }
1614
    }
Lines 1618-1624 sub send_acs_status { Link Here
1618
    if (   defined( $account->{print_width} )
1618
    if (   defined( $account->{print_width} )
1619
        && defined($print_line)
1619
        && defined($print_line)
1620
        && $account->{print_width} < length($print_line) ) {
1620
        && $account->{print_width} < length($print_line) ) {
1621
        syslog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1621
        log( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1622
        $print_line = substr( $print_line, 0, $account->{print_width} );
1622
        $print_line = substr( $print_line, 0, $account->{print_width} );
1623
    }
1623
    }
1624
1624
Lines 1638-1644 sub patron_status_string { Link Here
1638
    my $patron = shift;
1638
    my $patron = shift;
1639
    my $patron_status;
1639
    my $patron_status;
1640
1640
1641
    syslog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1641
    log( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1642
    $patron_status = sprintf(
1642
    $patron_status = sprintf(
1643
        '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1643
        '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1644
        denied( $patron->charge_ok ),
1644
        denied( $patron->charge_ok ),
1645
- 

Return to bug 15253