########################################################################
# Test Suite for Log::Log4perl::Config (Safe compartment functionality)
# James FitzGibbon, 2003 (james.fitzgibbon@target.com)
# Mike Schilli, 2003 (log4perl@perlmeister.com)
########################################################################
use Test;
BEGIN { plan tests => 23 };
use Log::Log4perl;
ok(1); # If we made it this far, we're ok.
my $example_log = "example" . (stat($0))[9] . ".log";
unlink($example_log);
Log::Log4perl::Config->vars_shared_with_safe_compartment(
main => [ '$0' ],
);
# test that unrestricted code works properly
Log::Log4perl::Config::allow_code(1);
my $config = <<'END';
log4perl.logger = INFO, Main
log4perl.appender.Main = Log::Log4perl::Appender::File
log4perl.appender.Main.filename = sub { "example" . (stat($0))[9] . ".log" }
log4perl.appender.Main.layout = Log::Log4perl::Layout::SimpleLayout
END
eval { Log::Log4perl->init( \$config ) };
my $failed = $@ ? 1 : 0;
ok($failed, 0, 'config file with code initializes successfully');
# test that disallowing code works properly
Log::Log4perl::Config->allow_code(0);
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 1, 'config file with code fails if ALLOW_CODE_IN_CONFIG_FILE is false');
# test that providing an explicit mask causes illegal code to fail
Log::Log4perl::Config->allow_code(1);
Log::Log4perl::Config->allowed_code_ops(':default');
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 1, 'config file with code fails if ALLOW_CODE_IN_CONFIG_FILE is true and an explicit mask is set');
# test that providing an restrictive convenience mask causes illegal code to fail
Log::Log4perl::Config::allow_code('restrictive');
undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE;
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 1, 'config file with code fails if ALLOW_CODE_IN_CONFIG_FILE is true and a restrictive convenience mask is set');
# test that providing an restrictive convenience mask causes illegal code to fail
Log::Log4perl::Config->allow_code('safe');
undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE;
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 0, 'config file with code succeeds if ALLOW_CODE_IN_CONFIG_FILE is true and a safe convenience mask is set');
##################################################
# Test allowed_code_ops_convenience_map accessors
###################################################
# get entire map as hashref
my $map = Log::Log4perl::Config->allowed_code_ops_convenience_map();
ok(ref $map, 'HASH', 'entire map is returned as a hashref');
my $numkeys = keys %{ $map };
# get entire map as hash
my %map = Log::Log4perl::Config->allowed_code_ops_convenience_map();
ok(keys %map, $numkeys, 'entire map returned as hash has same number of keys as hashref');
# replace entire map
Log::Log4perl::Config->allowed_code_ops_convenience_map( {} );
ok(keys %{ Log::Log4perl::Config->allowed_code_ops_convenience_map() }, 0,
'can replace entire map with an empty one');
Log::Log4perl::Config->allowed_code_ops_convenience_map( \%map );
ok(keys %{ Log::Log4perl::Config->allowed_code_ops_convenience_map() }, $numkeys,
'can replace entire map with an populated one');
# Add a new name/mask to the map
Log::Log4perl::Config->allowed_code_ops_convenience_map( foo => [ ':default' ] );
ok( keys %{ Log::Log4perl::Config->allowed_code_ops_convenience_map() },
$numkeys + 1, 'can add a new name/mask to the map');
# get the mask we just added back
my $mask = Log::Log4perl::Config->allowed_code_ops_convenience_map( 'foo' );
ok( $mask->[0], ':default', 'can retrieve a single mask');
###################################################
# Test vars_shared_with_safe_compartment accessors
###################################################
# get entire varlist as hashref
$map = Log::Log4perl::Config->vars_shared_with_safe_compartment();
ok(ref $map, 'HASH', 'entire map is returned as a hashref');
$numkeys = keys %{ $map };
# get entire map as hash
%map = Log::Log4perl::Config->vars_shared_with_safe_compartment();
ok(keys %map, $numkeys, 'entire map returned as hash has same number of keys as hashref');
# replace entire map
Log::Log4perl::Config->vars_shared_with_safe_compartment( {} );
ok(keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() }, 0,
'can replace entire map with an empty one');
Log::Log4perl::Config->vars_shared_with_safe_compartment( \%map );
ok(keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() }, $numkeys,
'can replace entire map with an populated one');
# Add a new name/mask to the map
$Foo::foo = 1;
@Foo::bar = ( 1, 2, 3 );
push @Foo::bar, $Foo::foo; # Some nonsense to avoid 'used only once' warning
Log::Log4perl::Config->vars_shared_with_safe_compartment( Foo => [ '$foo', '@bar' ] );
ok( keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() },
$numkeys + 1, 'can add a new name/mask to the map');
# get the varlist we just added back
my $varlist = Log::Log4perl::Config->vars_shared_with_safe_compartment( 'Foo' );
ok( $varlist->[0], '$foo', 'can retrieve a single varlist');
ok( $varlist->[1], '@bar', 'can retrieve a single varlist');
############################################
# Now the some tests with restricted cspecs
############################################
# Global cspec with illegal code
$config = <<'END';
log4perl.logger = INFO, Main
#'U' a global user-defined cspec
log4j.PatternLayout.cspec.U = sub { unlink 'quackquack'; }
log4perl.appender.Main = Log::Log4perl::Appender::Screen
log4perl.appender.Main.layout = Log::Log4perl::Layout::SimpleLayout
END
Log::Log4perl::Config::allow_code('restrictive');
undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE;
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 1,
'global cspec with harmful code rejected on restrictive setting');
# Global cspec with legal code
$config = <<'END';
log4perl.logger = INFO, Main
#'U' a global user-defined cspec
log4j.PatternLayout.cspec.U = sub { 1; }
log4perl.appender.Main = Log::Log4perl::Appender::Screen
log4perl.appender.Main.layout = Log::Log4perl::Layout::SimpleLayout
END
Log::Log4perl::Config->allow_code('restrictive');
undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE;
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 0, 'global cspec with legal code allowed on restrictive setting');
# Local cspec with illegal code
$config = <<'END';
log4perl.logger = INFO, Main
log4perl.appender.Main = Log::Log4perl::Appender::Screen
log4perl.appender.Main.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Main.layout.cspec.K = sub { symlink("a", "b"); }
END
Log::Log4perl::Config::allow_code('restrictive');
undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE;
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 1, 'local cspec with harmful code rejected on restrictive setting');
# Global cspec with legal code
$config = <<'END';
log4perl.logger = INFO, Main
log4perl.appender.Main = Log::Log4perl::Appender::Screen
log4perl.appender.Main.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Main.layout.cspec.K = sub { return sprintf "%1x", $$}
END
Log::Log4perl::Config::allow_code('restrictive');
undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE;
eval { Log::Log4perl->init( \$config ) };
$failed = $@ ? 1 : 0;
ok($failed, 0, 'local cspec with legal code allowed on restrictive setting');
unlink($example_log);