Bug 39190: Re-implement the connection testing

We now use background jobs triggered by Transport->store to update the
connection status.

Status is now a json blob with more details, so we update the api
definition to reflect that.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: Lucas Gass <lucas@bywatersolutions.com>

Koha/BackgroundJob.pm

@@ -456,6 +456,7 @@ sub core_types_to_classes {
         marc_import_revert_batch            => 'Koha::BackgroundJob::MARCImportRevertBatch',
         pseudonymize_statistic              => 'Koha::BackgroundJob::PseudonymizeStatistic',
         import_from_kbart_file              => 'Koha::BackgroundJob::ImportKBARTFile',
+        file_transport_test                 => 'Koha::BackgroundJob::TestTransport',
     };
 }
 

Koha/BackgroundJob/TestTransport.pm

@@ -0,0 +1,91 @@
+package Koha::BackgroundJob::TestTransport;
+
+# 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 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.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use JSON qw( decode_json encode_json );
+use Try::Tiny;
+use Koha::File::Transports;
+
+use base 'Koha::BackgroundJob';
+
+=head1 NAME
+
+Koha::BackgroundJob::TestTransport - Background job derived class to test File::Transports
+
+=head1 API
+
+=head2 Class methods
+
+=head3 job_type
+
+Define the job type of this job: file_transport_test
+
+=cut
+
+sub job_type {
+    return 'file_transport_test';
+}
+
+=head3 process
+
+Process the transport test.
+
+=cut
+
+sub process {
+    my ( $self, $args ) = @_;
+    $self->start;
+
+    my $transport = Koha::File::Transports->find( $args->{transport_id} );
+    $transport->test_connection;
+    my $status   = { status => 'ok' };
+    my $messages = $transport->object_messages;
+    for my $message (@$messages) {
+        $status->{status} = 'errors' if $message->{type} eq 'error';
+        push @{ $status->{operations} },
+            { code => $message->{message}, status => $message->{type}, detail => $message->{payload} };
+    }
+    $transport->set( { status => encode_json($status) } )->store();
+
+    my $data = $status;
+    $self->finish($data);
+}
+
+=head3 enqueue
+
+Enqueue the new job
+
+=cut
+
+sub enqueue {
+    my ( $self, $args ) = @_;
+
+    my $transport = $args->{transport_id};
+    Koha::Exceptions::MissingParameter->throw("Missing transport_id parameter is mandatory")
+        unless $transport;
+
+    $self->SUPER::enqueue(
+        {
+            job_size  => 1,
+            job_args  => {%$args},
+            job_queue => 'default',
+        }
+    );
+}
+
+1;

Koha/File/Transport.pm

@@ -16,12 +16,16 @@ package Koha::File::Transport;
 # along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use Modern::Perl;
+
 use constant {
     DEFAULT_TIMEOUT   => 10,
     TEST_FILE_NAME    => '.koha_test_file',
     TEST_FILE_CONTENT => "Hello, world!\n",
 };
+use JSON            qw( decode_json encode_json );
+use List::MoreUtils qw( any );
 
+use Koha::BackgroundJob::TestTransport;
 use Koha::Database;
 use Koha::Exceptions::Object;
 use Koha::Encryption;
@@ -63,11 +67,24 @@ sub store {
         $self->$dir_field( $dir . '/' ) unless substr( $dir, -1 ) eq '/';
     }
 
+    my @config_fields  = (qw(host port user_name password key_file upload_directory download_directory));
+    my $changed_config = ( !$self->in_storage || any { $self->_result->is_column_changed($_) } @config_fields ) ? 1 : 0;
+
     # Store
     $self->SUPER::store;
 
+    # Subclass triggers
+    my $subclass = $self->transport eq 'sftp' ? 'Koha::File::Transport::SFTP' : 'Koha::File::Transport::FTP';
+    $self = $subclass->_new_from_dbic( $self->_result );
+    $self->_post_store_trigger;
+
+    # Enqueue a connection test
+    if ($changed_config) {
+        Koha::BackgroundJob::TestTransport->new->enqueue( { transport_id => $self->id } );
+    }
+
     # Return the updated object including the encrypt_sensitive_data
-    return $self->discard_changes;
+    return $self;
 }
 
 =head3 plain_text_password
@@ -111,7 +128,8 @@ sub to_api {
     my ( $self, $params ) = @_;
 
     my $json = $self->SUPER::to_api($params) or return;
-    delete @{$json}{qw(password key_file)};    # Remove sensitive data
+    delete @{$json}{qw(password key_file)};                                    # Remove sensitive data
+    $json->{status} = $self->status ? decode_json( $self->status ) : undef;    # Decode json status
 
     return $json;
 }
