1######################################################################## 2# Test Suite for Log::Log4perl::Config (Safe compartment functionality) 3# James FitzGibbon, 2003 (james.fitzgibbon@target.com) 4# Mike Schilli, 2003 (log4perl@perlmeister.com) 5######################################################################## 6 7BEGIN { 8 if($ENV{INTERNAL_DEBUG}) { 9 require Log::Log4perl::InternalDebug; 10 Log::Log4perl::InternalDebug->enable(); 11 } 12} 13 14use Test; 15BEGIN { plan tests => 23 }; 16 17use Log::Log4perl; 18 19ok(1); # If we made it this far, we're ok. 20 21my $example_log = "example" . (stat($0))[9] . ".log"; 22unlink($example_log); 23 24Log::Log4perl::Config->vars_shared_with_safe_compartment( 25 main => [ '$0' ], 26); 27 28# test that unrestricted code works properly 29Log::Log4perl::Config::allow_code(1); 30my $config = <<'END'; 31 log4perl.logger = INFO, Main 32 log4perl.appender.Main = Log::Log4perl::Appender::File 33 log4perl.appender.Main.filename = sub { "example" . (stat($0))[9] . ".log" } 34 log4perl.appender.Main.layout = Log::Log4perl::Layout::SimpleLayout 35END 36eval { Log::Log4perl->init( \$config ) }; 37my $failed = $@ ? 1 : 0; 38ok($failed, 0, 'config file with code initializes successfully'); 39 40# test that disallowing code works properly 41Log::Log4perl::Config->allow_code(0); 42eval { Log::Log4perl->init( \$config ) }; 43$failed = $@ ? 1 : 0; 44ok($failed, 1, 'config file with code fails if ALLOW_CODE_IN_CONFIG_FILE is false'); 45 46# test that providing an explicit mask causes illegal code to fail 47Log::Log4perl::Config->allow_code(1); 48Log::Log4perl::Config->allowed_code_ops(':default'); 49eval { Log::Log4perl->init( \$config ) }; 50$failed = $@ ? 1 : 0; 51ok($failed, 1, 'config file with code fails if ALLOW_CODE_IN_CONFIG_FILE is true and an explicit mask is set'); 52 53# test that providing an restrictive convenience mask causes illegal code to fail 54Log::Log4perl::Config::allow_code('restrictive'); 55undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE; 56eval { Log::Log4perl->init( \$config ) }; 57$failed = $@ ? 1 : 0; 58ok($failed, 1, 'config file with code fails if ALLOW_CODE_IN_CONFIG_FILE is true and a restrictive convenience mask is set'); 59 60# test that providing an restrictive convenience mask causes illegal code to fail 61Log::Log4perl::Config->allow_code('safe'); 62undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE; 63eval { Log::Log4perl->init( \$config ) }; 64$failed = $@ ? 1 : 0; 65ok($failed, 0, 'config file with code succeeds if ALLOW_CODE_IN_CONFIG_FILE is true and a safe convenience mask is set'); 66 67################################################## 68# Test allowed_code_ops_convenience_map accessors 69################################################### 70 71# get entire map as hashref 72my $map = Log::Log4perl::Config->allowed_code_ops_convenience_map(); 73ok(ref $map, 'HASH', 'entire map is returned as a hashref'); 74my $numkeys = keys %{ $map }; 75 76# get entire map as hash 77my %map = Log::Log4perl::Config->allowed_code_ops_convenience_map(); 78ok(keys %map, $numkeys, 'entire map returned as hash has same number of keys as hashref'); 79 80# replace entire map 81Log::Log4perl::Config->allowed_code_ops_convenience_map( {} ); 82ok(keys %{ Log::Log4perl::Config->allowed_code_ops_convenience_map() }, 0, 83 'can replace entire map with an empty one'); 84Log::Log4perl::Config->allowed_code_ops_convenience_map( \%map ); 85ok(keys %{ Log::Log4perl::Config->allowed_code_ops_convenience_map() }, $numkeys, 86 'can replace entire map with an populated one'); 87 88# Add a new name/mask to the map 89Log::Log4perl::Config->allowed_code_ops_convenience_map( foo => [ ':default' ] ); 90ok( keys %{ Log::Log4perl::Config->allowed_code_ops_convenience_map() }, 91 $numkeys + 1, 'can add a new name/mask to the map'); 92 93# get the mask we just added back 94my $mask = Log::Log4perl::Config->allowed_code_ops_convenience_map( 'foo' ); 95ok( $mask->[0], ':default', 'can retrieve a single mask'); 96 97################################################### 98# Test vars_shared_with_safe_compartment accessors 99################################################### 100 101# get entire varlist as hashref 102$map = Log::Log4perl::Config->vars_shared_with_safe_compartment(); 103ok(ref $map, 'HASH', 'entire map is returned as a hashref'); 104$numkeys = keys %{ $map }; 105 106# get entire map as hash 107%map = Log::Log4perl::Config->vars_shared_with_safe_compartment(); 108ok(keys %map, $numkeys, 'entire map returned as hash has same number of keys as hashref'); 109 110# replace entire map 111Log::Log4perl::Config->vars_shared_with_safe_compartment( {} ); 112ok(keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() }, 0, 113 'can replace entire map with an empty one'); 114Log::Log4perl::Config->vars_shared_with_safe_compartment( \%map ); 115ok(keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() }, $numkeys, 116 'can replace entire map with an populated one'); 117 118# Add a new name/mask to the map 119$Foo::foo = 1; 120@Foo::bar = ( 1, 2, 3 ); 121push @Foo::bar, $Foo::foo; # Some nonsense to avoid 'used only once' warning 122Log::Log4perl::Config->vars_shared_with_safe_compartment( Foo => [ '$foo', '@bar' ] ); 123ok( keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() }, 124 $numkeys + 1, 'can add a new name/mask to the map'); 125 126# get the varlist we just added back 127my $varlist = Log::Log4perl::Config->vars_shared_with_safe_compartment( 'Foo' ); 128ok( $varlist->[0], '$foo', 'can retrieve a single varlist'); 129ok( $varlist->[1], '@bar', 'can retrieve a single varlist'); 130 131 132############################################ 133# Now the some tests with restricted cspecs 134############################################ 135 136# Global cspec with illegal code 137$config = <<'END'; 138 log4perl.logger = INFO, Main 139 #'U' a global user-defined cspec 140 log4j.PatternLayout.cspec.U = sub { unlink 'quackquack'; } 141 log4perl.appender.Main = Log::Log4perl::Appender::Screen 142 log4perl.appender.Main.layout = Log::Log4perl::Layout::SimpleLayout 143END 144Log::Log4perl::Config::allow_code('restrictive'); 145undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE; 146eval { Log::Log4perl->init( \$config ) }; 147$failed = $@ ? 1 : 0; 148ok($failed, 1, 149 'global cspec with harmful code rejected on restrictive setting'); 150 151# Global cspec with legal code 152$config = <<'END'; 153 log4perl.logger = INFO, Main 154 #'U' a global user-defined cspec 155 log4j.PatternLayout.cspec.U = sub { 1; } 156 log4perl.appender.Main = Log::Log4perl::Appender::Screen 157 log4perl.appender.Main.layout = Log::Log4perl::Layout::SimpleLayout 158END 159Log::Log4perl::Config->allow_code('restrictive'); 160undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE; 161eval { Log::Log4perl->init( \$config ) }; 162$failed = $@ ? 1 : 0; 163ok($failed, 0, 'global cspec with legal code allowed on restrictive setting'); 164 165# Local cspec with illegal code 166$config = <<'END'; 167 log4perl.logger = INFO, Main 168 log4perl.appender.Main = Log::Log4perl::Appender::Screen 169 log4perl.appender.Main.layout = Log::Log4perl::Layout::PatternLayout 170 log4perl.appender.Main.layout.cspec.K = sub { symlink("a", "b"); } 171END 172Log::Log4perl::Config::allow_code('restrictive'); 173undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE; 174eval { Log::Log4perl->init( \$config ) }; 175$failed = $@ ? 1 : 0; 176ok($failed, 1, 'local cspec with harmful code rejected on restrictive setting'); 177 178# Global cspec with legal code 179$config = <<'END'; 180 log4perl.logger = INFO, Main 181 log4perl.appender.Main = Log::Log4perl::Appender::Screen 182 log4perl.appender.Main.layout = Log::Log4perl::Layout::PatternLayout 183 log4perl.appender.Main.layout.cspec.K = sub { return sprintf "%1x", $$} 184END 185Log::Log4perl::Config::allow_code('restrictive'); 186undef @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE; 187eval { Log::Log4perl->init( \$config ) }; 188$failed = $@ ? 1 : 0; 189ok($failed, 0, 'local cspec with legal code allowed on restrictive setting'); 190 191unlink($example_log); 192