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

(-)a/C4/SIP/ILS.pm (-27 / +42 lines)
Lines 43-67 my %supports = ( Link Here
43
);
43
);
44
44
45
sub new {
45
sub new {
46
    my ($class, $institution) = @_;
46
    my ($class, $institution, $account, $server) = @_;
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
    $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS $institution->{id}");
50
    syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
51
    syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id});
51
    $self->{institution} = $institution;
52
    $self->{institution} = $institution;
53
    $self->{server} = $server;
52
    return bless $self, $type;
54
    return bless $self, $type;
53
}
55
}
54
56
55
sub find_patron {
57
sub find_patron {
56
    my $self = shift;
58
    my $self = shift;
57
 	$debug and warn "ILS: finding patron";
59
 	$debug and warn "ILS: finding patron";
58
    return C4::SIP::ILS::Patron->new(@_);
60
    return C4::SIP::ILS::Patron->new( @_, $self->{server} );
59
}
61
}
60
62
61
sub find_item {
63
sub find_item {
62
    my $self = shift;
64
    my $self = shift;
63
	$debug and warn "ILS: finding item";
65
	$debug and warn "ILS: finding item";
64
    return C4::SIP::ILS::Item->new(@_);
66
    return C4::SIP::ILS::Item->new(@_, $self->{server});
65
}
67
}
66
68
67
sub institution {
69
sub institution {
Lines 82-87 sub supports { Link Here
82
sub check_inst_id {
84
sub check_inst_id {
83
    my ($self, $id, $whence) = @_;
85
    my ($self, $id, $whence) = @_;
84
    if ($id ne $self->{institution}->{id}) {
86
    if ($id ne $self->{institution}->{id}) {
87
        $self->{server}->{logger}->warn("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: $whence: received institution '$id', expected '$self->{institution}->{id}'");
85
        syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
88
        syslog("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
89
        # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
87
    }
90
    }
Lines 129-138 sub checkout { Link Here
129
    my ($self, $patron_id, $item_id, $sc_renew, $fee_ack) = @_;
132
    my ($self, $patron_id, $item_id, $sc_renew, $fee_ack) = @_;
130
    my ($patron, $item, $circ);
133
    my ($patron, $item, $circ);
131
134
132
    $circ = C4::SIP::ILS::Transaction::Checkout->new();
135
    $circ = C4::SIP::ILS::Transaction::Checkout->new( $self->{server} );
133
    # BEGIN TRANSACTION
136
    # BEGIN TRANSACTION
134
    $circ->patron($patron = C4::SIP::ILS::Patron->new( $patron_id));
137
    $circ->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) );
135
    $circ->item($item = C4::SIP::ILS::Item->new( $item_id));
138
    $circ->item( $item = C4::SIP::ILS::Item->new( $item_id, $self->{server} ) );
136
    if ($fee_ack) {
139
    if ($fee_ack) {
137
        $circ->fee_ack($fee_ack);
140
        $circ->fee_ack($fee_ack);
138
    }
141
    }
Lines 162-171 sub checkout { Link Here
162
			push(@{$patron->{items}}, $item_id);
165
			push(@{$patron->{items}}, $item_id);
163
			$circ->desensitize(!$item->magnetic_media);
166
			$circ->desensitize(!$item->magnetic_media);
164
167
168
      $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::Checkout: patron $patron_id has checked out " . join(', ', @{$patron->{items}}) );
165
			syslog("LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
169
			syslog("LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s",
166
				$patron_id, join(', ', @{$patron->{items}}));
170
				$patron_id, join(', ', @{$patron->{items}}));
167
		}
171
		}
168
		else {
172
		else {
173
        $self->{server}->{logger}->error("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::Checkout Issue failed");
169
			syslog("LOG_ERR", "ILS::Checkout Issue failed");
174
			syslog("LOG_ERR", "ILS::Checkout Issue failed");
170
		}
175
		}
171
    }
176
    }
Lines 181-187 sub checkin { Link Here
181
    $circ = C4::SIP::ILS::Transaction::Checkin->new();
186
    $circ = C4::SIP::ILS::Transaction::Checkin->new();
182
187
183
    # BEGIN TRANSACTION
188
    # BEGIN TRANSACTION
184
    $circ->item( $item = C4::SIP::ILS::Item->new($item_id) );
189
    $circ->item( $item = C4::SIP::ILS::Item->new( $item_id, $self->{server} ) );
185
190
186
    if ($item) {
191
    if ($item) {
187
        $circ->do_checkin( $current_loc, $return_date );
192
        $circ->do_checkin( $current_loc, $return_date );
Lines 195-215 sub checkin { Link Here
195
    # It's ok to check it in if it exists, and if it was checked out
200
    # It's ok to check it in if it exists, and if it was checked out
196
    # or it was not checked out but the checked_in_ok flag was set
201
    # or it was not checked out but the checked_in_ok flag was set
197
    $circ->ok( ( $checked_in_ok && $item ) || ( $item && $item->{patron} ) );
202
    $circ->ok( ( $checked_in_ok && $item ) || ( $item && $item->{patron} ) );
203
    $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: C4::SIP::ILS::checkin - using checked_in_ok") if $checked_in_ok;
198
    syslog("LOG_DEBUG", "C4::SIP::ILS::checkin - using checked_in_ok") if $checked_in_ok;
204
    syslog("LOG_DEBUG", "C4::SIP::ILS::checkin - using checked_in_ok") if $checked_in_ok;
199
205
200
    if ( !defined( $item->{patron} ) ) {
206
    if ( !defined( $item->{patron} ) ) {
201
        $circ->screen_msg("Item not checked out") unless $checked_in_ok;
207
        $circ->screen_msg("Item not checked out") unless $checked_in_ok;
202
	syslog("LOG_DEBUG", "C4::SIP::ILS::checkin - item not checked out");
208
        $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: C4::SIP::ILS::checkin - item not checked out");
209
        syslog("LOG_DEBUG", "C4::SIP::ILS::checkin - item not checked out");
203
    }
210
    }
204
    else {
211
    else {
205
        if ( $circ->ok ) {
212
        if ( $circ->ok ) {
206
            $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron} ) );
213
            $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron}, $self->{server} ) );
207
            delete $item->{patron};
214
            delete $item->{patron};
208
            delete $item->{due_date};
215
            delete $item->{due_date};
209
            $patron->{items} = [ grep { $_ ne $item_id } @{ $patron->{items} } ];
216
            $patron->{items} = [ grep { $_ ne $item_id } @{ $patron->{items} } ];
210
        }
217
        }
211
    }
218
    }
212
213
    # END TRANSACTION
219
    # END TRANSACTION
214
220
215
    return $circ;
221
    return $circ;
Lines 234-240 sub pay_fee { Link Here
234
240
235
    $trans->transaction_id($trans_id);
241
    $trans->transaction_id($trans_id);
236
    my $patron;
242
    my $patron;
237
    $trans->patron($patron = C4::SIP::ILS::Patron->new($patron_id));
243
    $trans->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) );
