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