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 . 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;