summaryrefslogtreecommitdiff
path: root/t/041SafeEval.t
blob: 41dc3136b93cfd5f8e4dc602413951516c930068 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
########################################################################
# Test Suite for Log::Log4perl::Config (Safe compartment functionality)
# James FitzGibbon, 2003 (james.fitzgibbon@target.com)
# Mike Schilli, 2003 (log4perl@perlmeister.com)
########################################################################

BEGIN { 
    if($ENV{INTERNAL_DEBUG}) {
        require Log::Log4perl::InternalDebug;
        Log::Log4perl::InternalDebug->enable();
    }
}

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);