Attachment #104672 for bug #15253

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





# Most fields are handled by the Transaction superclass
my %fields = (
          security_inhibit => 0,
          due              => undef,
          renew_ok         => 0,
    );

sub new {
    my $class = shift;;
    my $self = $class->SUPER::new();
    foreach my $element (keys %fields) {
        $self->{_permitted}->{$element} = $fields{$element};
    }
    @{$self}{keys %fields} = values %fields;
#    $self->{'due'} = time() + (60*60*24*14); # two weeks hence
    $debug and warn "new ILS::Transaction::Checkout : " . Dumper $self;
    return bless $self, $class;
}

sub do_checkout {
    my $self = shift;
    siplog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
    my $shelf          = $self->{item}->hold_shelf;
    my $barcode        = $self->{item}->id;
    my $patron_barcode = $self->{patron}->id;
        my $overridden_duedate; # usually passed as undef to AddIssue
    $debug and warn "do_checkout: patron (" . $patron_barcode . ")";
    my $patron = Koha::Patrons->find( { cardnumber => $patron_barcode } );
    my $borrower = $patron->unblessed;
    $debug and warn "do_checkout borrower: . " . Dumper $borrower;
    my ($issuingimpossible, $needsconfirmation) = _can_we_issue($patron, $barcode,
        C4::Context->preference("AllowItemsOnHoldCheckoutSIP")
    );

            $noerror = 0;
        }
    }
    unless ($noerror) {
        $debug and warn "cannot issue: " . Dumper($issuingimpossible) . "\n" . Dumper($needsconfirmation);
        $self->ok(0);
        return $self;
    }
    # can issue
    $debug and warn "do_checkout: calling AddIssue(\$borrower,$barcode, $overridden_duedate, 0)\n"
        # . "w/ \$borrower: " . Dumper($borrower)
        . "w/ C4::Context->userenv: " . Dumper(C4::Context->userenv);
    my $issue = AddIssue( $borrower, $barcode, $overridden_duedate, 0 );
    $self->{due} = $self->duedatefromissue($issue, $itemnumber);

    $self->ok(1);
    return $self;
}

sub _can_we_issue {




use constant LOG_SIP => "local6"; # Local alias for the logging facility

#
# Main  # not really, since package SIPServer
#
# FIXME: Is this a module or a script?  
# A script with no MAIN namespace?

#
if (defined($config->{'server-params'})) {
    while (my ($key, $val) = each %{$config->{'server-params'}}) {
        push @parms, $key . '=' . $val;
    }
}


    $self->{service} = $config->find_service($sockaddr, $port, $proto);

    if (!defined($self->{service})) {
        siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
        die "process_request: Bad server connection";
    }

    $transport = $transports{$self->{service}->{transport}};

    if (!defined($transport)) {
        siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
        return;
    } else {
        &$transport($self);
    }
    return;
}

}

sub get_clean_string {
    my $string = shift;
    if (defined $string) {
        siplog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
        chomp($string);
        $string =~ s/^[^A-z0-9]+//;
        $string =~ s/[^A-z0-9]+$//;
        siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
    } else {
        siplog("LOG_INFO", "get_clean_string called on undefined");
    }
    return $string;
}

sub get_clean_input {
    local $/ = "\012";
    my $in = <STDIN>;
    $in = get_clean_string($in);
    while (my $extra = <STDIN>){
        siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
    }
    return $in;
}