@@ -141,14 +159,22 @@ sub test_connection {
     $self->connect or return;
 
     for my $dir_type (qw(download upload)) {
-        my $dir = $self->{"${dir_type}_directory"};
-        next if $dir eq '';
+        my $field = "${dir_type}_directory";
+        my $dir   = $self->$field;
+        $dir ||= undef;
 
-        $self->change_directory($dir) or return;
-        $self->list_files()           or return;
+        $self->change_directory(undef) or next;
+        $self->change_directory($dir)  or next;
+        $self->list_files()            or next;
     }
 
-    return 1;
+    my $return   = 1;
+    my $messages = $self->object_messages;
+    for my $message ( @{$messages} ) {
+        $return = 0 if $message->type eq 'error';
+    }
+
+    return $return;
 }
 
 =head2 Subclass methods
@@ -220,6 +246,21 @@ sub list_files {
     die "Subclass must implement list_files";
 }
 
+=head3 _post_store_trigger
+
+    $server->_post_store_trigger;
+
+Method triggered by parent store to allow local additions to the store call
+
+=cut
+
+sub _post_store_trigger {
+    my ($self) = @_;
+
+    #Subclass may implement a _post_store_trigger as required
+    return $self;
+}
+
 =head2 Internal methods
 
 =head3 _encrypt_sensitive_data
