use strict;
use warnings;
use Test::More;
use File::Temp qw( tempdir );
use lib './lib';
use File::Util qw( SL NL existent );
# ----------------------------------------------------------------------
# determine if we can run these fatal tests
# ----------------------------------------------------------------------
BEGIN {
if ( $^O !~ /bsd|linux|cygwin/i )
{
plan skip_all => 'this OS doesn\'t fail reliably - chmod() issues';
}
# the tests in this file have a higher probability of failing in the
# wild, and so are reserved for the author/maintainers as release tests.
# these tests also won't reliably run on platforms that can't run or
# can't respect chmod()... e.g.- windows (and even cygwin to some extent)
elsif ( $ENV{RELEASE_TESTING} || $ENV{AUTHOR_TESTING} || $ENV{AUTHOR_TESTS} )
{
{
local $@;
CORE::eval 'use Test::Fatal';
if ( $@ )
{
plan skip_all => 'Need Test::Fatal to run these tests';
}
else
{
require Test::Fatal;
Test::Fatal->import( qw( exception dies_ok lives_ok ) );
plan tests => 37;
CORE::eval <<'__TEST_NOWARNINGS__';
use Test::NoWarnings;
__TEST_NOWARNINGS__
}
}
}
else
{
plan skip_all => 'these tests are for testing by the author';
}
}
my $ftl = File::Util->new();
my $tempdir = tempdir( CLEANUP => 1 );
my $exception;
# ----------------------------------------------------------------------
# set ourselves up for failure
# ----------------------------------------------------------------------
# list of methods that will throw a special exception unless they get
# the input that they require
my @methods_that_need_input = qw(
list_dir load_file write_file touch
load_dir make_dir open_handle
);
# make an inaccessible file
my $noaccess_file = make_inaccessible_file( 'noaccess.txt' );
# make a directory, inaccessible
my $noaccess_dir = make_inaccessible_dir( 'noaccess/' );
# make a somewhat-deep temp dir structure
$ftl->make_dir( $tempdir . SL . 'a' . SL . 'b' . SL . 'c' );
# ----------------------------------------------------------------------
# let the fail begin
# ----------------------------------------------------------------------
# just test the onfail toggle for all recognized key words. This needs
# to be revisited to test the actual effect of a given call on a File::Util
# object, and not merely whether or not they return as expected.
is $ftl->onfail(), 'die', 'onfail "die" is default OK';
$ftl->onfail( 'zero' );
is $ftl->onfail(), 'zero', 'onfail "zero" setting toggled OK';
$ftl->onfail( 'warn' );
is $ftl->onfail(), 'warn', 'onfail "warn" setting toggled OK';
$ftl->onfail( 'message' );
is $ftl->onfail(), 'message', 'onfail "message" setting toggled OK';
$ftl->onfail( sub { } );
is ref $ftl->onfail(), 'CODE', 'onfail "callback" setting toggled OK';
$ftl->onfail( 'die' );
is $ftl->onfail(), 'die', 'onfail "die" setting toggled OK';
# the first of our real tests are several simple failure scenarios wherein
# no input is sent to a given method that requires it.
for my $method ( @methods_that_need_input )
{
# send no input to $method
$exception = exception { $ftl->$method() };
like $exception,
qr/(?m)^Call to \( $method\(\) \) failed:/,
sprintf 'send no input to %s()', $method;
}
# try to read-open a file that doesn't exist
$exception = exception { $ftl->load_file( get_nonexistent_file() ) };
like $exception,
qr/(?m)^File inaccessible or does not exist:/,
'attempt to read non-existant file';
# try to set a bad flock policy
$exception = exception { $ftl->flock_rules( 'dummy' ) };
like $exception,
qr/(?m)^Invalid file locking policy/,
'make a call to flock_rules() with improper input';
# try to read an inaccessible file
$exception = exception { $ftl->load_file( $noaccess_file ) };
like $exception,
qr/(?m)^Permissions conflict\. Can't read:/,
'attempt to read an inaccessible file';
# try to write to an inaccessible file
$exception = exception { $ftl->write_file( $noaccess_file => 'dummycontent' ) };
like $exception,
qr/(?m)^Permissions conflict\. Can't write to:/,
'attempt to write to an inaccessible file';
# try to access a file in an inaccessible directory
$exception = exception { $ftl->load_file( $noaccess_dir . SL . 'dummyfile' ) };
like $exception,
qr/(?m)^File inaccessible|^Permissions conflict/,
'attempt to read a file in a restricted directory';
# try to create a file in the inaccessible directory
$exception = exception
{
$ftl->write_file( $noaccess_dir . SL . 'dummyfile' => 'dummycontent' )
};
like $exception,
qr/(?m)^Permissions conflict. Can't (?:create|write)/, # cygwin differs
'attempt to create a file in a restricted directory';
# try to open a directory as a file for reading
$exception = exception { $ftl->load_file( '.' ) };
like $exception,
qr/(?m)^Can't call open\(\) on a directory:/,
'attempt to do file open() on a directory (read)';
# try to open a directory as a file for writing
$exception = exception { $ftl->write_file( '.' => 'dummycontent' ) };
like $exception,
qr/(?m)^File already exists as directory:/,
'attempt to do file open() on a directory (write)';
# try to open a file with a bad "mode" argument
$exception = exception
{
$ftl->write_file(
{
filename => 'dummyfile',
content => 'dummycontent',
mode => 'chuck norris', # << invalid
onfail => 'roundhouse', # << invalid
}
)
};
like $exception,
qr/(?m)^Illegal mode specified for file open:/,
'provide illegal open "mode" to write_file()';
# try to SYSopen a file with a bad "mode" argument
$exception = exception
{
$ftl->open_handle
(
{
use_sysopen => 1,
filename => 'dummyfile',
mode => 'stealth monkey', # << invalid
}
)
};
like $exception,
qr/(?m)^Illegal mode specified for sysopen:/,
'provide illegal SYSopen "mode" to write_file()';
# try to SYSopen a file with a utf8 binmode
$exception = exception
{
$ftl->open_handle
(
{
use_sysopen => 1,
filename => 'dummyfile',
mode => 'write',
binmode => 'utf8',
}
)
};
like $exception,
qr/(?m)^The use of system IO.+?on utf8 file handles is deprecated/,
'try to open_handle with mixed utf8 and systemIO options';
# try to opendir on an inaccessible directory
$exception = exception { $ftl->list_dir( $noaccess_dir ) };
like $exception,
qr/(?m)^Can't opendir on directory:/,
'attempt list_dir() on an inaccessible directory';
# try to makedir in an inaccessible directory
$exception = exception
{ $ftl->make_dir( $noaccess_dir . SL . 'snowballs_chance/' ) };
like $exception,
qr/(?m)^Permissions conflict\. Can't create directory:/,
'attempt make_dir() in an inaccessible directory';
# try to makedir for an existent directory
$exception = exception { $ftl->make_dir( '.' ) };
like $exception,
qr/(?m)^make_dir target already exists:/,
'attempt make_dir() for a directory that already esists';
# try to makedir on a file
$exception = exception { $ftl->make_dir( __FILE__ ) };
like $exception,
qr/(?m)^Can't make directory; already exists as a file/,
'attempt make_dir() on a file';
# try to list_dir() on a file
$exception = exception { $ftl->list_dir( __FILE__ ) };
like $exception,
qr/(?m)^Can't opendir\(\) on non-directory:/,
'attempt to list_dir() on a file';
# try to read more data from a file than the enforced read_limit amount
# ...we set the read_limit purposely low to induce the error
$exception = exception { $ftl->load_file( __FILE__, { read_limit => 0 } ) };
like $exception,
qr/(?m)^Stopped reading:/,
'attempt to read a file that\'s bigger than the set read_limit';
# send bad input to abort_depth()
$exception = exception { $ftl->abort_depth( 'cheezburger' ) };
like $exception,
qr/(?m)^Bad input provided to abort_depth/,
'make a call to abort_depth() with improper input';
# send bad input to read_limit()
$exception = exception { $ftl->read_limit( 'woof!' ) };
like $exception,
qr/(?m)^Bad input provided to read_limit/,
'make a call to read_limit() with improper input';
# intentionally exceed abort_depth
$exception = exception
{
$ftl->list_dir( $tempdir => { recurse => 1, abort_depth => 1 } )
};
like $exception,
qr/(?m)^Recursion limit exceeded/,
'attempt to list_dir recursively past abort_depth limit';
# call write_file() with an invalid file handle
$exception = exception
{
$ftl->load_file( file_handle => 'not a file handle at all' )
};
like $exception,
qr/a true file handle reference/,
'call write_file with a file handle that is invalid (not a real FH ref)';
# Knowing that the two tests below call File::Util methods with built-in
# onfail callbacks to handle issues when they can't create leading directories,
# and knowing that we're calling the methods in a way they will fail, we
# know that our own onfail callbacks (below) should return what we expect
# as long as the built-in onfail callbacks fire them off (repeater-style).
# The built-in onfail callbacks wrap around the callbacks we define below
# and make sure that those custom callbacks get invoked properly.
is $ftl->write_file(
$noaccess_dir . SL . 'my' . SL . 'dog' . SL . 'rover', 'woof!' => {
onfail => sub { return 'lassie' }
}
), 'lassie', 'test native onfail callback repeater mechanism in write_file()';
is $ftl->open_handle(
$noaccess_dir . SL . 'my' . SL . 'friend' . SL . 'john' => {
onfail => sub { return 'ian' }
}
), 'ian', 'test native onfail callback repeater mechanism in open_handle()';
# ----------------------------------------------------------------------
# clean up restricted-access files/dirs, and exit
# ----------------------------------------------------------------------
remove_inaccessible_file( $noaccess_file );
remove_inaccessible_dir( $noaccess_dir );
exit;
# ----------------------------------------------------------------------
# supporting subroutines
# ----------------------------------------------------------------------
sub make_inaccessible_file
{
my $filename = $ftl->strip_path( shift @_ );
$filename = $tempdir . SL . $filename;
$ftl->touch( $filename );
chmod oct 0, $filename or die $!;
return $filename;
}
sub remove_inaccessible_file
{
my $filename = $ftl->strip_path( shift @_ );
$filename = $tempdir . SL . $filename;
chmod oct 777, $filename or die $!;
unlink $filename or die $!;
}
sub make_inaccessible_dir
{
my $dirname = shift @_;
$dirname = $tempdir . SL . $dirname;
$ftl->make_dir( $dirname );
$ftl->touch( $dirname . SL . 'dummyfile' );
chmod oct 0, $dirname . SL . 'dummyfile' or die $!;
chmod oct 0, $dirname or die $!;
return $dirname;
}
sub remove_inaccessible_dir
{
my $dirname = $ftl->strip_path( shift @_ );
$dirname = $tempdir . SL . $dirname;
chmod oct 777, $dirname or die $!;
chmod oct 777, $dirname . SL . 'dummyfile' or die $!;
unlink $dirname . SL . 'dummyfile' or die $!;
rmdir $dirname or die $!;
}
sub get_nonexistent_file
{
my $file = ( rand 100 ) . time . $$;
while ( -e $file )
{
$file = get_nonexistent_file();
}
return $file;
}