Koha-clms/Koha/File/Transport.pm

package Koha::File::Transport;

# 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 <https://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::Database;
use Koha::Exceptions::Object;
use Koha::Encryption;

use base qw(Koha::Object);

=head1 NAME

Koha::File::Transport - Base class for file transport handling

=head1 DESCRIPTION

Base class providing common functionality for FTP/SFTP file transport.

=cut

=head1 API

=head2 Class methods

=head3 store

    $server->store;

Overloaded store method that ensures directory paths end with a forward slash.

=cut

sub store {
    my ($self) = @_;

    # Encrypt sensitive data if changed
    $self->_encrypt_sensitive_data();

    # Normalize directory paths
    for my $dir_field (qw(download_directory upload_directory)) {
        my $dir = $self->$dir_field;
        next                            unless $dir && $dir ne '';
        $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) {
        require Koha::BackgroundJob::TestTransport;
        Koha::BackgroundJob::TestTransport->new->enqueue( { transport_id => $self->id } );
    }

    # Return the updated object including the encrypt_sensitive_data
    return $self;
}

=head3 plain_text_password

    my $password = $server->plain_text_password;

Returns the decrypted plaintext password.

=cut

sub plain_text_password {
    my ($self) = @_;
    return unless $self->password;
    return Koha::Encryption->new->decrypt_hex( $self->password );
}

=head3 plain_text_key

    my $key = $server->plain_text_key;

Returns the decrypted plaintext key file.

=cut

sub plain_text_key {
    my ($self) = @_;
    return unless $self->key_file;
    return Koha::Encryption->new->decrypt_hex( $self->key_file ) . "\n";
}

=head3 to_api

    my $json = $transport->to_api;

Returns a JSON representation of the object suitable for API output,
excluding sensitive data.

=cut

sub to_api {
    my ( $self, $params ) = @_;

    my $json = $self->SUPER::to_api($params) or return;
    delete @{$json}{qw(password key_file)};                                    # Remove sensitive data
    $json->{status} = $self->status ? decode_json( $self->status ) : undef;    # Decode json status

    return $json;
}

=head3 to_api_mapping

This method returns the mapping for representing a Koha::File::Transport object
on the API.

=cut

sub to_api_mapping {
    return { id => 'file_transport_id' };
}

=head3 test_connection

    $transport->test_connection

Method to test the connection for the configuration of the current file server

=cut

sub test_connection {
    my ($self) = @_;

    $self->connect or return;

    for my $dir_type (qw(download upload)) {
        my $field = "${dir_type}_directory";
        my $dir   = $self->$field;
        $dir ||= undef;

        $self->change_directory(undef) or next;
        $self->change_directory($dir)  or next;
        $self->list_files()            or next;
    }

    my $return   = 1;
    my $messages = $self->object_messages;
    for my $message ( @{$messages} ) {
        $return = 0 if $message->type eq 'error';
    }

    return $return;
}

=head2 Subclass methods

Interface methods that must be implemented by subclasses

=head3 connect

    $transport->connect();

Method for connecting the current transport to the file server

=cut

sub connect {
    my ($self) = @_;
    die "Subclass must implement connect";
}

=head3 upload_file

    $transport->upload_file($file);

Method for uploading a file to the current file server

=cut

sub upload_file {
    my ( $self, $local_file, $remote_file ) = @_;
    die "Subclass must implement upload_file";
}

=head3 download_file

    $transport->download_file($file);

Method for downloading a file from the current file server

=cut

sub download_file {
    my ( $self, $remote_file, $local_file ) = @_;
    die "Subclass must implement download_file";
}

=head3 change_directory

    my $files = $transport->change_directory($path);

Method for changing the current directory on the connected file server

=cut

sub change_directory {
    my ( $self, $path ) = @_;
    die "Subclass must implement change_directory";
}

=head3 list_files

    my $files = $transport->list_files($path);

Method for listing files in the current directory of the connected file server

=cut

sub list_files {
    my ( $self, $path ) = @_;
    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

Handle encryption of sensitive data

=cut

sub _encrypt_sensitive_data {
    my ($self) = @_;
    my $encryption = Koha::Encryption->new;

    # 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->_result->is_column_changed('key_file') ) && $self->key_file ) {
        $self->key_file( $encryption->encrypt_hex( _dos2unix( $self->key_file ) ) );
    }

    return;
}

=head3 _dos2unix

Return a CR-free string from an input

=cut

sub _dos2unix {
    my $dosStr = shift;

    return $dosStr =~ s/\015\012/\012/gr;
}

=head3 _type

Return type of Object relating to Schema Result

=cut

sub _type {
    return 'FileTransport';
}

1;