@@ -232,14 +273,16 @@ sub _encrypt_sensitive_data {
     my ($self) = @_;
     my $encryption = Koha::Encryption->new;
 
-    # Only encrypt if the value has changed (is_changed from Koha::Object)
-    if ( ( !$self->in_storage || $self->is_changed('password') ) && $self->password ) {
+    # Only encrypt if the value has changed ($self->_result->is_column_changed from Koha::Object)
+    if ( ( !$self->in_storage || $self->_result->is_column_changed('password') ) && $self->password ) {
         $self->password( $encryption->encrypt_hex( $self->password ) );
     }
 
-    if ( ( !$self->in_storage || $self->is_changed('key_file') ) && $self->key_file ) {
+    if ( ( !$self->in_storage || $self->_result->is_column_changed('key_file') ) && $self->key_file ) {
         $self->key_file( $encryption->encrypt_hex( _dos2unix( $self->key_file ) ) );
     }
+
+    return;
 }
 
 =head3 _dos2unix

Koha/File/Transport/SFTP.pm

@@ -32,24 +32,6 @@ Koha::File::Transport::SFTP - SFTP implementation of file transport
 
 =head2 Class methods
 
-=head3 store
-
-    $server->store;
-
-Overloaded store method that ensures key_file also gets written to the filesystem.
-
-=cut
-
-sub store {
-    my ($self) = @_;
-
-    $self->SUPER::store;
-    $self->discard_changes;
-    $self->_write_key_file;
-
-    return $self;
-}
-
 =head3 connect
 
     my $success = $self->connect;
@@ -60,25 +42,34 @@ Start the SFTP transport connect, returns true on success or undefined on failur
 
 sub connect {
     my ($self) = @_;
+    my $operation = "connection";
 
+    # String to capture STDERR output
+    $self->{stderr_capture} = '';
+    open my $stderr_fh, '>', \$self->{stderr_capture} or die "Can't open scalar as filehandle: $!";
     $self->{connection} = Net::SFTP::Foreign->new(
         host     => $self->host,
         port     => $self->port,
         user     => $self->user_name,
         password => $self->plain_text_password,
-        key_path => $self->_locate_key_file,
-        timeout  => $self->DEFAULT_TIMEOUT,
-        more     => [qw(-o StrictHostKeyChecking=no)],
+        $self->_locate_key_file ? ( key_path => $self->_locate_key_file ) : (),
+        timeout   => $self->DEFAULT_TIMEOUT,
+        stderr_fh => $stderr_fh,
+        more      => [qw( -v -o StrictHostKeyChecking=no)],
     );
-    $self->{connection}->die_on_error("SFTP failure for remote host");
+    $self->{stderr_fh} = $stderr_fh;
 
-    return $self->_abort_operation() if ( $self->{connection}->error );
+    return $self->_abort_operation($operation) if ( $self->{connection}->error );
 
     $self->add_message(
         {
-            message => $self->{connection}->status,
+            message => $operation,
             type    => 'success',
-            payload => { detail => '' }
+            payload => {
+                status => $self->{connection}->status,
+                error  => $self->{connection}->error,
+                path   => $self->{connection}->cwd
+            }
         }
     );
 
@@ -97,16 +88,21 @@ Returns true on success or undefined on failure.
 
 sub upload_file {
     my ( $self, $local_file, $remote_file ) = @_;
+    my $operation = "upload";
 
     my $logger = Koha::Logger->get_logger();
 
-    $self->{connection}->put( $local_file, $remote_file ) or return $self->_abort_operation();
+    $self->{connection}->put( $local_file, $remote_file ) or return $self->_abort_operation($operation);
 
     $self->add_message(
         {
-            message => $self->{connection}->status,
+            message => $operation,
             type    => 'success',
-            payload => { detail => '' }
+            payload => {
+                status => $self->{connection}->status,
+                error  => $self->{connection}->error,
+                path   => $self->{connection}->cwd
+            }
         }
     );
 
@@ -125,14 +121,19 @@ Returns true on success or undefined on failure.
 
 sub download_file {
     my ( $self, $remote_file, $local_file ) = @_;
+    my $operation = 'download';
 
-    $self->{connection}->get( $remote_file, $local_file ) or return $self->_abort_operation();
+    $self->{connection}->get( $remote_file, $local_file ) or return $self->_abort_operation($operation);
 
     $self->add_message(
         {
-            message => $self->{connection}->status,
+            message => $operation,
             type    => 'success',
-            payload => { detail => '' }
+            payload => {
+                status => $self->{connection}->status,
+                error  => $self->{connection}->error,
+                path   => $self->{connection}->cwd
+            }
         }
     );
 
@@ -151,14 +152,19 @@ Returns true on success or undefined on failure.
 
 sub change_directory {
     my ( $self, $remote_directory ) = @_;
+    my $operation = 'change_directory';
 
-    $self->{connection}->setcwd($remote_directory) or return $self->_abort_operation();
+    $self->{connection}->setcwd($remote_directory) or return $self->_abort_operation( $operation, $remote_directory );
 
     $self->add_message(
         {
-            message => $self->{connection}->status,
+            message => $operation,
             type    => 'success',
-            payload => { detail => '' }
+            payload => {
+                status => $self->{connection}->status,
+                error  => $self->{connection}->error,
+                path   => $self->{connection}->cwd
+            }
         }
     );
 
@@ -175,14 +181,19 @@ Returns an array of filenames found in the current directory of the server conne
 
 sub list_files {
     my ($self) = @_;
+    my $operation = "list";
 
-    my $file_list = $self->{connection}->ls or return $self->_abort_operation();
+    my $file_list = $self->{connection}->ls or return $self->_abort_operation($operation);
 
     $self->add_message(
         {
-            message => $self->{connection}->status,
+            message => $operation,
             type    => 'success',
-            payload => { detail => '' }
+            payload => {
+                status => $self->{connection}->status,
+                error  => $self->{connection}->error,
+                path   => $self->{connection}->cwd
+            }
         }
     );
 
@@ -191,6 +202,21 @@ sub list_files {
 
 =head2 Internal methods
 
+=head3 _post_store_trigger
+
+    $server->post_store_trigger;
+
+Local trigger run by the parent store method after storage.
+Ensures key_file also gets written to the filesystem.
+
+=cut
+
+sub _post_store_trigger {
+    my ($self) = @_;
+    $self->_write_key_file;
+    return $self;
+}
+
 =head3 _write_key_file
 
     my $success = $server->_write_key_file;
@@ -204,6 +230,8 @@ Returns 1 on success, undef on failure.
 sub _write_key_file {
     my ($self) = @_;
 
+    return unless $self->plain_text_key;
+
     my $upload_path = C4::Context->config('upload_path') or return;
     my $logger      = Koha::Logger->get;
     my $key_path    = File::Spec->catdir( $upload_path, 'ssh_keys' );
@@ -254,13 +282,21 @@ Helper method to abort the current operation and return.
 =cut
 
 sub _abort_operation {
-    my ($self) = @_;
+    my ( $self, $operation, $path ) = @_;
+
+    my $stderr = $self->{stderr_capture};
+    $self->{stderr_capture} = '';
 
     $self->add_message(
         {
-            message => $self->{connection}->error,
+            message => $operation,
             type    => 'error',
-            payload => { detail => $self->{connection} ? $self->{connection}->status : '' }
+            payload => {
+                status    => $self->{connection}->status,
+                error     => $self->{connection}->error,
+                path      => $path ? $path : $self->{connection}->cwd,
+                error_raw => $stderr
+            }
         }
     );
 
@@ -271,4 +307,19 @@ sub _abort_operation {
     return;
 }
 
+=head3 DESTROY
+
+Ensure proper cleanup of open filehandles
+
+=cut
+
+sub DESTROY {
+    my ($self) = @_;
+
+    # Ensure the filehandle is closed properly
+    if ( $self->{stderr_fh} ) {
+        close $self->{stderr_fh} or warn "Failed to close STDERR filehandle: $!";
+    }
+}
+
 1;

Koha/SFTP/Server.pm

@@ -409,12 +409,12 @@ sub test_conn {
         }
     }
 
-    $self->update_status('tests_ok');
-    foreach my $val ( values %$sftp_test_results ) {
-        if ( defined $val->{'err'} ) {
-            $self->update_status('tests_failed');
-        }
-    }
+    #    $self->update_status('tests_ok');
+    #    foreach my $val ( values %$sftp_test_results ) {
+    #        if ( defined $val->{'err'} ) {
+    #            $self->update_status('tests_failed');
+    #        }
+    #    }
 
     return ( 1, $sftp_test_results );
 }

admin/sftp_servers.pl

@@ -192,25 +192,6 @@ if ( $op eq 'cud-add' ) {
             reason => 'invalid_id'
         };
     }
-
-} elsif ( $op eq 'test_form' ) {
-    my $sftp_server_id = $input->param('sftp_server_id');
-    my $sftp_server;
-
-    $sftp_server = Koha::File::Transports->find($sftp_server_id)
-        unless !$sftp_server_id;
-
-    if ($sftp_server) {
-        $template->param(
-            sftp_server => $sftp_server,
-        );
-    } else {
-        push @messages, {
-            type   => 'alert',
-            code   => 'error_on_test',
-            reason => 'invalid_id',
-        };
-    }
 }
 
 if ( $op eq 'list' ) {

api/v1/swagger/definitions/sftp_server.yaml

@@ -58,7 +58,7 @@ properties:
     description: Path on the remote server we upload to (optional)
   status:
     type:
-      - string
+      - object
       - "null"
     description: Most recent status of the FTP/SFTP server (optional)
   debug:

koha-tmpl/intranet-tmpl/prog/en/includes/background_jobs/file_transport_test.inc

@@ -0,0 +1,48 @@
+[% USE Koha %]
+
+[%- BLOCK operation_description -%]
+    [%- SWITCH operation.code -%]
+
+    [%- CASE 'connection' -%]
+        <span>Connection</span>
+    [%- CASE 'upload' -%]
+        <span>Upload</span>
+    [%- CASE 'download' -%]
+        <span>Download</span>
+    [%- CASE 'list' -%]
+        <span>List files</span>
+    [%- CASE 'change_directory' -%]
+        <span>Change directory</span>
+    [%- CASE -%]
+        <span>[% operation.code | html %]</span>
+    [%- END -%]
+[%- END -%]
+
+[% SET report = job.decoded_data %]
+[% BLOCK report %]
+    [% IF job.status == 'finished' %]
+        [% IF report.status == 'errors' %]
+            <div class="alert alert-alert"> Connection test completed with errors </div>
+        [% ELSE %]
+            <div class="alert alert-success"> Connection test completed without errors </div>
+        [% END %]
+    [% ELSIF job.status == 'cancelled' %]
+        <span>The connection test was cancelled before it finished.</span>
+    [% END %]
+[% END %]
+
+[% BLOCK detail %]
+    [% FOREACH operation IN report.operations %]
+        [% IF operation.status == 'error' %]
+            <div class="text-danger"> <i class="fa-solid fa-circle-xmark"></i> [% PROCESS operation_description %] failed. </div>
+        [% ELSE %]
+            <div class="text-success"> <i class="fa-solid fa-circle-check"></i> [% PROCESS operation_description %] passed. </div>
+        [% END %]
+    [% END %]
+    [% IF job.status == 'cancelled' %]
+        <span>The connection test was cancelled before it finished.</span>
+    [% END %]
+[% END %]
+
+[% BLOCK js %]
+[% END %]

koha-tmpl/intranet-tmpl/prog/en/modules/admin/background_jobs.tt

@@ -226,6 +226,10 @@
                 '_id': 'import_from_kbart_file',
                 '_str': _("Import titles from a KBART file").escapeHtml()
             },
+            {
+                '_id': 'file_transport_test',
+                '_str': _("File transport connection test")
+            },
             [% FOR job_type IN plugin_job_types %]
             {
                 '_id': '[% job_type.id | html %]',

koha-tmpl/intranet-tmpl/prog/js/transport_status.js

@@ -0,0 +1,7 @@
+let operationLabels = {
+    connection: __("Connection"),
+    upload: __("Upload"),
+    download: __("Download"),
+    list: __("List Files"),
+    change_directory: __("Change Directory"),
+};