sub telnet_transport {

    siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout");

    eval {
    local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
    local $| = 1;           # Unbuffered output
    $/ = "\015";        # Internet Record Separator (lax version)
    # Until the terminal has logged in, we don't trust it
    # so use a timeout to protect ourselves from hanging.

    while ($strikes--) {
        print "login: ";
        alarm $timeout;
        # $uid = &get_clean_input;
        $uid = <STDIN>;
        print "password: ";
        # $pwd = &get_clean_input || '';
        $pwd = <STDIN>;
        alarm 0;

        siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
        $uid = get_clean_string ($uid);
        $pwd = get_clean_string ($pwd);
        siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));

        if (exists ($config->{accounts}->{$uid})
        && ($pwd eq $config->{accounts}->{$uid}->{password})) {
            $account = $config->{accounts}->{$uid};
            if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) {
                last;
            }
        }
        siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
        print("Invalid login$CRLF");
    }
    }; # End of eval

    if ($@) {
        siplog("LOG_ERR", "telnet_transport: Login timed out");
        die "Telnet Login Timed out";
    } elsif (!defined($account)) {
        siplog("LOG_ERR", "telnet_transport: Login Failed");
        die "Login Failure";
    } else {
        print "Login OK.  Initiating SIP$CRLF";
    }

    $self->{account} = $account;




    my ($i, $ent);

    if (!defined($value)) {
    siplog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
           $field_id);
        $value = '';
    }
    $value=~s/\r/ /g; # CR terminates a sip message
                      # Protect against them in sip text fields

    $ent = sprintf("&#%d;", ord($field_delimiter));

    while (($i = index($value, $field_delimiter)) != ($[-1)) {
        substr($value, $i, 1) = $ent;
    }

    return $field_id . $value . $field_delimiter;

    # If the field is unsupported, it will be undef, return blanks
    # as per the spec.
    if (!defined($count)) {
        return ' ' x 4;
    }

    $count = sprintf("%04d", $count);
    if (length($count) != 4) {
        siplog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
           $label, $count);
        $count = ' ' x 4;
    }
    return $count;
}
- 

Return to bug 15253

Lines 28-61 our $debug; Link Here

