#
# This file is part of Koha.
#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
use strict;
use warnings;
-use Getopt::Long;
+use Getopt::Long qw( GetOptions );
my ($help, $config, $daemon);
add_only_for_matches, add_only_for_new or ignore
import_mode - stage or direct
framework - to be used if import_mode is direct
+ connexion_user - User sent from connexion client
+ connexion_password - Password sent from connexion client
+
+ Note: If connexion parameters are not defined request authentication will not be checked
+ You should specify a different user for connexion to protect the Koha credentials
All process related parameters (all but ip and port) have default values as
per Koha import process.
{
package ImportProxyServer;
-use Carp;
-use IO::Socket::INET;
+use Carp qw( croak );
+use IO::Socket::INET qw( SOCK_STREAM );
# use IO::Socket::IP;
use IO::Select;
-use POSIX;
-use HTTP::Status qw(:constants);
+use POSIX qw( close exit fork localtime open printf sprintf );
+use HTTP::Status qw( HTTP_FORBIDDEN HTTP_UNAUTHORIZED );
+use strict;
+use warnings;
use LWP::UserAgent;
-use XML::Simple;
+use XML::Simple qw( XMLin );
+use MARC::Record;
+use MARC::File::XML;
use constant CLIENT_READ_TIMEOUT => 5;
-use constant CLIENT_READ_BUFFER_SIZE => 4 * 1024;
+use constant CLIENT_READ_BUFFER_SIZE => 100000;
use constant AUTH_URI => "/cgi-bin/koha/mainpage.pl";
use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
die "Invalid config line $line: $_" unless defined $v;
$param{$p} = $v;
}
+ close($conf_fh);
$self->{koha} = delete( $param{koha} )
or die "No koha base url in config file";
$self->{password} = delete( $param{password} )
or die "No koha user password in config file";
+ if( defined $param{connexion_user} || defined $param{connexion_password}){
+ # If either is defined we expect both
+ $self->{connexion_user} = delete( $param{connexion_user} )
+ or die "No koha connexion_user in config file";
+ $self->{connexion_password} = delete( $param{connexion_password} )
+ or die "No koha user connexion_password in config file";
+ }
+
$self->{host} = delete( $param{host} );
$self->{port} = delete( $param{port} )
or die "Port not specified";
sub read_request {
my ( $self, $io ) = @_;
- my ($in, @in, $timeout);
+ my ($in, @in_arr, $timeout, $bad_marc);
my $select = IO::Select->new($io) ;
while ( "FOREVER" ) {
if ( $select->can_read(CLIENT_READ_TIMEOUT) ){
# XXX ignore after NULL
if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
- push @in, $1;
+ push @in_arr, $1;
last;
}
- push @in, $in;
+ push @in_arr, $in;
}
else {
- $timeout = 1;
last;
}
}
- $in = join '', @in;
-
+ $in = join '', @in_arr;
+ $in =~ m/(.)$/;
+ my $lastchar = $1;
my ($xml, $user, $password, $local_user);
my $data = $in; # copy for diagmostic purposes
- while ( my $first = substr( $data, 0, 1 ) ) {
+ while () {
+ my $first = substr( $data, 0, 1 );
+ if (!defined $first) {
+ last;
+ }
$first eq 'U' && do {
($user, $data) = _trim_identifier($data);
next;
next;
};
$first eq 'P' && do {
- ($password,, $data) = _trim_identifier($data);
+ ($password, $data) = _trim_identifier($data);
next;
};
$first eq ' ' && do {
$data = substr( $data, 1 ); # trim
next;
};
- $first eq '<' && do {
- $xml = $data;
+ $data =~ m/^[0-9]/ && do {
+ # What we have here might be a MARC record...
+ my $marc_record;
+ eval { $marc_record = MARC::Record->new_from_usmarc($data); };
+ if ($@) {
+ $bad_marc = 1;
+ }
+ else {
+ $xml = $marc_record->as_xml();
+ }
last;
};
-
last; # unexpected input
}
my @details;
push @details, "Timeout" if $timeout;
+ push @details, "Bad MARC" if $bad_marc;
push @details, "User: $user" if $user;
push @details, "Password: " . ( $self->{debug} ? $password : ("x" x length($password)) ) if $password;
push @details, "Local user: $local_user" if $local_user;
+ push @details, "XML: $xml" if $xml;
+ push @details, "Remaining data: $data" if ($data && !$xml);
unless ($xml) {
$self->log("Invalid request", $in, @details);
return;
}
+ $user = $local_user if !$user && $local_user;
$self->log("Request", @details);
$self->log($in) if $self->{debug};
}
sub _trim_identifier {
- my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
-
- return ( substr( $_[0], 2, $len ), substr( $_[0], 2 + $len ) );
+ #my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
+ my $len=ord(substr ($_[0], 1, 1)) - 64;
+ if ($len <0) { #length is numeric, and thus comes from the web client, not the desktop client.
+ $_[0] =~ m/.(\d+)/;
+ $len = $1;
+ return ( substr( $_[0], length($len)+1 , $len ), substr( $_[0], length($len) + 1 + $len ) );
+ }
+ return ( substr( $_[0], 2 , $len ), substr( $_[0], 2 + $len ) );
}
sub handle_request {
my ( $self, $io ) = @_;
-
my ($data, $user, $password) = $self->read_request($io)
or return $self->error_response("Bad request");
+ unless(
+ !(defined $self->{connexion_user}) ||
+ ($user eq $self->{connexion_user} && $password eq $self->{connexion_password})
+ ){
+ return $self->error_response("Unauthorized request");
+ }
+
my $ua;
if ($self->{user}) {
$user = $self->{user};
}
my $base_url = $self->{koha};
- my $resp = $ua->post( $base_url.IMPORT_SVC_URI, $self->{params}, 'Content-Type' => 'text/plain', Content => $data );
+ my $resp = $ua->post( $base_url.IMPORT_SVC_URI,
+ {'nomatch_action' => $self->{params}->{nomatch_action},
+ 'overlay_action' => $self->{params}->{overlay_action},
+ 'match' => $self->{params}->{match},
+ 'import_mode' => $self->{params}->{import_mode},
+ 'framework' => $self->{params}->{framework},
+ 'item_action' => $self->{params}->{item_action},
+ 'xml' => $data});
+
my $status = $resp->code;
if ($status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN) {
my $user = $self->{user};
my $password = $self->{password};
$resp = $ua->post( $base_url.AUTH_URI, { userid => $user, password => $password } );
- $resp = $ua->post( $base_url.IMPORT_SVC_URI, $self->{params}, 'Content-Type' => 'text/plain', Content => $data )
+ $resp = $ua->post( $base_url.IMPORT_SVC_URI,
+ {'nomatch_action' => $self->{params}->{nomatch_action},
+ 'overlay_action' => $self->{params}->{overlay_action},
+ 'match' => $self->{params}->{match},
+ 'import_mode' => $self->{params}->{import_mode},
+ 'framework' => $self->{params}->{framework},
+ 'item_action' => $self->{params}->{item_action},
+ 'xml' => $data})
if $resp->is_success;
}
unless ($resp->is_success) {
return $self->error_response("Unsuccessful request");
}
- my ($koha_status, $bib, $batch_id, $error);
+ my ($koha_status, $bib, $overlay, $batch_id, $error, $url);
if ( my $r = eval { XMLin($resp->content) } ) {
$koha_status = $r->{status};
$batch_id = $r->{import_batch_id};
$error = $r->{error};
+ $bib = $r->{biblionumber};
+ $overlay = $r->{match_status};
+ $url = $r->{url};
}
else {
$koha_status = "error";
}
if ($koha_status eq "ok") {
- return $self->response( sprintf( "Success. Import batch id: %s", $batch_id ) );
+ my $response_string = sprintf( "Success. Batch number %s - biblio record number %s",
+ $batch_id,$bib);
+ $response_string .= $overlay eq 'no_match' ? ' added to Koha.' : ' overlaid by import.';
+ $response_string .= "\n\n$url";
+
+ return $self->response( $response_string );
}
return $self->error_response( sprintf( "%s. Please contact administrator.", $error ) );
projects / srvgit / blobdiff