238
    if (!$patron) {
244
    if (!$patron) {
239
        $trans->screen_msg('Invalid patron barcode.');
245
        $trans->screen_msg('Invalid patron barcode.');
240
        return $trans;
246
        return $trans;
Lines 252-268 sub add_hold { Link Here
252
258
253
	my $trans = C4::SIP::ILS::Transaction::Hold->new();
259
	my $trans = C4::SIP::ILS::Transaction::Hold->new();
254
260
255
    $patron = C4::SIP::ILS::Patron->new( $patron_id);
261
    $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} );
256
    if (!$patron
262
    if (!$patron
257
	|| (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
263
	|| (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
258
		$trans->screen_msg("Invalid Patron.");
264
		$trans->screen_msg("Invalid Patron.");
259
		return $trans;
265
		return $trans;
260
    }
266
    }
261
267
262
	unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
268
    my $id = $item_id || $title_id;
263
		$trans->screen_msg("No such item.");
269
    unless ($item = C4::SIP::ILS::Item->new( $id, $self->{server} ) ) {
264
		return $trans;
270
        $trans->screen_msg("No such item.");
265
	}
271
        return $trans;
272
    }
266
273
267
    if ( $patron->holds_blocked_by_excessive_fees() ) {
274
    if ( $patron->holds_blocked_by_excessive_fees() ) {
268
        $trans->screen_msg("Excessive fees blocking placement of hold.");
275
        $trans->screen_msg("Excessive fees blocking placement of hold.");
Lines 299-305 sub cancel_hold { Link Here
299
306
300
	my $trans = C4::SIP::ILS::Transaction::Hold->new();
307
	my $trans = C4::SIP::ILS::Transaction::Hold->new();
301
308
302
    $patron = C4::SIP::ILS::Patron->new( $patron_id );
309
    $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} );
303
    if (!$patron) {
310
    if (!$patron) {
304
		$trans->screen_msg("Invalid patron barcode.");
311
		$trans->screen_msg("Invalid patron barcode.");
305
		return $trans;
312
		return $trans;
Lines 308-316 sub cancel_hold { Link Here
308
		return $trans;
315
		return $trans;
309
    }
316
    }
310
317
311
    unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) {
318
    my $id = $item_id || $title_id;
312
		$trans->screen_msg("No such item.");
319
    unless ( $item = C4::SIP::ILS::Item->new( $id, $self->{server} ) ) {
313
		return $trans;
320
        $trans->screen_msg("No such item.");
321
        return $trans;
314
    }
322
    }
315
323
316
    $trans->patron($patron);
324
    $trans->patron($patron);
Lines 358-364 sub alter_hold { Link Here
358
    $trans = C4::SIP::ILS::Transaction::Hold->new();
366
    $trans = C4::SIP::ILS::Transaction::Hold->new();
359
367
360
    # BEGIN TRANSACTION
368
    # BEGIN TRANSACTION
361
    $patron = C4::SIP::ILS::Patron->new( $patron_id );
369
    $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} );
362
    unless ($patron) {
370
    unless ($patron) {
363
		$trans->screen_msg("Invalid patron barcode: '$patron_id'.");
371
		$trans->screen_msg("Invalid patron barcode: '$patron_id'.");
364
		return $trans;
372
		return $trans;
Lines 376-382 sub alter_hold { Link Here
376
	    # $trans->ok(1);
384
	    # $trans->ok(1);
377
	    $trans->screen_msg("Hold updated.");
385
	    $trans->screen_msg("Hold updated.");
378
	    $trans->patron($patron);
386
	    $trans->patron($patron);
379
	    $trans->item(C4::SIP::ILS::Item->new( $hold->{item_id}));
387
    $trans->item( C4::SIP::ILS::Item->new( $hold->{item_id}, $self->{server} ) );
380
	    last;
388
	    last;
381
	}
389
	}
382
    }
390
    }
Lines 401-407 sub renew { Link Here
401
    my $trans;
409
    my $trans;
402
410
403
    $trans = C4::SIP::ILS::Transaction::Renew->new();
411
    $trans = C4::SIP::ILS::Transaction::Renew->new();
404
    $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
412
    $trans->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) );
405
413
406
    if (!$patron) {
414
    if (!$patron) {
407
		$trans->screen_msg("Invalid patron barcode.");
415
		$trans->screen_msg("Invalid patron barcode.");
Lines 425-437 sub renew { Link Here
425
		my $count = scalar @{$patron->{items}};
433
		my $count = scalar @{$patron->{items}};
426
		foreach my $i (@{$patron->{items}}) {
434
		foreach my $i (@{$patron->{items}}) {
427
            unless (defined $i->{barcode}) {    # FIXME: using data instead of objects may violate the abstraction layer
435
            unless (defined $i->{barcode}) {    # FIXME: using data instead of objects may violate the abstraction layer
436
                $self->{server}->{logger}->error("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: No barcode for item " . $j+1 . " of $count: $item_id");
428
                syslog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
437
                syslog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count);
429
                next;
438
                next;
430
            }
439
            }
440
            $self->{server}->{logger}->debug( "$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: "
441
                  . "checking item "
442
                  . $j + 1
443
                  . " of $count: $item_id vs. $i->{barcode} " );
431
            syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
444
            syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode});
432
            if ($i->{barcode} eq $item_id) {
445
            if ($i->{barcode} eq $item_id) {
433
				# We have it checked out
446
				# We have it checked out
434
				$item = C4::SIP::ILS::Item->new( $item_id );
447
                $item = C4::SIP::ILS::Item->new( $item_id, $self->{server} );
435
				last;
448
				last;
436
			}
449
			}
437
		}
450
		}
Lines 458-469 sub renew_all { Link Here
458
    my ($patron, $item_id);
471
    my ($patron, $item_id);
459
    my $trans;
472
    my $trans;
460
473
461
    $trans = C4::SIP::ILS::Transaction::RenewAll->new();
474
    $trans = C4::SIP::ILS::Transaction::RenewAll->new( $self->{server} );
462
475
463
    $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id ));
476
    $trans->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) );
464
    if (defined $patron) {
477
    if (defined $patron) {
478
        $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::renew_all: patron '$patron->name': renew_ok: $patron->renew_ok");
465
        syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
479
        syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok);
466
    } else {
480
    } else {
481
        $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::renew_all: Invalid patron id: '$patron_id'");
467
        syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
482
        syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id);
468
    }
483
    }