(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-24 / +24 lines)
28		28
29	# Most fields are handled by the Transaction superclass	29	# Most fields are handled by the Transaction superclass
30	my %fields = (	30	my %fields = (
31	security_inhibit => 0,	31	security_inhibit => 0,
32	due => undef,	32	due => undef,
33	renew_ok => 0,	33	renew_ok => 0,
34	);	34	);
35		35
36	sub new {	36	sub new {
37	my $class = shift;;	37	my $class = shift;;
38	my $self = $class->SUPER::new();	38	my $self = $class->SUPER::new();
39	foreach my $element (keys %fields) {	39	foreach my $element (keys %fields) {
40	$self->{_permitted}->{$element} = $fields{$element};	40	$self->{_permitted}->{$element} = $fields{$element};
41	}	41	}
42	@{$self}{keys %fields} = values %fields;	42	@{$self}{keys %fields} = values %fields;
43	# $self->{'due'} = time() + (606024*14); # two weeks hence	43	# $self->{'due'} = time() + (606024*14); # two weeks hence
44	$debug and warn "new ILS::Transaction::Checkout : " . Dumper $self;	44	$debug and warn "new ILS::Transaction::Checkout : " . Dumper $self;
45	return bless $self, $class;	45	return bless $self, $class;
46	}	46	}
47		47
48	sub do_checkout {	48	sub do_checkout {
49	my $self = shift;	49	my $self = shift;
50	siplog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");	50	siplog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout...");
51	my $shelf = $self->{item}->hold_shelf;	51	my $shelf = $self->{item}->hold_shelf;
52	my $barcode = $self->{item}->id;	52	my $barcode = $self->{item}->id;
53	my $patron_barcode = $self->{patron}->id;	53	my $patron_barcode = $self->{patron}->id;
54	my $overridden_duedate; # usually passed as undef to AddIssue	54	my $overridden_duedate; # usually passed as undef to AddIssue
55	$debug and warn "do_checkout: patron (" . $patron_barcode . ")";	55	$debug and warn "do_checkout: patron (" . $patron_barcode . ")";
56	my $patron = Koha::Patrons->find( { cardnumber => $patron_barcode } );	56	my $patron = Koha::Patrons->find( { cardnumber => $patron_barcode } );
57	my $borrower = $patron->unblessed;	57	my $borrower = $patron->unblessed;
58	$debug and warn "do_checkout borrower: . " . Dumper $borrower;	58	$debug and warn "do_checkout borrower: . " . Dumper $borrower;
59	my ($issuingimpossible, $needsconfirmation) = _can_we_issue($patron, $barcode,	59	my ($issuingimpossible, $needsconfirmation) = _can_we_issue($patron, $barcode,
60	C4::Context->preference("AllowItemsOnHoldCheckoutSIP")	60	C4::Context->preference("AllowItemsOnHoldCheckoutSIP")
61	);	61	);
Lines 126-145 sub do_checkout { Link Here
126	$noerror = 0;	126	$noerror = 0;
127	}	127	}
128	}	128	}
129	unless ($noerror) {	129	unless ($noerror) {
130	$debug and warn "cannot issue: " . Dumper($issuingimpossible) . "\n" . Dumper($needsconfirmation);	130	$debug and warn "cannot issue: " . Dumper($issuingimpossible) . "\n" . Dumper($needsconfirmation);
131	$self->ok(0);	131	$self->ok(0);
132	return $self;	132	return $self;
133	}	133	}
134	# can issue	134	# can issue
135	$debug and warn "do_checkout: calling AddIssue(\$borrower,$barcode, $overridden_duedate, 0)\n"	135	$debug and warn "do_checkout: calling AddIssue(\$borrower,$barcode, $overridden_duedate, 0)\n"
136	# . "w/ \$borrower: " . Dumper($borrower)	136	# . "w/ \$borrower: " . Dumper($borrower)
137	. "w/ C4::Context->userenv: " . Dumper(C4::Context->userenv);	137	. "w/ C4::Context->userenv: " . Dumper(C4::Context->userenv);
138	my $issue = AddIssue( $borrower, $barcode, $overridden_duedate, 0 );	138	my $issue = AddIssue( $borrower, $barcode, $overridden_duedate, 0 );
139	$self->{due} = $self->duedatefromissue($issue, $itemnumber);	139	$self->{due} = $self->duedatefromissue($issue, $itemnumber);
140		140
141	$self->ok(1);	141	$self->ok(1);
142	return $self;	142	return $self;
143	}	143	}
144		144
145	sub _can_we_issue {	145	sub _can_we_issue {

Lines 30-36 use base qw(Net::Server::PreFork); Link Here

(-)a/C4/SIP/SIPServer.pm (-56 / +56 lines)
30	use constant LOG_SIP => "local6"; # Local alias for the logging facility	30	use constant LOG_SIP => "local6"; # Local alias for the logging facility
31		31
32	#	32	#
33	# Main # not really, since package SIPServer	33	# Main # not really, since package SIPServer
34	#	34	#
35	# FIXME: Is this a module or a script?	35	# FIXME: Is this a module or a script?
36	# A script with no MAIN namespace?	36	# A script with no MAIN namespace?
Lines 75-81 foreach my $svc (keys %{$config->{listeners}}) { Link Here
75	#	75	#
76	if (defined($config->{'server-params'})) {	76	if (defined($config->{'server-params'})) {
77	while (my ($key, $val) = each %{$config->{'server-params'}}) {	77	while (my ($key, $val) = each %{$config->{'server-params'}}) {
78	push @parms, $key . '=' . $val;	78	push @parms, $key . '=' . $val;
79	}	79	}
80	}	80	}
81		81
Lines 125-141 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	siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);	128	siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
129	die "process_request: Bad server connection";	129	die "process_request: Bad server connection";
130	}	130	}
131		131
132	$transport = $transports{$self->{service}->{transport}};	132	$transport = $transports{$self->{service}->{transport}};
133		133
134	if (!defined($transport)) {	134	if (!defined($transport)) {
135	siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});	135	siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
136	return;	136	return;
137	} else {	137	} else {
138	&$transport($self);	138	&$transport($self);
139	}	139	}
140	return;	140	return;
141	}	141	}
Lines 201-227 sub raw_transport { Link Here
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	siplog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string);	206	siplog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string);
207	chomp($string);	207	chomp($string);
208	$string =~ s/^[^A-z0-9]+//;	208	$string =~ s/^[^A-z0-9]+//;
209	$string =~ s/[^A-z0-9]+$//;	209	$string =~ s/[^A-z0-9]+$//;
210	siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);	210	siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
211	} else {	211	} else {
212	siplog("LOG_INFO", "get_clean_string called on undefined");	212	siplog("LOG_INFO", "get_clean_string called on undefined");
213	}	213	}
214	return $string;	214	return $string;
215	}	215	}
216		216
217	sub get_clean_input {	217	sub get_clean_input {
218	local $/ = "\012";	218	local $/ = "\012";
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	siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);	222	siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
223	}	223	}
224	return $in;	224	return $in;
225	}	225	}
226		226
227	sub telnet_transport {	227	sub telnet_transport {
Lines 235-281 sub telnet_transport { Link Here
235	siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout");	235	siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout");
236		236
237	eval {	237	eval {
238	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };	238	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
239	local $\| = 1; # Unbuffered output	239	local $\| = 1; # Unbuffered output
240	$/ = "\015"; # Internet Record Separator (lax version)	240	$/ = "\015"; # Internet Record Separator (lax version)
241	# Until the terminal has logged in, we don't trust it	241	# Until the terminal has logged in, we don't trust it
242	# so use a timeout to protect ourselves from hanging.	242	# so use a timeout to protect ourselves from hanging.
243		243
244	while ($strikes--) {	244	while ($strikes--) {
245	print "login: ";	245	print "login: ";
246	alarm $timeout;	246	alarm $timeout;
247	# $uid = &get_clean_input;	247	# $uid = &get_clean_input;
248	$uid = <STDIN>;	248	$uid = <STDIN>;
249	print "password: ";	249	print "password: ";
250	# $pwd = &get_clean_input \|\| '';	250	# $pwd = &get_clean_input \|\| '';
251	$pwd = <STDIN>;	251	$pwd = <STDIN>;
252	alarm 0;	252	alarm 0;
253		253
254	siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));	254	siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
255	$uid = get_clean_string ($uid);	255	$uid = get_clean_string ($uid);
256	$pwd = get_clean_string ($pwd);	256	$pwd = get_clean_string ($pwd);
257	siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));	257	siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
258		258
259	if (exists ($config->{accounts}->{$uid})	259	if (exists ($config->{accounts}->{$uid})
260	&& ($pwd eq $config->{accounts}->{$uid}->{password})) {	260	&& ($pwd eq $config->{accounts}->{$uid}->{password})) {
261	$account = $config->{accounts}->{$uid};	261	$account = $config->{accounts}->{$uid};
262	if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) {	262	if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) {
263	last;	263	last;
264	}	264	}
265	}	265	}
266	siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid\|\|''));	266	siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid\|\|''));
267	print("Invalid login$CRLF");	267	print("Invalid login$CRLF");
268	}	268	}
269	}; # End of eval	269	}; # End of eval
270		270
271	if ($@) {	271	if ($@) {
272	siplog("LOG_ERR", "telnet_transport: Login timed out");	272	siplog("LOG_ERR", "telnet_transport: Login timed out");
273	die "Telnet Login Timed out";	273	die "Telnet Login Timed out";
274	} elsif (!defined($account)) {	274	} elsif (!defined($account)) {
275	siplog("LOG_ERR", "telnet_transport: Login Failed");	275	siplog("LOG_ERR", "telnet_transport: Login Failed");
276	die "Login Failure";	276	die "Login Failure";
277	} else {	277	} else {
278	print "Login OK. Initiating SIP$CRLF";	278	print "Login OK. Initiating SIP$CRLF";
279	}	279	}
280		280
281	$self->{account} = $account;	281	$self->{account} = $account;

