From f5cb58c03d2b4d4f8555fefd86fd5dd68b460b53 Mon Sep 17 00:00:00 2001 From: Nick Clemens Date: Fri, 9 Aug 2024 10:58:23 +0000 Subject: [PATCH] Bug 37543: (follow-up) Tidy Tidy the whole thing Signed-off-by: Nick Clemens Signed-off-by: Paul Derscheid --- misc/bin/connexion_import_daemon.pl | 638 ++++++++++++++-------------- 1 file changed, 321 insertions(+), 317 deletions(-) diff --git a/misc/bin/connexion_import_daemon.pl b/misc/bin/connexion_import_daemon.pl index a4754a8229..0ab2da42ab 100755 --- a/misc/bin/connexion_import_daemon.pl +++ b/misc/bin/connexion_import_daemon.pl @@ -22,12 +22,12 @@ use warnings; use Getopt::Long qw( GetOptions ); -my ($help, $config, $daemon); +my ( $help, $config, $daemon ); GetOptions( - 'config|c=s' => \$config, - 'daemon|d' => \$daemon, - 'help|?' => \$help, + 'config|c=s' => \$config, + 'daemon|d' => \$daemon, + 'help|?' => \$help, ); if ( $help || !$config ) { @@ -86,372 +86,376 @@ if ($daemon) { exit; { -package ImportProxyServer; - -use Carp qw( croak ); -use IO::Socket::INET qw( SOCK_STREAM ); -# use IO::Socket::IP; -use IO::Select; -use POSIX; -use HTTP::Status qw( HTTP_FORBIDDEN HTTP_UNAUTHORIZED ); -use strict; -use warnings; -use LWP::UserAgent; -use XML::Simple qw( XMLin ); -use MARC::Record; -use MARC::File::XML; + package ImportProxyServer; -use constant CLIENT_READ_TIMEOUT => 5; -use constant CLIENT_READ_BUFFER_SIZE => 100000; -use constant AUTH_URI => "/cgi-bin/koha/svc/authentication"; -use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib"; + use Carp qw( croak ); + use IO::Socket::INET qw( SOCK_STREAM ); -sub new { - my $class = shift; - my $config_file = shift or croak "No config file"; + # use IO::Socket::IP; + use IO::Select; + use POSIX; + use HTTP::Status qw( HTTP_FORBIDDEN HTTP_UNAUTHORIZED ); + use strict; + use warnings; - my $self = {time_to_die => 0, config_file => $config_file }; - bless $self, $class; + use LWP::UserAgent; + use XML::Simple qw( XMLin ); + use MARC::Record; + use MARC::File::XML; - $self->parse_config; - return $self; -} + use constant CLIENT_READ_TIMEOUT => 5; + use constant CLIENT_READ_BUFFER_SIZE => 100000; + use constant AUTH_URI => "/cgi-bin/koha/svc/authentication"; + use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib"; -sub parse_config { - my $self = shift; + sub new { + my $class = shift; + my $config_file = shift or croak "No config file"; - my $config_file = $self->{config_file}; + my $self = { time_to_die => 0, config_file => $config_file }; + bless $self, $class; - open (my $conf_fh, '<', $config_file) or die "Cannot open config file $config: $!"; + $self->parse_config; + return $self; + } - my %param; - my $line = 0; - while (<$conf_fh>) { - $line++; - chomp; - s/\s*#.*//o; # remove comments - s/^\s+//o; # trim leading spaces - s/\s+$//o; # trim trailing spaces - next unless $_; + sub parse_config { + my $self = shift; - my ($p, $v) = m/(\S+?):\s*(.*)/o; - 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->{user} = delete( $param{user} ) - or die "No koha user 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"; - } + my $config_file = $self->{config_file}; - $self->{host} = delete( $param{host} ); - $self->{port} = delete( $param{port} ) - or die "Port not specified"; + open( my $conf_fh, '<', $config_file ) or die "Cannot open config file $config: $!"; - $self->{debug} = delete( $param{debug} ); + my %param; + my $line = 0; + while (<$conf_fh>) { + $line++; + chomp; + s/\s*#.*//o; # remove comments + s/^\s+//o; # trim leading spaces + s/\s+$//o; # trim trailing spaces + next unless $_; - my $log_fh; - close $self->{log_fh} if $self->{log_fh}; - if (my $logfile = delete $param{log}) { - open ($log_fh, '>>', $logfile) or die "Cannot open $logfile for write: $!"; - } else { - $log_fh = \*STDERR; - } - $self->{log_fh} = $log_fh; + my ( $p, $v ) = m/(\S+?):\s*(.*)/o; + 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->{user} = delete( $param{user} ) + or die "No koha user 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->{params} = \%param; -} + $self->{host} = delete( $param{host} ); + $self->{port} = delete( $param{port} ) + or die "Port not specified"; -sub log { - my $self = shift; - my $log_fh = $self->{log_fh} - or warn "No log fh", - return; - my $t = localtime; - print $log_fh map "$t: $_\n", @_; -} + $self->{debug} = delete( $param{debug} ); -sub background { - my $self = shift; + my $log_fh; + close $self->{log_fh} if $self->{log_fh}; + if ( my $logfile = delete $param{log} ) { + open( $log_fh, '>>', $logfile ) or die "Cannot open $logfile for write: $!"; + } else { + $log_fh = \*STDERR; + } + $self->{log_fh} = $log_fh; - my $pid = fork; - return ($pid) if $pid; # parent + $self->{params} = \%param; + } - die "Couldn't fork: $!" unless defined($pid); + sub log { + my $self = shift; + my $log_fh = $self->{log_fh} + or warn "No log fh", + return; + my $t = localtime; + print $log_fh map "$t: $_\n", @_; + } - POSIX::setsid() or die "Can't start a new session: $!"; + sub background { + my $self = shift; - $SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 }; - # trap or ignore $SIG{PIPE} - $SIG{USR1} = sub { $self->parse_config }; + my $pid = fork; + return ($pid) if $pid; # parent - $self->run; -} + die "Couldn't fork: $!" unless defined($pid); -sub run { - my $self = shift; - - my $server_port = $self->{port}; - my $server_host = $self->{host}; - - my $server = IO::Socket::INET->new( - LocalHost => $server_host, - LocalPort => $server_port, - Type => SOCK_STREAM, - Proto => "tcp", - Listen => 12, - Blocking => 1, - ReuseAddr => 1, - ) or die "Couldn't be a tcp server on port $server_port: $! $@"; - - $self->log("Started tcp listener on $server_host:$server_port"); - - $self->{ua} = _ua(); - - while ("FOREVER") { - my $client = $server->accept() - or die "Cannot accept: $!"; - my $oldfh = select($client); - $self->handle_request($client); - select($oldfh); - last if $self->{time_to_die}; - } + POSIX::setsid() or die "Can't start a new session: $!"; - close($server); -} + $SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 }; -sub _ua { - my $ua = LWP::UserAgent->new; - $ua->timeout(10); - $ua->cookie_jar({}); - return $ua; -} + # trap or ignore $SIG{PIPE} + $SIG{USR1} = sub { $self->parse_config }; -sub get_current_csrf_token { - my $self = shift; - my $ua = $self->{ua}; - my $url = $self->{koha} . AUTH_URI; - return $ua->get($url)->header('CSRF-TOKEN'); -} + $self->run; + } -sub authenticate { - my $self = shift; - my $ua = $self->{ua}; - my $url = $self->{koha} . AUTH_URI; - my $resp = $ua->post( - $url, - { - login_userid => $self->{user}, - login_password => $self->{password}, - csrf_token => $self->get_current_csrf_token, + sub run { + my $self = shift; + + my $server_port = $self->{port}; + my $server_host = $self->{host}; + + my $server = IO::Socket::INET->new( + LocalHost => $server_host, + LocalPort => $server_port, + Type => SOCK_STREAM, + Proto => "tcp", + Listen => 12, + Blocking => 1, + ReuseAddr => 1, + ) or die "Couldn't be a tcp server on port $server_port: $! $@"; + + $self->log("Started tcp listener on $server_host:$server_port"); + + $self->{ua} = _ua(); + + while ("FOREVER") { + my $client = $server->accept() + or die "Cannot accept: $!"; + my $oldfh = select($client); + $self->handle_request($client); + select($oldfh); + last if $self->{time_to_die}; } - ); - if ( !$resp->is_success ) { - $self->log("Authentication failed", $resp->request->as_string, $resp->as_string); - return; + + close($server); } - return $resp->header('CSRF-TOKEN'); -} -sub read_request { - my ( $self, $io ) = @_; + sub _ua { + my $ua = LWP::UserAgent->new; + $ua->timeout(10); + $ua->cookie_jar( {} ); + return $ua; + } - my ($in, @in_arr, $timeout, $bad_marc); - my $select = IO::Select->new($io) ; - while ( "FOREVER" ) { - if ( $select->can_read(CLIENT_READ_TIMEOUT) ){ - $io->recv($in, CLIENT_READ_BUFFER_SIZE); - last unless $in; + sub get_current_csrf_token { + my $self = shift; + my $ua = $self->{ua}; + my $url = $self->{koha} . AUTH_URI; + return $ua->get($url)->header('CSRF-TOKEN'); + } - # XXX ignore after NULL - if ( $in =~ m/^(.*)\000/so ) { # null received, EOT - push @in_arr, $1; - last; + sub authenticate { + my $self = shift; + my $ua = $self->{ua}; + my $url = $self->{koha} . AUTH_URI; + my $resp = $ua->post( + $url, + { + login_userid => $self->{user}, + login_password => $self->{password}, + csrf_token => $self->get_current_csrf_token, } - push @in_arr, $in; - } - else { - last; + ); + if ( !$resp->is_success ) { + $self->log( "Authentication failed", $resp->request->as_string, $resp->as_string ); + return; } + return $resp->header('CSRF-TOKEN'); } - $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 ); - if (!defined $first) { - last; - } - $first eq 'U' && do { - ($user, $data) = _trim_identifier($data); - next; - }; - $first eq 'A' && do { - ($local_user, $data) = _trim_identifier($data); - next; - }; - $first eq 'P' && do { - ($password, $data) = _trim_identifier($data); - next; - }; - $first eq ' ' && do { - $data = substr( $data, 1 ); # trim - next; - }; - $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; + sub read_request { + my ( $self, $io ) = @_; + + my ( $in, @in_arr, $timeout, $bad_marc ); + my $select = IO::Select->new($io); + while ("FOREVER") { + if ( $select->can_read(CLIENT_READ_TIMEOUT) ) { + $io->recv( $in, CLIENT_READ_BUFFER_SIZE ); + last unless $in; + + # XXX ignore after NULL + if ( $in =~ m/^(.*)\000/so ) { # null received, EOT + push @in_arr, $1; + last; + } + push @in_arr, $in; + } else { + last; } - else { - $xml = $marc_record->as_xml(); + } + + $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 ); + if ( !defined $first ) { + last; } - last; - }; - last; # unexpected input - } + $first eq 'U' && do { + ( $user, $data ) = _trim_identifier($data); + next; + }; + $first eq 'A' && do { + ( $local_user, $data ) = _trim_identifier($data); + next; + }; + $first eq 'P' && do { + ( $password, $data ) = _trim_identifier($data); + next; + }; + $first eq ' ' && do { + $data = substr( $data, 1 ); # trim + next; + }; + $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; + 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}; + return ( $xml, $user, $password ); } - $user = $local_user if !$user && $local_user; - $self->log("Request", @details); - $self->log($in) if $self->{debug}; - return ($xml, $user, $password); -} + sub _trim_identifier { -sub _trim_identifier { - #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 ) ); + #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 ) ); } - 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"); + 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"); - } + 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}; - $password = $self->{password}; - $ua = $self->{ua}; - } - else { - $ua = _ua(); # fresh one, needs to authenticate - } + my $ua; + if ( $self->{user} ) { + $user = $self->{user}; + $password = $self->{password}; + $ua = $self->{ua}; + } else { + $ua = _ua(); # fresh one, needs to authenticate + } + + my $base_url = $self->{koha}; + my $post_body = { + '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}, + 'overlay_framework' => $self->{params}->{overlay_framework}, + 'item_action' => $self->{params}->{item_action}, + 'xml' => $data + }; - my $base_url = $self->{koha}; - my $post_body = { - '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}, - 'overlay_framework' => $self->{params}->{overlay_framework}, - 'item_action' => $self->{params}->{item_action}, - 'xml' => $data - }; - - # If we have a token, try it, else, authenticate for the first time. - $self->{csrf_token} = $self->authenticate unless $self->{csrf_token}; - my $resp = $ua->post( - $base_url . IMPORT_SVC_URI, - $post_body, - csrf_token => $self->{csrf_token}, - ); - - my $status = $resp->code; - if ( $status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN ) { - # Our token might have expired. Re-authenticate and post again. - $self->{csrf_token} = $self->authenticate; - $resp = $ua->post( + # If we have a token, try it, else, authenticate for the first time. + $self->{csrf_token} = $self->authenticate unless $self->{csrf_token}; + my $resp = $ua->post( $base_url . IMPORT_SVC_URI, $post_body, csrf_token => $self->{csrf_token}, - ) - } - unless ($resp->is_success) { - $self->log("Unsuccessful request", $resp->request->as_string, $resp->as_string); - return $self->error_response("Unsuccessful request"); - } + ); + + my $status = $resp->code; + if ( $status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN ) { + + # Our token might have expired. Re-authenticate and post again. + $self->{csrf_token} = $self->authenticate; + $resp = $ua->post( + $base_url . IMPORT_SVC_URI, + $post_body, + csrf_token => $self->{csrf_token}, + ); + } + unless ( $resp->is_success ) { + $self->log( "Unsuccessful request", $resp->request->as_string, $resp->as_string ); + return $self->error_response("Unsuccessful request"); + } - 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"; - $self->log("Response format error:\n$resp->content"); - return $self->error_response("Invalid response"); - } + 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"; + $self->log("Response format error:\n$resp->content"); + return $self->error_response("Invalid response"); + } - if ($koha_status eq "ok") { - 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"; + if ( $koha_status eq "ok" ) { + 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 ) ); -} + return $self->response($response_string); + } -sub error_response { - my $self = shift; - $self->response(@_); -} + return $self->error_response( sprintf( "%s. Please contact administrator.", $error ) ); + } -sub response { - my $self = shift; - $self->log("Response: $_[0]"); - printf $_[0] . "\0"; -} + sub error_response { + my $self = shift; + $self->response(@_); + } + sub response { + my $self = shift; + $self->log("Response: $_[0]"); + printf $_[0] . "\0"; + } -} # package +} # package -- 2.46.0