469
484
(-)a/C4/SIP/ILS/Item.pm (-1 / +5 lines)
Lines 73-84 sub priority_sort { Link Here
73
}
73
}
74
74
75
sub new {
75
sub new {
76
	my ($class, $item_id) = @_;
76
    my ( $class, $item_id, $server ) = @_;
77
	my $type = ref($class) || $class;
77
	my $type = ref($class) || $class;
78
	my $self;
78
	my $self;
79
    my $itemnumber = GetItemnumberFromBarcode($item_id);
79
    my $itemnumber = GetItemnumberFromBarcode($item_id);
80
	my $item = GetBiblioFromItemNumber($itemnumber);    # actually biblio.*, biblioitems.* AND items.*  (overkill)
80
	my $item = GetBiblioFromItemNumber($itemnumber);    # actually biblio.*, biblioitems.* AND items.*  (overkill)
81
	if (! $item) {
81
	if (! $item) {
82
        $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS::Item('$item_id'): not found");
82
		syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
83
		syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
83
		warn "new ILS::Item($item_id) : No item '$item_id'.";
84
		warn "new ILS::Item($item_id) : No item '$item_id'.";
84
        return;
85
        return;
Lines 105-112 sub new { Link Here
105
	$item->{hold_shelf}    = [( grep {   defined $_->{found}  and $_->{found} eq 'W' } @{$item->{hold_queue}} )];
106
	$item->{hold_shelf}    = [( grep {   defined $_->{found}  and $_->{found} eq 'W' } @{$item->{hold_queue}} )];
106
	$item->{pending_queue} = [( grep {(! defined $_->{found}) or  $_->{found} ne 'W' } @{$item->{hold_queue}} )];
107
	$item->{pending_queue} = [( grep {(! defined $_->{found}) or  $_->{found} ne 'W' } @{$item->{hold_queue}} )];
107
	$self = $item;
108
	$self = $item;
109
  $self->{server} = $server;
108
	bless $self, $type;
110
	bless $self, $type;
109
111
112
    $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS::Item('$item_id'): found with title '$self->{title}'");
110
    syslog("LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
113
    syslog("LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'",
111
	   $item_id, $self->{title});
114
	   $item_id, $self->{title});
112
115
Lines 170-175 sub hold_patron_name { Link Here
170
    my $borrowernumber = (@_ ? shift: $self->hold_patron_id()) or return;
173
    my $borrowernumber = (@_ ? shift: $self->hold_patron_id()) or return;
171
    my $holder = GetMember(borrowernumber=>$borrowernumber);
174
    my $holder = GetMember(borrowernumber=>$borrowernumber);
172
    unless ($holder) {
175
    unless ($holder) {
176
        $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: While checking hold, GetMember failed for borrowernumber '$borrowernumber'");
173
        syslog("LOG_ERR", "While checking hold, GetMember failed for borrowernumber '$borrowernumber'");
177
        syslog("LOG_ERR", "While checking hold, GetMember failed for borrowernumber '$borrowernumber'");
174
        return;
178
        return;
175
    }
179
    }
(-)a/C4/SIP/ILS/Patron.pm (-1 / +8 lines)
Lines 29-40 our $VERSION = 3.07.00.049; Link Here
29
our $kp;    # koha patron
29
our $kp;    # koha patron
30
30
31
sub new {
31
sub new {
32
    my ($class, $patron_id) = @_;
32
    my ($class, $patron_id, $server) = @_;
33
    my $type = ref($class) || $class;
33
    my $type = ref($class) || $class;
34
    my $self;
34
    my $self;
35
35
    $kp = GetMember(cardnumber=>$patron_id) || GetMember(userid=>$patron_id);
36
    $kp = GetMember(cardnumber=>$patron_id) || GetMember(userid=>$patron_id);
36
    $debug and warn "new Patron (GetMember): " . Dumper($kp);
37
    $debug and warn "new Patron (GetMember): " . Dumper($kp);
37
    unless (defined $kp) {
38
    unless (defined $kp) {
39
        $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS::Patron($patron_id): no such patron");
38
        syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
40
        syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
39
        return;
41
        return;
40
    }
42
    }
Lines 121-127 sub new { Link Here
121
    $ilspatron{unavail_holds} = _get_outstanding_holds($kp->{borrowernumber});
123
    $ilspatron{unavail_holds} = _get_outstanding_holds($kp->{borrowernumber});
122
    $ilspatron{items} = GetPendingIssues($kp->{borrowernumber});
124
    $ilspatron{items} = GetPendingIssues($kp->{borrowernumber});
123
    $self = \%ilspatron;
125
    $self = \%ilspatron;
126
    $self->{server} = $server;
124
    $debug and warn Dumper($self);
127
    $debug and warn Dumper($self);
128
    $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: new ILS::Patron($patron_id): found patron '$self->{id}'");
125
    syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
129
    syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
126
    bless $self, $type;
130
    bless $self, $type;
127
    return $self;
131
    return $self;
Lines 322-327 sub enable { Link Here
322
    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
326
    foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
323
        $self->{$field} = 1;
327
        $self->{$field} = 1;
324
    }
328
    }
329
    $self->{server}->{logger}->debug( "$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: "
330
          . "Patron($self->{id})->enable: charge: $self->{charge_ok}, "
331
          . "renew:$self->{renew_ok}, recall:$self->{recall_ok}, hold:$self->{hold_ok}" );
325
    syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
332
    syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s",
326
       $self->{id}, $self->{charge_ok}, $self->{renew_ok},
333
       $self->{id}, $self->{charge_ok}, $self->{renew_ok},
327
       $self->{recall_ok}, $self->{hold_ok});
334
       $self->{recall_ok}, $self->{hold_ok});
(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-2 / +4 lines)
Lines 35-42 my %fields = ( Link Here
35
	);
35
	);
36
36
37
sub new {
37
sub new {
38
    my $class = shift;;
38
    my ( $class, $server ) = @_;
39
    my $self = $class->SUPER::new();
39
    my $self = $class->SUPER::new();
40
    $self->{server} = $server;
40
    foreach my $element (keys %fields) {
41
    foreach my $element (keys %fields) {
41
		$self->{_permitted}->{$element} = $fields{$element};
42
		$self->{_permitted}->{$element} = $fields{$element};
42
    }
43
    }
Lines 48-53 sub new { Link Here
48
49
49
sub do_checkout {
50
sub do_checkout {
50
	my $self = shift;
51
	my $self = shift;
52
    $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::Transaction::Checkout performing checkout...");
51
	syslog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
53
	syslog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
52
	my $pending        = $self->{item}->pending_queue;
54
	my $pending        = $self->{item}->pending_queue;
53
	my $shelf          = $self->{item}->hold_shelf;
55
	my $shelf          = $self->{item}->hold_shelf;
Lines 99-105 sub do_checkout { Link Here
99
            } else {
101
            } else {
100
                $self->screen_msg($needsconfirmation->{$confirmation});
102
                $self->screen_msg($needsconfirmation->{$confirmation});
101
                $noerror = 0;
103
                $noerror = 0;
102
                syslog('LOG_DEBUG', "Blocking checkout Reason:$confirmation");
104
                $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: Blocking checkout Reason:$confirmation");
103
            }
105
            }
104
        }
106
        }
105
    }
107
    }
(-)a/C4/SIP/ILS/Transaction/RenewAll.pm (-1 / +4 lines)
Lines 7-13 use strict; Link Here
7
use warnings;
7
use warnings;
8
8
9
use Sys::Syslog qw(syslog);
9
use Sys::Syslog qw(syslog);
10
11
use C4::SIP::ILS::Item;
10
use C4::SIP::ILS::Item;
12
11
13
use C4::Members qw( GetMember );
12
use C4::Members qw( GetMember );
Lines 21-26 my %fields = ( Link Here
21
20
22
sub new {
21
sub new {
23
    my $class = shift;
22
    my $class = shift;
23
    my $server = shift;
24
    my $self  = $class->SUPER::new();
24
    my $self  = $class->SUPER::new();
25
25
26
    foreach my $element ( keys %fields ) {
26
    foreach my $element ( keys %fields ) {
Lines 28-33 sub new { Link Here
28
    }
28
    }
29
29
30
    @{$self}{ keys %fields } = values %fields;
30
    @{$self}{ keys %fields } = values %fields;
31
32
    $self->{server} = $server;
31
    return bless $self, $class;
33
    return bless $self, $class;
32
}
34
}
33
35
Lines 42-47 sub do_renew_all { Link Here
42
        my $item_id = $itemx->{barcode};
44
        my $item_id = $itemx->{barcode};
43
        my $item    = C4::SIP::ILS::Item->new($item_id);
45
        my $item    = C4::SIP::ILS::Item->new($item_id);
44
        if ( !defined($item) ) {
46
        if ( !defined($item) ) {
47
            $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: renew_all: Invalid item id '$item_id' associated with patron '$patron->id'");
45
            syslog(
48
            syslog(
46
                'LOG_WARNING',
49
                'LOG_WARNING',
47
                q|renew_all: Invalid item id '%s' associated with patron '%s'|,
50
                q|renew_all: Invalid item id '%s' associated with patron '%s'|,
(-)a/C4/SIP/SIPServer.pm (-41 / +82 lines)
Lines 6-11 use warnings; Link Here
6
use FindBin qw($Bin);
6
use FindBin qw($Bin);
7
use lib "$Bin";
7
use lib "$Bin";
8
use Sys::Syslog qw(syslog);
8
use Sys::Syslog qw(syslog);
9
use Koha::Logger;
9
use Net::Server::PreFork;
10
use Net::Server::PreFork;
10
use IO::Socket::INET;
11
use IO::Socket::INET;
11
use Socket qw(:DEFAULT :crlf);
12
use Socket qw(:DEFAULT :crlf);
Lines 17-22 use C4::SIP::Sip::Checksum qw(checksum verify_cksum); Link Here
17
use C4::SIP::Sip::MsgType qw( handle login_core );
18
use C4::SIP::Sip::MsgType qw( handle login_core );
18
use C4::SIP::Sip qw( read_SIP_packet );
19
use C4::SIP::Sip qw( read_SIP_packet );
19
20
21
use Koha::Logger;
22
20
use base qw(Net::Server::PreFork);
23
use base qw(Net::Server::PreFork);
21
24
22
use constant LOG_SIP => "local6"; # Local alias for the logging facility
25
use constant LOG_SIP => "local6"; # Local alias for the logging facility
Lines 88-93 sub process_request { Link Here
88
91
89
    $self->{config} = $config;
92
    $self->{config} = $config;
90
93
94
    $self->{logger} = Koha::Logger->get({ interface => 'sip' });
95
    $self->{account} = undef; # Clear out the account from the last request, it may be different
96
91
    my $sockname = getsockname(STDIN);
97
    my $sockname = getsockname(STDIN);
92
98
93
    # Check if socket connection is IPv6 before resolving address
99
    # Check if socket connection is IPv6 before resolving address
Lines 104-109 sub process_request { Link Here
104
    $self->{service} = $config->find_service($sockaddr, $port, $proto);
110
    $self->{service} = $config->find_service($sockaddr, $port, $proto);
105
111
106
    if (!defined($self->{service})) {
112
    if (!defined($self->{service})) {
113
                $self->{logger}->error("$self->{server}->{peeraddr}: process_request: Unknown recognized server connection: $sockaddr:$port/$proto");
107
		syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
114
		syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
108
		die "process_request: Bad server connection";
115
		die "process_request: Bad server connection";
109
    }
116
    }
Lines 111-116 sub process_request { Link Here
111
    $transport = $transports{$self->{service}->{transport}};
118
    $transport = $transports{$self->{service}->{transport}};
112
119
113
    if (!defined($transport)) {
120
    if (!defined($transport)) {
121
        $self->{logger}->warn("$self->{server}->{peeraddr}: Unknown transport '$service->{transport}', dropping");
114
		syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
122
		syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
115
		return;
123
		return;
116
    } else {
124
    } else {
Lines 129-138 sub raw_transport { Link Here
129
137
130
    while (!$self->{account}) {
138
    while (!$self->{account}) {
131
    local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
139
    local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
140
141
    $self->{logger}->debug("$self->{server}->{peeraddr}: raw_transport: timeout is $service->{timeout}");
132
    syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
142
    syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
143
144
    $C4::SIP::Sip::server = $self;
133
    $input = read_SIP_packet(*STDIN);
145
    $input = read_SIP_packet(*STDIN);
134
    if (!$input) {
146
    if (!$input) {
135
        # EOF on the socket
147
        # EOF on the socket
148
        $self->{logger}->info("$self->{server}->{peeraddr}: raw_transport: shutting down: EOF during login");
136
        syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
149
        syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
137
        return;
150
        return;
138
    }
151
    }
Lines 140-175 sub raw_transport { Link Here
140
    last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
153
    last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
141
    }
154
    }
142
155
143
    syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
156
    $self->{logger} = Koha::Logger->get( { interface => 'sip', category => $self->{account}->{id} } ); # Add id to namespace
144
	   $self->{account}->{id},
157
    $self->{logger}->debug("$self->{server}->{peeraddr}:$self->{account}->{id}: raw_transport: uname/inst: '$self->{account}->{id}/$self->{account}->{institution}'");
145
	   $self->{account}->{institution});
158
    syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", $self->{account}->{id}, $self->{account}->{institution});
146
159
147
    $self->sip_protocol_loop();
160
    $self->sip_protocol_loop();
161
162
    $self->{logger}->info("$self->{server}->{peeraddr}:$self->{account}->{id}: raw_transport: shutting down");
148
    syslog("LOG_INFO", "raw_transport: shutting down");
163
    syslog("LOG_INFO", "raw_transport: shutting down");
149
}
164
}
150
165
151
sub get_clean_string {
166
sub get_clean_string {
152
	my $string = shift;
167
    my $self = shift;
153
	if (defined $string) {
168
    my $string = shift;
154
		syslog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
169
    if ( defined $string ) {
155
		chomp($string);
170
        $self->{logger}->debug( "$self->{server}->{peeraddr}: get_clean_string  pre-clean(length " . length($string) . "): $string" );
156
		$string =~ s/^[^A-z0-9]+//;
171
        syslog( "LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string );
157
		$string =~ s/[^A-z0-9]+$//;
172
158
		syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
173
        chomp($string);
159
	} else {
174
        $string =~ s/^[^A-z0-9]+//;
160
		syslog("LOG_INFO", "get_clean_string called on undefined");
175
        $string =~ s/[^A-z0-9]+$//;
161
	}
176
162
	return $string;
177
        $self->{logger}->debug( "$self->{server}->{peeraddr}: get_clean_string post-clean(length " . length($string) . "): $string)" );
178
        syslog( "LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string );
179
    }
180
    else {
181
        $self->{logger}->info("$self->{server}->{peeraddr}: get_clean_string called on undefined");
182
        syslog( "LOG_INFO", "get_clean_string called on undefined" );
183
    }
184
    return $string;
163
}
185
}
164
186
187
# looks like this sub is no longer used
165
sub get_clean_input {
188
sub get_clean_input {
166
	local $/ = "\012";
189
    local $/ = "\012";
167
	my $in = <STDIN>;
190
    my $in = <STDIN>;
168
	$in = get_clean_string($in);
191
    $in = get_clean_string($in);
169
	while (my $extra = <STDIN>){
192
170
		syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
193
    while ( my $extra = <STDIN> ) {
171
	}
194
        syslog( "LOG_ERR", "get_clean_input got extra lines: %s", $extra );
172
	return $in;
195
    }
196
197
    return $in;
173
}
198
}
174
199
175
sub telnet_transport {
200
sub telnet_transport {
Lines 179-186 sub telnet_transport { Link Here
179
    my $account = undef;
204
    my $account = undef;
180
    my $input;
205
    my $input;
181
    my $config  = $self->{config};
206
    my $config  = $self->{config};
182
	my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
207
    my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
183
	syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout);
208
209
    $self->{logger}->debug("$self->{server}->{peeraddr}: telnet_transport: timeout is $timeout");
210
    syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout);
184
211
185
    eval {
212
    eval {
186
	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
213
	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
Lines 199-208 sub telnet_transport { Link Here
199
		$pwd = <STDIN>;
226
		$pwd = <STDIN>;
200
		alarm 0;
227
		alarm 0;
201
228
202
		syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
229
        $self->{logger}->debug( "$self->{server}->{peeraddr}: telnet_transport 1: uid length " . length($uid) . ", pwd length " . length($pwd) );
203
		$uid = get_clean_string ($uid);
230
        syslog( "LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd) );
204
		$pwd = get_clean_string ($pwd);
231
        $uid = $self->get_clean_string($uid);
205
		syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
232
        $pwd = $self->get_clean_string($pwd);
233
        $self->{logger}->debug( "$self->{server}->{peeraddr}: telnet_transport 2: uid length " . length($uid) . ", pwd length " . length($pwd) );
234
        syslog( "LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd) );
206
235
207
	    if (exists ($config->{accounts}->{$uid})
236
	    if (exists ($config->{accounts}->{$uid})
208
		&& ($pwd eq $config->{accounts}->{$uid}->{password})) {
237
		&& ($pwd eq $config->{accounts}->{$uid}->{password})) {
Lines 211-234 sub telnet_transport { Link Here
211
                last;
240
                last;
212
            }
241
            }
213
	    }
242
	    }
243
        $self->{logger}->warn("$self->{server}->{peeraddr}: Invalid login attempt: ' . ($uid||'')  . '");
214
		syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
244
		syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
215
		print("Invalid login$CRLF");
245
		print("Invalid login$CRLF");
216
	}
246
	}
217
    }; # End of eval
247
    }; # End of eval
218
248
219
    if ($@) {
249
    if ($@) {
220
		syslog("LOG_ERR", "telnet_transport: Login timed out");
250
        $self->{logger}->error("$self->{server}->{peeraddr}: telnet_transport: Login timed out");
221
		die "Telnet Login Timed out";
251
        syslog( "LOG_ERR", "telnet_transport: Login timed out" );
222
    } elsif (!defined($account)) {
252
        die "Telnet Login Timed out";
223
		syslog("LOG_ERR", "telnet_transport: Login Failed");
253
    }
224
		die "Login Failure";
254
    elsif ( !defined($account) ) {
225
    } else {
255
        $self->{logger}->error("$self->{server}->{peeraddr}: telnet_transport: Login Failed");
226
		print "Login OK.  Initiating SIP$CRLF";
256
        syslog( "LOG_ERR", "telnet_transport: Login Failed" );
257
        die "Login Failure";
258
    }
259
    else {
260
        print "Login OK.  Initiating SIP$CRLF";
227
    }
261
    }
228
262
229
    $self->{account} = $account;
263
    $self->{account} = $account;
264
    $self->{logger} = Koha::Logger->get( { interface => 'sip', category => $self->{account}->{id} } ); # Add id to namespace
265
    $self->{logger}->debug("$self->{server}->{peeraddr}:$self->{account}->{id}: telnet_transport: uname/inst: '$account->{id}/$account->{institution}'");
230
    syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
266
    syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
231
    $self->sip_protocol_loop();
267
    $self->sip_protocol_loop();
268
    $self->{logger}->info("$self->{server}->{peeraddr}:$self->{account}->{id}: telnet_transport: shutting down");
232
    syslog("LOG_INFO", "telnet_transport: shutting down");
269
    syslog("LOG_INFO", "telnet_transport: shutting down");
233
}
270
}
234
271
Lines 262-267 sub sip_protocol_loop { Link Here
262
    my $expect = '';
299
    my $expect = '';
263
    while (1) {
300
    while (1) {
264
        alarm $timeout;
301
        alarm $timeout;
302
        $C4::SIP::Sip::server = $self;
265
        $input = read_SIP_packet(*STDIN);
303
        $input = read_SIP_packet(*STDIN);
266
        unless ($input) {
304
        unless ($input) {
267
            return;		# EOF
305
            return;		# EOF
Lines 271-290 sub sip_protocol_loop { Link Here
271
		$input =~ s/[^A-z0-9]+$//s;	# Same on the end, should get DOSsy ^M line-endings too.
309
		$input =~ s/[^A-z0-9]+$//s;	# Same on the end, should get DOSsy ^M line-endings too.
272
		while (chomp($input)) {warn "Extra line ending on input";}
310
		while (chomp($input)) {warn "Extra line ending on input";}
273
		unless ($input) {
311
		unless ($input) {
312
            $self->{logger}->error("$self->{server}->{peeraddr}:$self->{account}->{id}: sip_protocol_loop: empty input skipped");
274
            syslog("LOG_ERR", "sip_protocol_loop: empty input skipped");
313
            syslog("LOG_ERR", "sip_protocol_loop: empty input skipped");
275
            print("96$CR");
314
            print("96$CR");
276
            next;
315
            next;
277
		}
316
		}
278
		# end cheap input hacks
317
		# end cheap input hacks
279
		my $status = handle($input, $self, $expect);
318
		my $status = handle($input, $self, $expect);
280
		if (!$status) {
319
        if ( !$status ) {
281
			syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
320
            $self->{logger}->error( "$self->{server}->{peeraddr}:$self->{account}->{id}: sip_protocol_loop: failed to handle " . substr( $input, 0, 2 ) );
282
		}
321
            syslog( "LOG_ERR", "sip_protocol_loop: failed to handle %s", substr( $input, 0, 2 ) );
322
        }
283
		next if $status eq REQUEST_ACS_RESEND;
323
		next if $status eq REQUEST_ACS_RESEND;
284
		if ($expect && ($status ne $expect)) {
324
        if ( $expect && ( $status ne $expect ) ) {
285
			# We received a non-"RESEND" that wasn't what we were expecting.
325
            # We received a non-"RESEND" that wasn't what we were expecting.
286
		    syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input);
326
            $self->{logger}->error("$self->{server}->{peeraddr}:$self->{account}->{id}: sip_protocol_loop: expected $expect, received $input, exiting");
287
		}
327
            syslog( "LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input );
328
        }
288
		# We successfully received and processed what we were expecting
329
		# We successfully received and processed what we were expecting
289
		$expect = '';
330
		$expect = '';
290
    alarm 0;
331
    alarm 0;
(-)a/C4/SIP/Sip.pm (-6 / +30 lines)
Lines 47-52 our $field_delimiter = '|'; # Protocol Default Link Here
47
47
48
our $last_response = '';
48
our $last_response = '';
49
49
50
# We need to have the server to do logging
51
our $server = undef;
52
50
sub timestamp {
53
sub timestamp {
51
    my $time = $_[0] || time();
54
    my $time = $_[0] || time();
52
    if ( ref $time eq 'DateTime') {
55
    if ( ref $time eq 'DateTime') {
Lines 67-74 sub add_field { Link Here
67
    my ($i, $ent);
70
    my ($i, $ent);
68
71
69
    if (!defined($value)) {
72
    if (!defined($value)) {
70
	syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
73
        $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: add_field: Undefined value being added to '$field_id'");
71
	       $field_id);
74
        syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
75
               $field_id);
72
		$value = '';
76
		$value = '';
73
    }
77
    }
74
    $value=~s/\r/ /g; # CR terminates a sip message
78
    $value=~s/\r/ /g; # CR terminates a sip message
Lines 122-127 sub add_count { Link Here
122
126
123
    $count = sprintf("%04d", $count);
127
    $count = sprintf("%04d", $count);
124
    if (length($count) != 4) {
128
    if (length($count) != 4) {
129
        $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_patron_info: $label wrong size: '$count'");
125
		syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
130
		syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
126
	       $label, $count);
131
	       $label, $count);
127
		$count = ' ' x 4;
132
		$count = ' ' x 4;
Lines 162-168 sub boolspace { Link Here
162
#
167
#
163
sub read_SIP_packet {
168
sub read_SIP_packet {
164
    my $record;
169
    my $record;
165
    my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!");
170
    my $fh;
171
    unless ( $fh = shift ) {
172
        $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet: no filehandle argument!");
173
        syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!");
174
    }
166
    my $len1 = 999;
175
    my $len1 = 999;
167
176
168
    # local $/ = "\r";      # don't need any of these here.  use whatever the prevailing $/ is.
177
    # local $/ = "\r";      # don't need any of these here.  use whatever the prevailing $/ is.
Lines 173-178 sub read_SIP_packet { Link Here
173
            if ( defined($record) ) {
182
            if ( defined($record) ) {
174
                while ( chomp($record) ) { 1; }
183
                while ( chomp($record) ) { 1; }
175
                $len1 = length($record);
184
                $len1 = length($record);
185
                $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet, INPUT MSG: '$record'");
176
                syslog( "LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'" );
186
                syslog( "LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'" );
177
                $record =~ s/^\s*[^A-z0-9]+//s; # Every line must start with a "real" character.  Not whitespace, control chars, etc. 
187
                $record =~ s/^\s*[^A-z0-9]+//s; # Every line must start with a "real" character.  Not whitespace, control chars, etc. 
178
                $record =~ s/[^A-z0-9]+$//s;    # Same for the end.  Note this catches the problem some clients have sending empty fields at the end, like |||
188
                $record =~ s/[^A-z0-9]+$//s;    # Same for the end.  Note this catches the problem some clients have sending empty fields at the end, like |||
Lines 186-194 sub read_SIP_packet { Link Here
186
    }
196
    }
187
    if ($record) {
197
    if ($record) {
188
        my $len2 = length($record);
198
        my $len2 = length($record);
189
        syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record;
199
        if ( $record ) {
190
        ($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2);
200
            $server->{logger}->info("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet, INPUT MSG: '$record'");
201
            syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'");
202
        }
203
        if ($len1 != $len2) {
204
            $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet, trimmed " . $len1-$len2 . " character(s) (after chomps).");
205
            syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2);
206
        }
191
    } else {
207
    } else {
208
        $server->{logger}->debug( "$server->{server}->{peeraddr}:$server->{account}->{id}: "
209
              . "read_SIP_packet input "
210
              . ( defined($record) ? "empty ($record)" : 'undefined' )
211
              . ", end of input." );
192
        syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record) ? "empty ($record)" : 'undefined'));
212
        syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record) ? "empty ($record)" : 'undefined'));
193
    }
213
    }
194
    #
214
    #
Lines 204-210 sub read_SIP_packet { Link Here
204
    #  
224
    #  
205
    # This is now handled by the vigorous cleansing above.
225
    # This is now handled by the vigorous cleansing above.
206
    # syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record;
226
    # syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record;
207
    syslog("LOG_INFO", "INPUT MSG: '$record'") if $record;
227
    if ( $record ) {
228
        $server->{logger}->debug( "$server->{server}->{peeraddr}:$server->{account}->{id}: INPUT MSG: '$record'" );
229
        syslog("LOG_INFO", "INPUT MSG: '$record'");
230
    }
208
    return $record;
231
    return $record;
209
}
232
}
210
233
Lines 246-251 sub write_msg { Link Here
246
    } else {
269
    } else {
247
        STDOUT->autoflush(1);
270
        STDOUT->autoflush(1);
248
        print $msg, $terminator;
271
        print $msg, $terminator;
272
        $server->{logger}->info( "$server->{server}->{peeraddr}:$server->{account}->{id}: OUTPUT MSG: '$msg'");
249
        syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
273
        syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
250
    }
274
    }
251
275
(-)a/C4/SIP/Sip/Configuration.pm (+2 lines)
Lines 60-68 sub accounts { Link Here
60
60
61
sub find_service {
61
sub find_service {
62
    my ( $self, $sockaddr, $port, $proto ) = @_;
62
    my ( $self, $sockaddr, $port, $proto ) = @_;
63
    my $logger = Koha::Logger->get({ interface => 'sip' });
63
    my $portstr;
64
    my $portstr;
64
    foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
65
    foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
65
        $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
66
        $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
67
        $logger->debug("Configuration::find_service: Trying $portstr");
66
        Sys::Syslog::syslog( "LOG_DEBUG",
68
        Sys::Syslog::syslog( "LOG_DEBUG",
67
            "Configuration::find_service: Trying $portstr" );
69
            "Configuration::find_service: Trying $portstr" );
68
        last if ( exists( ( $self->{listeners} )->{$portstr} ) );
70
        last if ( exists( ( $self->{listeners} )->{$portstr} ) );
(-)a/C4/SIP/Sip/MsgType.pm (-36 / +76 lines)
Lines 276-282 foreach my $i (keys(%handlers)) { Link Here
276
}
276
}
277
277
278
sub new {
278
sub new {
279
    my ($class, $msg, $seqno) = @_;
279
    my ($class, $msg, $seqno, $server) = @_;
280
    my $self = {};
280
    my $self = {};
281
    my $msgtag = substr($msg, 0, 2);
281
    my $msgtag = substr($msg, 0, 2);
282
282
Lines 287-300 sub new { Link Here
287
	# it's using the 2.00 login process, so it must support 2.00.
287
	# it's using the 2.00 login process, so it must support 2.00.
288
		$protocol_version = 2;
288
		$protocol_version = 2;
289
    }
289
    }
290
    my $id = $server->{account} ? $server->{account}->{id} . ':' : q{};
291
    $server->{logger}->debug( "$server->{server}->{peeraddr}:$id Sip::MsgType::new('$class', '" . substr($msg, 0, 10)
292
                    . "...', '$msgtag'): seq.no '$seqno', protocol $protocol_version" );
290
    syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s",
293
    syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s",
291
		$class, substr($msg, 0, 10), $msgtag, $seqno, $protocol_version);
294
		$class, substr($msg, 0, 10), $msgtag, $seqno, $protocol_version);
292
	# warn "SIP PROTOCOL: $protocol_version";	
293
    if (!exists($handlers{$msgtag})) {
295
    if (!exists($handlers{$msgtag})) {
296
        $server->{logger}->warn("$server->{server}->{peeraddr}:$id new Sip::MsgType: Skipping message of unknown type '$msgtag' in '$msg'");
294
		syslog("LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'",
297
		syslog("LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'",
295
	       $msgtag, $msg);
298
	       $msgtag, $msg);
296
        return;
299
        return;
297
    } elsif (!exists($handlers{$msgtag}->{protocol}->{$protocol_version})) {
300
    } elsif (!exists($handlers{$msgtag}->{protocol}->{$protocol_version})) {
301
        $server->{logger}->warn("$server->{server}->{peeraddr}:$id new Sip::MsgType: Skipping message '$msgtag' unsupported by protocol rev. '$protocol_version'");
298
		syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'",
302
		syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'",
299
	       $msgtag, $protocol_version);
303
	       $msgtag, $protocol_version);
300
        return;
304
        return;
Lines 302-307 sub new { Link Here
302
306
303
    bless $self, $class;
307
    bless $self, $class;
304
308
309
    $self->{server} = $server;
305
    $self->{seqno} = $seqno;
310
    $self->{seqno} = $seqno;
306
    $self->_initialize(substr($msg,2), $handlers{$msgtag});
311
    $self->_initialize(substr($msg,2), $handlers{$msgtag});
307
312
Lines 328-333 sub _initialize { Link Here
328
		$self->{fields}->{$field} = undef;
333
		$self->{fields}->{$field} = undef;
329
	}
334
	}
330
335
336
    my $id = $self->{server}->{account} ? $self->{server}->{account}->{id} . ':' : q{};
337
    $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$id Sip::MsgType::_initialize('$self->{name}', '$msg', '$proto->{template}', '$proto->{template_len}', ...)");
331
    syslog("LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)",
338
    syslog("LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)",
332
		$self->{name}, $msg, $proto->{template}, $proto->{template_len});
339
		$self->{name}, $msg, $proto->{template}, $proto->{template_len});
333
340
Lines 339-347 sub _initialize { Link Here
339
		$fn = substr($field, 0, 2);
346
		$fn = substr($field, 0, 2);
340
347
341
	if (!exists($self->{fields}->{$fn})) {
348
	if (!exists($self->{fields}->{$fn})) {
349
        $self->{server}->{logger}->warn("$self->{server}->{server}->{peeraddr}:$id: Unsupported field '$fn' in $self->{name}, message '$msg'");
342
		syslog("LOG_WARNING", "Unsupported field '%s' in %s message '%s'",
350
		syslog("LOG_WARNING", "Unsupported field '%s' in %s message '%s'",
343
			$fn, $self->{name}, $msg);
351
			$fn, $self->{name}, $msg);
344
	} elsif (defined($self->{fields}->{$fn})) {
352
	} elsif (defined($self->{fields}->{$fn})) {
353
        $self->{server}->{logger}->warn("$self->{server}->{server}->{peeraddr}:$id: Duplicate field '$fn' (previous value '$self->{fields}->{$fn}') in $self->{name} message '$msg'");
345
		syslog("LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'",
354
		syslog("LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'",
346
			$fn, $self->{fields}->{$fn}, $self->{name}, $msg);
355
			$fn, $self->{fields}->{$fn}, $self->{name}, $msg);
347
	} else {
356
	} else {
Lines 373-383 sub handle { Link Here
373
    if ($msg eq REQUEST_ACS_RESEND_CKSUM) {
382
    if ($msg eq REQUEST_ACS_RESEND_CKSUM) {
374
		# Special case
383
		# Special case
375
		$error_detection = 1;
384
		$error_detection = 1;
376
		$self = C4::SIP::Sip::MsgType->new((REQUEST_ACS_RESEND), 0);
385
        $self = C4::SIP::Sip::MsgType->new( (REQUEST_ACS_RESEND), 0, $server );
377
    } elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {
386
    } elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {
378
		$error_detection = 1;
387
		$error_detection = 1;
379
388
380
	if (!verify_cksum($msg)) {
389
	if (!verify_cksum($msg)) {
390
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Checksum failed on message '$msg'");
381
	    syslog("LOG_WARNING", "Checksum failed on message '%s'", $msg);
391
	    syslog("LOG_WARNING", "Checksum failed on message '%s'", $msg);
382
	    # REQUEST_SC_RESEND with error detection
392
	    # REQUEST_SC_RESEND with error detection
383
	    $last_response = REQUEST_SC_RESEND_CKSUM;
393
	    $last_response = REQUEST_SC_RESEND_CKSUM;
Lines 386-402 sub handle { Link Here
386
	} else {
396
	} else {
387
	    # Save the sequence number, then strip off the
397
	    # Save the sequence number, then strip off the
388
	    # error detection data to process the message
398
	    # error detection data to process the message
389
	    $self = C4::SIP::Sip::MsgType->new(substr($msg, 0, -9), substr($msg, -7, 1));
399
    $self = C4::SIP::Sip::MsgType->new( substr( $msg, 0, -9 ), substr( $msg, -7, 1 ), $server );
390
	}
400
	}
391
    } elsif ($error_detection) {
401
    } elsif ($error_detection) {
392
	# We received a non-ED message when ED is supposed to be active.
402
	# We received a non-ED message when ED is supposed to be active.
393
	# Warn about this problem, then process the message anyway.
403
	# Warn about this problem, then process the message anyway.
404
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Received message without error detection: '$msg'");
394
		syslog("LOG_WARNING",
405
		syslog("LOG_WARNING",
395
	       "Received message without error detection: '%s'", $msg);
406
	       "Received message without error detection: '%s'", $msg);
396
		$error_detection = 0;
407
		$error_detection = 0;
397
		$self = C4::SIP::Sip::MsgType->new($msg, 0);
408
        $self = C4::SIP::Sip::MsgType->new( $msg, 0, $server );
398
    } else {
409
    } else {
399
		$self = C4::SIP::Sip::MsgType->new($msg, 0);
410
        $self = C4::SIP::Sip::MsgType->new( $msg, 0, $server );
400
    }
411
    }
401
412
402
	if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&
413
	if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&
Lines 404-409 sub handle { Link Here
404
		return substr($msg, 0, 2);
415
		return substr($msg, 0, 2);
405
	}
416
	}
406
	unless ($self->{handler}) {
417
	unless ($self->{handler}) {
418
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: No handler defined for '$msg'");
407
		syslog("LOG_WARNING", "No handler defined for '%s'", $msg);
419
		syslog("LOG_WARNING", "No handler defined for '%s'", $msg);
408
        $last_response = REQUEST_SC_RESEND;
420
        $last_response = REQUEST_SC_RESEND;
409
        print("$last_response\r");
421
        print("$last_response\r");
Lines 437-443 sub build_patron_status { Link Here
437
    my $resp = (PATRON_STATUS_RESP);
449
    my $resp = (PATRON_STATUS_RESP);
438
450
439
    if ($patron) {
451
    if ($patron) {
440
	$resp .= patron_status_string($patron);
452
        $resp .= patron_status_string( $patron, $server );
441
	$resp .= $lang . timestamp();
453
	$resp .= $lang . timestamp();
442
	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
454
	$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
443
455
Lines 518-523 sub handle_checkout { Link Here
518
530
519
        # Off-line transactions need to be recorded, but there's
531
        # Off-line transactions need to be recorded, but there's
520
        # not a lot we can do about it
532
        # not a lot we can do about it
533
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: received no-block checkout from terminal '$account->{id}'");
521
        syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
534
        syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
522
535
523
        $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
536
        $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
Lines 640-645 sub handle_checkin { Link Here
640
653
641
    if ($no_block eq 'Y') {
654
    if ($no_block eq 'Y') {
642
        # Off-line transactions, ick.
655
        # Off-line transactions, ick.
656
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: received no-block checkin from terminal '$account->{id}'");
643
        syslog("LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id});
657
        syslog("LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id});
644
        $status = $ils->checkin_no_block($item_id, $trans_date, $return_date, $item_props, $cancel);
658
        $status = $ils->checkin_no_block($item_id, $trans_date, $return_date, $item_props, $cancel);
645
    } else {
659
    } else {
Lines 759-779 sub handle_sc_status { Link Here
759
	} elsif ($sc_protocol_version =~ /^2\./) {
773
	} elsif ($sc_protocol_version =~ /^2\./) {
760
		$new_proto = 2;
774
		$new_proto = 2;
761
	} else {
775
	} else {
776
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Unrecognized protocol revision '$sc_protocol_version', falling back to '1'");
762
		syslog("LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version);
777
		syslog("LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version);
763
		$new_proto = 1;
778
		$new_proto = 1;
764
	}
779
	}
765
780
766
	if ($new_proto != $protocol_version) {
781
	if ($new_proto != $protocol_version) {
782
        $server->{logger}->info("$server->{server}->{peeraddr}:$server->{account}->{id}: Setting protocol level to $new_proto");
767
		syslog("LOG_INFO", "Setting protocol level to $new_proto");
783
		syslog("LOG_INFO", "Setting protocol level to $new_proto");
768
		$protocol_version = $new_proto;
784
		$protocol_version = $new_proto;
769
	}
785
	}
770
786
771
    if ($status == SC_STATUS_PAPER) {
787
    if ($status == SC_STATUS_PAPER) {
772
	syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper",
788
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Self-Check unit '$self->{account}->{id}@$self->{account}->{institution}' out of paper");
773
	       $self->{account}->{id}, $self->{account}->{institution});
789
        syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper",
790
               $self->{account}->{id}, $self->{account}->{institution});
774
    } elsif ($status == SC_STATUS_SHUTDOWN) {
791
    } elsif ($status == SC_STATUS_SHUTDOWN) {
775
	syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down",
792
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Self-Check unit '$self->{account}->{id}@$self->{account}->{institution}' shutting down");
776
	       $self->{account}->{id}, $self->{account}->{institution});
793
        syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down",
794
               $self->{account}->{id}, $self->{account}->{institution});
777
    }
795
    }
778
796
779
    $self->{account}->{print_width} = $print_width;
797
    $self->{account}->{print_width} = $print_width;
Lines 810-818 sub login_core { Link Here
810
	my $pwd = shift;
828
	my $pwd = shift;
811
    my $status = 1;		# Assume it all works
829
    my $status = 1;		# Assume it all works
812
    if (!exists($server->{config}->{accounts}->{$uid})) {
830
    if (!exists($server->{config}->{accounts}->{$uid})) {
831
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: MsgType::login_core: Unknown login '$uid'");
813
		syslog("LOG_WARNING", "MsgType::login_core: Unknown login '$uid'");
832
		syslog("LOG_WARNING", "MsgType::login_core: Unknown login '$uid'");
814
		$status = 0;
833
		$status = 0;
815
    } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) {
834
    } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) {
835
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: MsgType::login_core: Invalid password for login '$uid'");
816
		syslog("LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'");
836
		syslog("LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'");
817
		$status = 0;
837
		$status = 0;
818
    } else {
838
    } else {
Lines 826-840 sub login_core { Link Here
826
846
827
        my $auth_status = api_auth($uid,$pwd,$inst);
847
        my $auth_status = api_auth($uid,$pwd,$inst);
828
		if (!$auth_status or $auth_status !~ /^ok$/i) {
848
		if (!$auth_status or $auth_status !~ /^ok$/i) {
849
            $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: api_auth failed for SIP terminal '$uid' of '$inst': " . ($auth_status||'unknown') );
829
			syslog("LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s",
850
			syslog("LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s",
830
						$uid, $inst, ($auth_status||'unknown'));
851
						$uid, $inst, ($auth_status||'unknown'));
831
			$status = 0;
852
			$status = 0;
832
		} else {
853
		} else {
854
            $server->{logger}->info("$server->{server}->{peeraddr}:$server->{account}->{id}: Successful login/auth for '$server->{account}->{id}' of '$inst'");
833
			syslog("LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst);
855
			syslog("LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst);
834
			#
856
			#
835
			# initialize connection to ILS
857
			# initialize connection to ILS
836
			#
858
			#
837
			my $module = $server->{config}->{institutions}->{$inst}->{implementation};
859
			my $module = $server->{config}->{institutions}->{$inst}->{implementation};
860
            $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: login_core: " . Dumper($module) );
838
			syslog("LOG_DEBUG", 'login_core: ' . Dumper($module));
861
			syslog("LOG_DEBUG", 'login_core: ' . Dumper($module));
839
            # Suspect this is always ILS but so we don't break any eccentic install (for now)
862
            # Suspect this is always ILS but so we don't break any eccentic install (for now)
840
            if ($module eq 'ILS') {
863
            if ($module eq 'ILS') {
Lines 842-855 sub login_core { Link Here
842
            }
865
            }
843
			$module->use;
866
			$module->use;
844
			if ($@) {
867
			if ($@) {
868
                $server->{logger}->error("$server->{server}->{peeraddr}:$server->{service}: Loading ILS implementation '$module' for institution '$inst' failed");
845
				syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
869
				syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
846
						$server->{service}, $module, $inst);
870
						$server->{service}, $module, $inst);
847
				die("Failed to load ILS implementation '$module' for $inst");
871
				die("Failed to load ILS implementation '$module' for $inst");
848
			}
872
			}
849
873
850
			# like   ILS->new(), I think.
874
			# like   ILS->new(), I think.
851
			$server->{ils} = $module->new($server->{institution}, $server->{account});
875
876
            $server->{ils} = $module->new( $server->{institution}, $server->{account}, $server );
852
			if (!$server->{ils}) {
877
			if (!$server->{ils}) {
878
                $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: $server->{service}: ILS connection to '$inst' failed");
853
			    syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst);
879
			    syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst);
854
			    die("Unable to connect to ILS '$inst'");
880
			    die("Unable to connect to ILS '$inst'");
855
			}
881
			}
Lines 873-878 sub handle_login { Link Here
873
    $pwd = $fields->{(FID_LOGIN_PWD)}; # Terminal PWD, not patron PWD.
899
    $pwd = $fields->{(FID_LOGIN_PWD)}; # Terminal PWD, not patron PWD.
874
900
875
    if ($uid_algorithm || $pwd_algorithm) {
901
    if ($uid_algorithm || $pwd_algorithm) {
902
        $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm");
876
		syslog("LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm");
903
		syslog("LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm");
877
		$status = 0;
904
		$status = 0;
878
    }
905
    }
Lines 890-896 sub handle_login { Link Here
890
# and we're going to believe it.
917
# and we're going to believe it.
891
#
918
#
892
sub summary_info {
919
sub summary_info {
893
    my ($ils, $patron, $summary, $start, $end) = @_;
920
    my ($server, $ils, $patron, $summary, $start, $end) = @_;
894
    my $resp = '';
921
    my $resp = '';
895
    my $summary_type;
922
    my $summary_type;
896
    #
923
    #
Lines 910-915 sub summary_info { Link Here
910
        return '';  # No detailed information required
937
        return '';  # No detailed information required
911
    }
938
    }
912
939
940
    $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: Summary_info: index == '$summary_type', field '$summary_map[$summary_type]->{fid}'");
913
    syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
941
    syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
914
        $summary_type, $summary_map[$summary_type]->{fid});
942
        $summary_type, $summary_map[$summary_type]->{fid});
915
943
Lines 917-922 sub summary_info { Link Here
917
    my $fid  = $summary_map[$summary_type]->{fid};
945
    my $fid  = $summary_map[$summary_type]->{fid};
918
    my $itemlist = &$func($patron, $start, $end);
946
    my $itemlist = &$func($patron, $start, $end);
919
947
948
    $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: summary_info: list = (" . join(", ", @{$itemlist}) . ")");
920
    syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
949
    syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
921
    foreach my $i (@{$itemlist}) {
950
    foreach my $i (@{$itemlist}) {
922
        $resp .= add_field($fid, $i->{barcode});
951
        $resp .= add_field($fid, $i->{barcode});
Lines 944-950 sub handle_patron_info { Link Here
944
973
945
    $resp = (PATRON_INFO_RESP);
974
    $resp = (PATRON_INFO_RESP);
946
    if ($patron) {
975
    if ($patron) {
947
        $resp .= patron_status_string($patron);
976
        $resp .= patron_status_string($patron, $server);
948
        $resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
977
        $resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
949
        $resp .= timestamp();
978
        $resp .= timestamp();
950
979
Lines 991-997 sub handle_patron_info { Link Here
991
        #          fine_items
1020
        #          fine_items
992
        #        recall_items
1021
        #        recall_items
993
1022
994
        $resp .= summary_info($ils, $patron, $summary, $start, $end);
1023
        $resp .= summary_info($server, $ils, $patron, $summary, $start, $end);
995
1024
996
        $resp .= maybe_add(FID_HOME_ADDR,  $patron->address);
1025
        $resp .= maybe_add(FID_HOME_ADDR,  $patron->address);
997
        $resp .= maybe_add(FID_EMAIL,      $patron->email_addr);
1026
        $resp .= maybe_add(FID_EMAIL,      $patron->email_addr);
Lines 1177-1182 sub handle_item_status_update { Link Here
1177
    $item_props = $fields->{(FID_ITEM_PROPS)};
1206
    $item_props = $fields->{(FID_ITEM_PROPS)};
1178
1207
1179
	if (!defined($item_id)) {
1208
	if (!defined($item_id)) {
1209
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_item_status: received message without Item ID field");
1180
		syslog("LOG_WARNING",
1210
		syslog("LOG_WARNING",
1181
			"handle_item_status: received message without Item ID field");
1211
			"handle_item_status: received message without Item ID field");
1182
    } else {
1212
    } else {
Lines 1221-1226 sub handle_patron_enable { Link Here
1221
    $patron_id = $fields->{(FID_PATRON_ID)};
1251
    $patron_id = $fields->{(FID_PATRON_ID)};
1222
    $patron_pwd = $fields->{(FID_PATRON_PWD)};
1252
    $patron_pwd = $fields->{(FID_PATRON_PWD)};
1223
1253
1254
    $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_patron_enable: patron_id: '$patron_id', patron_pwd: '$patron_pwd'");
1224
    syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'",
1255
    syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'",
1225
	   $patron_id, $patron_pwd);
1256
	   $patron_id, $patron_pwd);
1226
1257
Lines 1239-1245 sub handle_patron_enable { Link Here
1239
	    # Don't enable the patron if there was an invalid password
1270
	    # Don't enable the patron if there was an invalid password
1240
	    $status = $patron->enable;
1271
	    $status = $patron->enable;
1241
	}
1272
	}
1242
	$resp .= patron_status_string($patron);
1273
    $resp .= patron_status_string( $patron, $server );
1243
	$resp .= $patron->language . timestamp();
1274
	$resp .= $patron->language . timestamp();
1244
1275
1245
	$resp .= add_field(FID_PATRON_ID, $patron->id);
1276
	$resp .= add_field(FID_PATRON_ID, $patron->id);
Lines 1292-1301 sub handle_hold { Link Here
1292
	$status = $ils->alter_hold($patron_id, $patron_pwd, $item_id, $title_id,
1323
	$status = $ils->alter_hold($patron_id, $patron_pwd, $item_id, $title_id,
1293
						$expiry_date, $pickup_locn, $hold_type, $fee_ack);
1324
						$expiry_date, $pickup_locn, $hold_type, $fee_ack);
1294
    } else {
1325
    } else {
1295
	syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'",
1326
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_hold: Unrecognized hold mode '$hold_mode' from terminal '$server->{account}->{id}'");
1296
	       $hold_mode, $server->{account}->{id});
1327
        syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'",
1297
	$status = $ils->Transaction::Hold;		# new?
1328
               $hold_mode, $server->{account}->{id});
1298
	$status->screen_msg("System error. Please contact library staff.");
1329
        $status = $ils->Transaction::Hold;    # new?
1330
        $status->screen_msg("System error. Please contact library staff.");
1299
    }
1331
    }
1300
1332
1301
    $resp .= $status->ok;
1333
    $resp .= $status->ok;
Lines 1342-1350 sub handle_renew { Link Here
1342
    $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew");
1374
    $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew");
1343
1375
1344
    if ($no_block eq 'Y') {
1376
    if ($no_block eq 'Y') {
1345
	syslog("LOG_WARNING",
1377
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_renew: received 'no block' renewal from terminal '$server->{account}->{id}'");
1346
            "handle_renew: received 'no block' renewal from terminal '%s'",
1378
        syslog("LOG_WARNING",
1347
	       $server->{account}->{id});
1379
                "handle_renew: received 'no block' renewal from terminal '%s'",
1380
               $server->{account}->{id});
1348
    }
1381
    }
1349
1382
1350
    $patron_id  = $fields->{(FID_PATRON_ID)};
1383
    $patron_id  = $fields->{(FID_PATRON_ID)};
Lines 1511-1525 sub send_acs_status { Link Here
1511
    $retries = sprintf("%03d", $policy->{retries});
1544
    $retries = sprintf("%03d", $policy->{retries});
1512
1545
1513
    if (length($timeout) != 3) {
1546
    if (length($timeout) != 3) {
1514
	syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'",
1547
        $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_acs_status: timeout field wrong size: '$timeout'");
1515
	       $timeout);
1548
        syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'",
1516
	$timeout = '000';
1549
               $timeout);
1550
        $timeout = '000';
1517
    }
1551
    }
1518
1552
1519
    if (length($retries) != 3) {
1553
    if (length($retries) != 3) {
1520
	syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'",
1554
        $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_acs_status: retries field wrong size: '$retries'");
1521
	       $retries);
1555
        syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'",
1522
	$retries = '000';
1556
               $retries);
1557
        $retries = '000';
1523
    }
1558
    }
1524
1559
1525
    $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1560
    $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
Lines 1531-1540 sub send_acs_status { Link Here
1531
    } elsif ($protocol_version == 2) {
1566
    } elsif ($protocol_version == 2) {
1532
	$msg .= '2.00';
1567
	$msg .= '2.00';
1533
    } else {
1568
    } else {
1534
	syslog("LOG_ERR",
1569
        $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: Bad setting for \$protocol_version, '$protocol_version' in send_acs_status");
1535
	       'Bad setting for $protocol_version, "%s" in send_acs_status',
1570
        syslog("LOG_ERR",
1536
	       $protocol_version);
1571
               'Bad setting for $protocol_version, "%s" in send_acs_status',
1537
	$msg .= '1.00';
1572
               $protocol_version);
1573
        $msg .= '1.00';
1538
    }
1574
    }
1539
1575
1540
    # Institution ID
1576
    # Institution ID
Lines 1552-1557 sub send_acs_status { Link Here
1552
	    }
1588
	    }
1553
	}
1589
	}
1554
	if (length($supported_msgs) < 16) {
1590
	if (length($supported_msgs) < 16) {
1591
        $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: send_acs_status: supported messages '$supported_msgs' too short");
1555
	    syslog("LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs);
1592
	    syslog("LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs);
1556
	}
1593
	}
1557
	$msg .= add_field(FID_SUPPORTED_MSGS, $supported_msgs);
1594
	$msg .= add_field(FID_SUPPORTED_MSGS, $supported_msgs);
Lines 1561-1569 sub send_acs_status { Link Here
1561
1598
1562
    if (defined($account->{print_width}) && defined($print_line)
1599
    if (defined($account->{print_width}) && defined($print_line)
1563
	&& $account->{print_width} < length($print_line)) {
1600
	&& $account->{print_width} < length($print_line)) {
1564
	syslog("LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating",
1601
        $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: send_acs_status: print line '$print_line' too long.  Truncating");
1565
	       $print_line);
1602
        syslog("LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating",
1566
	$print_line = substr($print_line, 0, $account->{print_width});
1603
               $print_line);
1604
        $print_line = substr($print_line, 0, $account->{print_width});
1567
    }
1605
    }
1568
1606
1569
    $msg .= maybe_add(FID_PRINT_LINE, $print_line);
1607
    $msg .= maybe_add(FID_PRINT_LINE, $print_line);
Lines 1580-1587 sub send_acs_status { Link Here
1580
#
1618
#
1581
sub patron_status_string {
1619
sub patron_status_string {
1582
    my $patron = shift;
1620
    my $patron = shift;
1621
    my $server = shift;
1583
    my $patron_status;
1622
    my $patron_status;
1584
1623
1624
    $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: patron_status_string: $patron->id charge_ok: $patron->charge_ok");
1585
    syslog("LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok);
1625
    syslog("LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok);
1586
    $patron_status = sprintf(
1626
    $patron_status = sprintf(
1587
        '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1627
        '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
(-)a/etc/log4perl.conf (-1 / +8 lines)
Lines 11-13 log4perl.appender.OPAC.filename=__LOG_DIR__/opac-error.log Link Here
11
log4perl.appender.OPAC.mode=append
11
log4perl.appender.OPAC.mode=append
12
log4perl.appender.OPAC.layout=PatternLayout
12
log4perl.appender.OPAC.layout=PatternLayout
13
log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
13
log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
14
- 
14
15
log4perl.logger.sip = DEBUG, SIP
16
log4perl.appender.SIP           = Log::Dispatch::Syslog
17
log4perl.appender.SIP.min_level = debug
18
log4perl.appender.SIP.ident     = koha_sip
19
log4perl.appender.SIP.facility  = local6
20
log4perl.appender.SIP.layout=PatternLayout
21
log4perl.appender.SIP.layout.ConversionPattern=[%d] [%p] %m %l %n

Return to bug 15253