Lines 68-76 sub add_field { Link Here

(-)a/C4/SIP/Sip.pm (-9 / +8 lines)
68	my ($i, $ent);	68	my ($i, $ent);
69		69
70	if (!defined($value)) {	70	if (!defined($value)) {
71	siplog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",	71	siplog("LOG_DEBUG", "add_field: Undefined value being added to '%s'",
72	$field_id);	72	$field_id);
73	$value = '';	73	$value = '';
74	}	74	}
75	$value=~s/\r/ /g; # CR terminates a sip message	75	$value=~s/\r/ /g; # CR terminates a sip message
76	# Protect against them in sip text fields	76	# Protect against them in sip text fields
Lines 80-86 sub add_field { Link Here
80	$ent = sprintf("&#%d;", ord($field_delimiter));	80	$ent = sprintf("&#%d;", ord($field_delimiter));
81		81
82	while (($i = index($value, $field_delimiter)) != ($[-1)) {	82	while (($i = index($value, $field_delimiter)) != ($[-1)) {
83	substr($value, $i, 1) = $ent;	83	substr($value, $i, 1) = $ent;
84	}	84	}
85		85
86	return $field_id . $value . $field_delimiter;	86	return $field_id . $value . $field_delimiter;
Lines 122-135 sub add_count { Link Here
122	# If the field is unsupported, it will be undef, return blanks	122	# If the field is unsupported, it will be undef, return blanks
123	# as per the spec.	123	# as per the spec.
124	if (!defined($count)) {	124	if (!defined($count)) {
125	return ' ' x 4;	125	return ' ' x 4;
126	}	126	}
127		127
128	$count = sprintf("%04d", $count);	128	$count = sprintf("%04d", $count);
129	if (length($count) != 4) {	129	if (length($count) != 4) {
130	siplog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",	130	siplog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'",
131	$label, $count);	131	$label, $count);
132	$count = ' ' x 4;	132	$count = ' ' x 4;
133	}	133	}
134	return $count;	134	return $count;
135	}	135	}
136	-