Bug 43078: Unify file transport list_files() across FTP, Local and SFTP
Net::SFTP::Foreign's ls() returned file metadata with size, permissions
and modification time nested inside a Net::SFTP::Foreign::Attributes
object, while FTP and Local returned flat hash keys and silently
dropped directories. Callers of list_files() needed backend-specific
parsing to get at file metadata or to know a directory even existed,
defeating the purpose of the shared transport API.
All three transports now return the same flat hashref shape per entry:
filename, longname, size, perms, mtime, type ('file'/'directory'/
'other'). Directories are included everywhere; '.' and '..' remain
excluded everywhere. FTP's MLSD path prefers the UNIX.mode fact for
exact Unix permissions, falling back to an approximation from the RFC
3659 perm capability fact when UNIX.mode isn't available, and parses
the modify fact into mtime; its NLST fallback (servers without MLSD)
probes each entry with SIZE/MDTM to recover size, mtime and a
best-effort type.
Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Andrew Fuerste Henry <andrew@bywatersolutions.com>
Signed-off-by: Lucas Gass <lucas@bywatersolutions.com>
This commit is contained in:
Martin Renvoize
Lucas Gass
parent
c9b1c20c6f
commit
2f1eb2db84
|
|
@ -17,6 +17,7 @@ package Koha::File::Transport::FTP;
|
|||
|
||||
use Modern::Perl;
|
||||
use Net::FTP;
|
||||
use Time::Local qw( timegm );
|
||||
use Try::Tiny;
|
||||
|
||||
use base qw(Koha::File::Transport);
|
||||
|
|
@ -156,7 +157,7 @@ sub _change_directory {
|
|||
|
||||
Internal method that performs the FTP-specific file listing operation.
|
||||
Returns an array reference of hashrefs with file information.
|
||||
Each hashref contains: filename, longname, size, perms.
|
||||
Each hashref contains: filename, longname, size, perms, mtime, type.
|
||||
|
||||
The listing is obtained with MLSD (RFC 3659), whose machine-readable output
|
||||
is locale- and platform-independent and gives us the filename unambiguously
|
||||
|
|
@ -171,9 +172,7 @@ rmdir() uses for MLSD. That interface has been stable for many releases.
|
|||
|
||||
The hashref shape is kept consistent with the SFTP and Local transports so
|
||||
that consumers of list_files() (including out-of-tree ones) can rely on the
|
||||
same structure regardless of transport type. Note that over MLSD the perms
|
||||
value is the RFC 3659 "perm" fact (e.g. "adfr"), not a Unix mode string, and
|
||||
size is only present when the server reports it.
|
||||
same structure regardless of transport type.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -200,21 +199,44 @@ sub _list_files {
|
|||
map { my ( $k, $v ) = split /=/, $_, 2; ( lc($k) => $v ) }
|
||||
grep { length } split /;/, $facts_str;
|
||||
|
||||
# Skip the directory itself, its parent and any subdirectories
|
||||
next if ( $fact{type} // q{} ) =~ /^(?:dir|cdir|pdir)$/i;
|
||||
# Skip only the current/parent directory pseudo-entries; real
|
||||
# subdirectories (type=dir) are now included like Local and SFTP.
|
||||
next if ( $fact{type} // q{} ) =~ /^(?:cdir|pdir)$/i;
|
||||
|
||||
my $type =
|
||||
( $fact{type} // q{} ) eq 'file' ? 'file'
|
||||
: ( $fact{type} // q{} ) eq 'dir' ? 'directory'
|
||||
: 'other';
|
||||
|
||||
my $perms = $self->_perms_from_mlsd_facts( \%fact, $type );
|
||||
push @file_list, {
|
||||
filename => $filename,
|
||||
longname => $line,
|
||||
size => $fact{size},
|
||||
perms => $fact{perm}
|
||||
perms => $perms,
|
||||
mtime => $self->_mtime_from_mlsd_fact( $fact{modify} ),
|
||||
type => $type,
|
||||
};
|
||||
}
|
||||
} else {
|
||||
|
||||
# Fallback for servers without MLSD: NLST returns bare filenames only.
|
||||
# Fallback for servers without MLSD: NLST returns bare filenames
|
||||
# only, so probe each entry with SIZE/MDTM (both plain Net::FTP
|
||||
# methods) to recover size, mtime and a best-effort type. A
|
||||
# permission-denied file would be misclassified as a directory here
|
||||
# (SIZE failing is the only signal available) - a rare, accepted
|
||||
# limitation of this legacy fallback path. perms stays undef: there
|
||||
# is no way to get Unix permission bits without MLSD/UNIX.mode.
|
||||
my $names = $self->{connection}->ls or return $self->_abort_operation($operation);
|
||||
@file_list = map { { filename => $_ } } grep { !/^[.]{1,2}$/ } @{$names};
|
||||
foreach my $name ( grep { !/^[.]{1,2}$/ } @{$names} ) {
|
||||
my $size = $self->{connection}->size($name);
|
||||
push @file_list, {
|
||||
filename => $name,
|
||||
size => $size,
|
||||
mtime => $self->{connection}->mdtm($name),
|
||||
type => defined $size ? 'file' : 'directory',
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
$self->add_message(
|
||||
|
|
@ -231,6 +253,60 @@ sub _list_files {
|
|||
return \@file_list;
|
||||
}
|
||||
|
||||
=head3 _perms_from_mlsd_facts
|
||||
|
||||
my $perms = $self->_perms_from_mlsd_facts( \%fact, $type );
|
||||
|
||||
Converts MLSD facts into the same C<"%04o"> Unix permission-bits string used
|
||||
by the Local and SFTP transports.
|
||||
|
||||
Prefers the C<UNIX.mode> vendor-extension fact (exact Unix octal
|
||||
permissions) when the server provides it. Otherwise approximates from the
|
||||
RFC 3659 C<perm> fact, which describes only what the connected user is
|
||||
allowed to do (append/create/delete/rename/list/mkdir/read/write/etc.), not
|
||||
a real owner/group/other split - the resulting triad is mirrored across
|
||||
owner/group/other since that distinction isn't available. Returns undef if
|
||||
neither fact is present.
|
||||
|
||||
=cut
|
||||
|
||||
sub _perms_from_mlsd_facts {
|
||||
my ( $self, $fact, $type ) = @_;
|
||||
|
||||
if ( defined $fact->{'unix.mode'} ) {
|
||||
return sprintf( "%04o", oct( $fact->{'unix.mode'} ) & oct('07777') );
|
||||
}
|
||||
|
||||
my $perm = $fact->{perm};
|
||||
return unless defined $perm;
|
||||
|
||||
my $bits = 0;
|
||||
$bits |= 4 if $perm =~ /r/;
|
||||
$bits |= 2 if $perm =~ /[wa]/;
|
||||
$bits |= 1 if $type eq 'directory' && $perm =~ /e/;
|
||||
|
||||
return sprintf( "%04o", ( $bits << 6 ) | ( $bits << 3 ) | $bits );
|
||||
}
|
||||
|
||||
=head3 _mtime_from_mlsd_fact
|
||||
|
||||
my $mtime = $self->_mtime_from_mlsd_fact( $fact->{modify} );
|
||||
|
||||
Converts an MLSD C<modify> fact (RFC 3659 C<YYYYMMDDHHMMSS[.sss]> format,
|
||||
always UTC) into a Unix epoch timestamp. Returns undef if the fact is
|
||||
missing or doesn't match the expected format.
|
||||
|
||||
=cut
|
||||
|
||||
sub _mtime_from_mlsd_fact {
|
||||
my ( $self, $modify ) = @_;
|
||||
|
||||
return unless defined $modify;
|
||||
return unless $modify =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
|
||||
|
||||
return eval { timegm( $6, $5, $4, $3, $2 - 1, $1 ) };
|
||||
}
|
||||
|
||||
=head3 _rename_file
|
||||
|
||||
Internal method that performs the FTP-specific file rename operation.
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@ use Modern::Perl;
|
|||
use File::Copy qw( copy move );
|
||||
use File::Spec;
|
||||
use IO::Dir;
|
||||
use Fcntl qw( S_ISDIR S_ISREG );
|
||||
|
||||
use base qw(Koha::File::Transport);
|
||||
|
||||
|
|
@ -257,7 +258,7 @@ sub _change_directory {
|
|||
|
||||
Internal method that performs the local file system file listing operation.
|
||||
Returns an array reference of hashrefs with file information.
|
||||
Each hashref contains: filename, longname, size, perms, mtime.
|
||||
Each hashref contains: filename, longname, size, perms, mtime, type.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -300,14 +301,20 @@ sub _list_files {
|
|||
while ( defined( my $file = $dir_handle->read ) ) {
|
||||
next if $file =~ /^\.\.?$/; # Skip . and ..
|
||||
my $full_path = File::Spec->catfile( $directory, $file );
|
||||
next unless -f $full_path; # Only files
|
||||
|
||||
# Get file stats for consistency with SFTP format
|
||||
my @stat = stat($full_path);
|
||||
# Get file stats for consistency with the SFTP/FTP format
|
||||
my @stat = stat($full_path);
|
||||
next unless @stat; # Skip entries we can't stat (e.g. broken symlinks)
|
||||
|
||||
my $size = $stat[7] || 0;
|
||||
my $mtime = $stat[9] || 0;
|
||||
my $mode = $stat[2] || 0;
|
||||
|
||||
my $type =
|
||||
S_ISDIR($mode) ? 'directory'
|
||||
: S_ISREG($mode) ? 'file'
|
||||
: 'other';
|
||||
|
||||
# Create permissions string (simplified)
|
||||
my $perms = sprintf( "%04o", $mode & oct('07777') );
|
||||
|
||||
|
|
@ -316,7 +323,8 @@ sub _list_files {
|
|||
longname => sprintf( "%s %8d %s %s", $perms, $size, scalar( localtime($mtime) ), $file ),
|
||||
size => $size,
|
||||
perms => $perms,
|
||||
mtime => $mtime
|
||||
mtime => $mtime,
|
||||
type => $type,
|
||||
};
|
||||
}
|
||||
$dir_handle->close;
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@ use File::Spec;
|
|||
use IO::File;
|
||||
use Net::SFTP::Foreign;
|
||||
use Try::Tiny;
|
||||
use JSON qw( decode_json encode_json );
|
||||
use JSON qw( decode_json encode_json );
|
||||
use Fcntl qw( S_ISDIR S_ISREG );
|
||||
|
||||
use base qw(Koha::File::Transport);
|
||||
|
||||
|
|
@ -172,7 +173,11 @@ sub _change_directory {
|
|||
|
||||
Internal method that performs the SFTP-specific file listing operation.
|
||||
Returns an array reference of hashrefs with file information.
|
||||
Each hashref contains: filename, longname, a (attributes).
|
||||
Each hashref contains: filename, longname, size, perms, mtime, type.
|
||||
|
||||
Net::SFTP::Foreign's ls() natively returns the size/perms/mtime nested inside
|
||||
a Net::SFTP::Foreign::Attributes object (the 'a' key). Those fields are
|
||||
flattened out here so the returned shape matches the FTP and Local transports.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -182,6 +187,22 @@ sub _list_files {
|
|||
|
||||
my $file_list = $self->{connection}->ls or return $self->_abort_operation($operation);
|
||||
|
||||
my @files = map {
|
||||
my $attrs = $_->{a};
|
||||
my $mode = $attrs ? $attrs->perm : undef;
|
||||
{
|
||||
filename => $_->{filename},
|
||||
longname => $_->{longname},
|
||||
size => $attrs ? $attrs->size : undef,
|
||||
perms => $attrs && defined $mode ? sprintf( "%04o", $mode & oct('07777') ) : undef,
|
||||
mtime => $attrs ? $attrs->mtime : undef,
|
||||
type => !defined $mode ? 'other'
|
||||
: S_ISDIR($mode) ? 'directory'
|
||||
: S_ISREG($mode) ? 'file'
|
||||
: 'other',
|
||||
}
|
||||
} @{$file_list};
|
||||
|
||||
$self->add_message(
|
||||
{
|
||||
message => $operation,
|
||||
|
|
@ -194,7 +215,7 @@ sub _list_files {
|
|||
}
|
||||
);
|
||||
|
||||
return $file_list;
|
||||
return \@files;
|
||||
}
|
||||
|
||||
=head3 _rename_file
|
||||
|
|
|
|||
|
|
@ -136,7 +136,7 @@ subtest 'change_directory() tests' => sub {
|
|||
};
|
||||
|
||||
subtest 'list_files() MLSD tests' => sub {
|
||||
plan tests => 6;
|
||||
plan tests => 16;
|
||||
|
||||
$schema->storage->txn_begin;
|
||||
|
||||
|
|
@ -151,11 +151,12 @@ subtest 'list_files() MLSD tests' => sub {
|
|||
|
||||
# MLSD output: "facts filename" per RFC 3659. Facts are locale-independent,
|
||||
# the filename is everything after the facts and a single space (so spaces
|
||||
# in filenames are handled), and cdir/pdir/dir entries must be skipped.
|
||||
# in filenames are handled), and cdir/pdir entries must be skipped while
|
||||
# real subdirectories (type=dir) are now included.
|
||||
my @mlsd_output = (
|
||||
'type=file;size=1234;modify=20250101120000;perm=adfr; QUOTES_413514.CEQ',
|
||||
'type=file;size=4096;modify=20250214093000; INVOICE_99.CEI',
|
||||
'type=dir;modify=20250303080000; subdir',
|
||||
'type=file;size=4096;modify=20250214093000;UNIX.mode=0644; INVOICE_99.CEI',
|
||||
'type=dir;modify=20250303080000;perm=cpmel; subdir',
|
||||
'type=cdir;modify=20250303080000; .',
|
||||
'type=pdir;modify=20250303080000; ..',
|
||||
'type=file;size=55;modify=20250405091000; name with spaces.CEA',
|
||||
|
|
@ -175,17 +176,34 @@ subtest 'list_files() MLSD tests' => sub {
|
|||
is( ref($files), 'ARRAY', 'list_files() returns an arrayref' );
|
||||
|
||||
my @names = sort map { $_->{filename} } @{$files};
|
||||
is( scalar @names, 3, 'directory, cdir and pdir entries are skipped' );
|
||||
is( scalar @names, 4, 'cdir and pdir entries are skipped, dir entries are now included' );
|
||||
|
||||
is_deeply(
|
||||
\@names,
|
||||
[ 'INVOICE_99.CEI', 'QUOTES_413514.CEQ', 'name with spaces.CEA' ],
|
||||
[ 'INVOICE_99.CEI', 'QUOTES_413514.CEQ', 'name with spaces.CEA', 'subdir' ],
|
||||
'filenames parsed from MLSD, spaces preserved'
|
||||
);
|
||||
|
||||
my ($quote) = grep { $_->{filename} eq 'QUOTES_413514.CEQ' } @{$files};
|
||||
is( $quote->{size}, 1234, 'size fact parsed correctly' );
|
||||
is( $quote->{perms}, 'adfr', 'perm fact captured' );
|
||||
my ($quote) = grep { $_->{filename} eq 'QUOTES_413514.CEQ' } @{$files};
|
||||
my ($invoice) = grep { $_->{filename} eq 'INVOICE_99.CEI' } @{$files};
|
||||
my ($subdir) = grep { $_->{filename} eq 'subdir' } @{$files};
|
||||
my ($spaced) = grep { $_->{filename} eq 'name with spaces.CEA' } @{$files};
|
||||
|
||||
is( $quote->{size}, 1234, 'size fact parsed correctly' );
|
||||
is( $quote->{type}, 'file', 'type=file fact maps to "file"' );
|
||||
is( $quote->{perms}, '0666', 'perm-only fact (adfr: read+write) approximated to octal' );
|
||||
is( $quote->{mtime}, 1735732800, 'modify fact (2025-01-01 12:00:00 UTC) parsed into mtime' );
|
||||
|
||||
is( $invoice->{perms}, '0644', 'UNIX.mode fact used verbatim when present' );
|
||||
is( $invoice->{type}, 'file', 'type=file fact maps to "file"' );
|
||||
is( $invoice->{mtime}, 1739525400, 'modify fact (2025-02-14 09:30:00 UTC) parsed into mtime' );
|
||||
|
||||
is( $subdir->{type}, 'directory', 'type=dir fact maps to "directory"' );
|
||||
is( $subdir->{perms}, '0111', 'perm-only fact (cpmel: execute via e) approximated to octal' );
|
||||
is( $subdir->{mtime}, 1740988800, 'modify fact is parsed into mtime for directories too' );
|
||||
|
||||
is( $spaced->{perms}, undef, 'entries with neither perm nor UNIX.mode fact get undef perms' );
|
||||
is( $spaced->{mtime}, 1743844200, 'modify fact still parsed into mtime when perms is undef' );
|
||||
|
||||
$transport->{connection} = undef;
|
||||
|
||||
|
|
@ -193,7 +211,7 @@ subtest 'list_files() MLSD tests' => sub {
|
|||
};
|
||||
|
||||
subtest 'list_files() NLST fallback tests' => sub {
|
||||
plan tests => 4;
|
||||
plan tests => 10;
|
||||
|
||||
$schema->storage->txn_begin;
|
||||
|
||||
|
|
@ -205,12 +223,30 @@ subtest 'list_files() NLST fallback tests' => sub {
|
|||
);
|
||||
|
||||
# Server without MLSD support: _list_cmd('MLSD') returns nothing, so
|
||||
# list_files() must fall back to NLST (ls) and return bare filenames.
|
||||
# list_files() must fall back to NLST (ls) and probe each entry with
|
||||
# SIZE/MDTM (plain Net::FTP methods) for size/mtime/type.
|
||||
my $ls_called = 0;
|
||||
my $mock_ftp = Test::MockModule->new('Net::FTP');
|
||||
$mock_ftp->mock( '_list_cmd', sub { return; } );
|
||||
$mock_ftp->mock( 'ls', sub { $ls_called = 1; return [ 'QUOTES_1.CEQ', '.', '..', 'INVOICE_2.CEI' ]; } );
|
||||
$mock_ftp->mock( 'pwd', sub { return '/incoming/'; } );
|
||||
$mock_ftp->mock(
|
||||
'ls',
|
||||
sub { $ls_called = 1; return [ 'QUOTES_1.CEQ', '.', '..', 'INVOICE_2.CEI', 'subdir' ]; }
|
||||
);
|
||||
$mock_ftp->mock( 'pwd', sub { return '/incoming/'; } );
|
||||
$mock_ftp->mock(
|
||||
'size',
|
||||
sub {
|
||||
my ( $s, $name ) = @_;
|
||||
return { 'QUOTES_1.CEQ' => 100, 'INVOICE_2.CEI' => 200 }->{$name};
|
||||
}
|
||||
);
|
||||
$mock_ftp->mock(
|
||||
'mdtm',
|
||||
sub {
|
||||
my ( $s, $name ) = @_;
|
||||
return { 'QUOTES_1.CEQ' => 1700000000, 'INVOICE_2.CEI' => 1700000100 }->{$name};
|
||||
}
|
||||
);
|
||||
|
||||
$transport->{connection} = bless {}, 'Net::FTP';
|
||||
$transport->{_user_set_directory} = 1;
|
||||
|
|
@ -220,13 +256,26 @@ subtest 'list_files() NLST fallback tests' => sub {
|
|||
is( $ls_called, 1, 'falls back to ls() when MLSD is unsupported' );
|
||||
|
||||
my @names = sort map { $_->{filename} } @{$files};
|
||||
is( scalar @names, 2, 'current/parent dir entries filtered from NLST output' );
|
||||
is( scalar @names, 3, 'current/parent dir entries filtered from NLST output' );
|
||||
is_deeply(
|
||||
\@names,
|
||||
[ 'INVOICE_2.CEI', 'QUOTES_1.CEQ' ],
|
||||
'bare filenames returned from NLST fallback'
|
||||
[ 'INVOICE_2.CEI', 'QUOTES_1.CEQ', 'subdir' ],
|
||||
'bare filenames returned from NLST fallback, including the directory'
|
||||
);
|
||||
ok( ( exists $files->[0]{filename} ), 'fallback entries expose a filename key' );
|
||||
|
||||
my ($quote) = grep { $_->{filename} eq 'QUOTES_1.CEQ' } @{$files};
|
||||
my ($invoice) = grep { $_->{filename} eq 'INVOICE_2.CEI' } @{$files};
|
||||
my ($subdir) = grep { $_->{filename} eq 'subdir' } @{$files};
|
||||
|
||||
is( $quote->{type}, 'file', 'SIZE succeeding means type "file"' );
|
||||
is( $quote->{size}, 100, 'size populated via SIZE probe' );
|
||||
is( $quote->{mtime}, 1700000000, 'mtime populated via MDTM probe' );
|
||||
|
||||
is( $invoice->{type}, 'file', 'SIZE succeeding means type "file"' );
|
||||
is( $invoice->{size}, 200, 'size populated via SIZE probe' );
|
||||
|
||||
is( $subdir->{type}, 'directory', 'SIZE failing is treated as a directory' );
|
||||
is( $subdir->{perms}, undef, 'perms stay undef on the NLST fallback path' );
|
||||
|
||||
$transport->{connection} = undef;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,82 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# 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 Test::More tests => 2;
|
||||
use Test::NoWarnings;
|
||||
use File::Temp qw( tempdir );
|
||||
use File::Spec;
|
||||
|
||||
use Koha::File::Transports;
|
||||
|
||||
use t::lib::TestBuilder;
|
||||
use t::lib::Mocks;
|
||||
|
||||
my $schema = Koha::Database->new->schema;
|
||||
my $builder = t::lib::TestBuilder->new;
|
||||
|
||||
subtest 'list_files() tests' => sub {
|
||||
plan tests => 9;
|
||||
|
||||
$schema->storage->txn_begin;
|
||||
|
||||
my $tempdir = tempdir( CLEANUP => 1 );
|
||||
my $download_dir = File::Spec->catdir( $tempdir, 'download' );
|
||||
mkdir $download_dir or die "Cannot create download_dir: $!";
|
||||
|
||||
my $file_path = File::Spec->catfile( $download_dir, 'QUOTES_413514.CEQ' );
|
||||
open my $fh, '>', $file_path or die "Cannot create test file: $!";
|
||||
print $fh 'test content';
|
||||
close $fh;
|
||||
chmod 0644, $file_path;
|
||||
|
||||
my $subdir_path = File::Spec->catdir( $download_dir, 'incoming' );
|
||||
mkdir $subdir_path or die "Cannot create subdir: $!";
|
||||
chmod 0755, $subdir_path;
|
||||
|
||||
my $transport = $builder->build_object(
|
||||
{
|
||||
class => 'Koha::File::Transports',
|
||||
value => {
|
||||
transport => 'local',
|
||||
download_directory => $download_dir,
|
||||
}
|
||||
}
|
||||
);
|
||||
|
||||
can_ok( $transport, 'list_files' );
|
||||
|
||||
my $files = $transport->list_files();
|
||||
is( ref($files), 'ARRAY', 'list_files() returns an arrayref' );
|
||||
is( scalar @{$files}, 2, 'both the file and the directory are returned' );
|
||||
|
||||
my ($file_entry) = grep { $_->{filename} eq 'QUOTES_413514.CEQ' } @{$files};
|
||||
my ($dir_entry) = grep { $_->{filename} eq 'incoming' } @{$files};
|
||||
|
||||
ok( $file_entry, 'file entry is present' );
|
||||
is( $file_entry->{type}, 'file', 'file entry has type "file"' );
|
||||
is( $file_entry->{perms}, '0644', 'file entry has expected octal perms' );
|
||||
|
||||
ok( $dir_entry, 'directory entry is present' );
|
||||
is( $dir_entry->{type}, 'directory', 'directory entry has type "directory"' );
|
||||
is( $dir_entry->{perms}, '0755', 'directory entry has expected octal perms' );
|
||||
|
||||
$schema->storage->txn_rollback;
|
||||
};
|
||||
|
||||
1;
|
||||
|
|
@ -23,6 +23,8 @@ use Test::NoWarnings;
|
|||
use Test::Warn;
|
||||
use Test::MockModule;
|
||||
|
||||
use Net::SFTP::Foreign::Attributes;
|
||||
|
||||
use Koha::Encryption;
|
||||
use Koha::File::Transports;
|
||||
|
||||
|
|
@ -248,7 +250,10 @@ subtest 'change_directory() tests' => sub {
|
|||
};
|
||||
|
||||
subtest 'list_files() tests' => sub {
|
||||
plan tests => 1;
|
||||
plan tests => 11;
|
||||
|
||||
$schema->storage->txn_begin;
|
||||
|
||||
my $transport = $builder->build_object(
|
||||
{
|
||||
class => 'Koha::File::Transports',
|
||||
|
|
@ -257,6 +262,64 @@ subtest 'list_files() tests' => sub {
|
|||
);
|
||||
|
||||
can_ok( $transport, 'list_files' );
|
||||
|
||||
# Net::SFTP::Foreign::ls() returns an arrayref of hashes, each with
|
||||
# filename, longname and an 'a' key holding a
|
||||
# Net::SFTP::Foreign::Attributes object - the fields we need to flatten
|
||||
# out into the same flat hash shape used by the FTP and Local transports.
|
||||
my $file_attrs = Net::SFTP::Foreign::Attributes->new;
|
||||
$file_attrs->set_size(1234);
|
||||
$file_attrs->set_perm( oct('100644') );
|
||||
$file_attrs->set_amtime( 1700000000, 1700000100 );
|
||||
|
||||
my $dir_attrs = Net::SFTP::Foreign::Attributes->new;
|
||||
$dir_attrs->set_perm( oct('040755') );
|
||||
|
||||
my @sftp_ls_output = (
|
||||
{
|
||||
filename => 'QUOTES_413514.CEQ',
|
||||
longname => '-rw-r--r-- 1 kohauser kohauser 1234 Nov 14 22:15 QUOTES_413514.CEQ',
|
||||
a => $file_attrs,
|
||||
},
|
||||
{
|
||||
filename => 'incoming',
|
||||
longname => 'drwxr-xr-x 2 kohauser kohauser 4096 Nov 14 22:15 incoming',
|
||||
a => $dir_attrs,
|
||||
},
|
||||
);
|
||||
|
||||
my $undef;
|
||||
my $mock_sftp = Test::MockModule->new('Net::SFTP::Foreign');
|
||||
$mock_sftp->mock( 'ls', sub { return [@sftp_ls_output]; } );
|
||||
$mock_sftp->mock( 'error', sub { return $undef; } );
|
||||
$mock_sftp->mock( 'status', sub { return 0; } );
|
||||
$mock_sftp->mock( 'cwd', sub { return '/incoming/'; } );
|
||||
|
||||
# Pretend we are already connected so list_files() skips (re)connection
|
||||
$transport->{connection} = bless {}, 'Net::SFTP::Foreign';
|
||||
$transport->{_user_set_directory} = 1;
|
||||
|
||||
my $files = $transport->list_files();
|
||||
|
||||
is( ref($files), 'ARRAY', 'list_files() returns an arrayref' );
|
||||
is( scalar @{$files}, 2, 'both the file and the directory are returned' );
|
||||
|
||||
my ($file) = grep { $_->{filename} eq 'QUOTES_413514.CEQ' } @{$files};
|
||||
my ($dir) = grep { $_->{filename} eq 'incoming' } @{$files};
|
||||
|
||||
is( ref( $file->{a} ), '', 'nested Attributes object is not present in the returned hashref' );
|
||||
is( $file->{size}, 1234, 'size is flattened out of the Attributes object' );
|
||||
is( $file->{mtime}, 1700000100, 'mtime is flattened out of the Attributes object' );
|
||||
is( $file->{perms}, '0644', 'perms is flattened out of the Attributes object' );
|
||||
is( $file->{type}, 'file', 'regular file gets type "file"' );
|
||||
|
||||
ok( $dir, 'directory entry is present in the listing' );
|
||||
is( $dir->{type}, 'directory', 'directory gets type "directory"' );
|
||||
is( $dir->{perms}, '0755', 'directory perms are flattened too' );
|
||||
|
||||
$transport->{connection} = undef;
|
||||
|
||||
$schema->storage->txn_rollback;
|
||||
};
|
||||
|
||||
1;
|
||||
|
|
|
|||
Loading…
Reference in New Issue