line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Acme::SafetyGoggles; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
90211
|
use warnings; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
81
|
|
4
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
79
|
|
5
|
2
|
|
|
2
|
|
11
|
use Carp; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
142
|
|
6
|
2
|
|
|
2
|
|
11
|
use Filter::Simple; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
13
|
|
7
|
2
|
|
|
2
|
|
2161
|
use Text::Diff (); |
|
2
|
|
|
|
|
28732
|
|
|
2
|
|
|
|
|
125
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$Carp::Internal{'Filter::Simple'}++; |
10
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
11
|
|
|
|
|
|
|
|
12
|
2
|
|
|
2
|
|
25
|
no warnings 'unopened'; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
122
|
|
13
|
2
|
|
|
2
|
|
11
|
no warnings 'redefine'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
544
|
|
14
|
|
|
|
|
|
|
*DIAG = $ENV{ACME_SAFETYGOGGLES_DIAG} ? *STDERR : *DEVNULL; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my ($state, $diff); |
17
|
2
|
|
|
2
|
1
|
41
|
sub state { $state } |
18
|
2
|
|
|
2
|
1
|
12
|
sub diff { $diff } |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub _set_current { |
21
|
6
|
|
|
6
|
|
21
|
print DIAG "A::SG::_set_current => \n\n\n==========\n$_\n==========\n\n\n\n"; |
22
|
6
|
|
|
|
|
10
|
our $current; |
23
|
6
|
100
|
|
|
|
29
|
$current = $_ if length($_); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
CHECK { |
29
|
2
|
|
|
2
|
|
9
|
print DIAG "A::SG::CHECK\n"; |
30
|
2
|
|
|
|
|
7
|
&apply_safety_goggles; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
BEGIN { |
34
|
2
|
|
|
2
|
|
25
|
our @caller = caller(2); |
35
|
|
|
|
|
|
|
# caller(0) and caller(1) both refer to this BEGIN block |
36
|
2
|
|
|
|
|
1379
|
print DIAG "A::SG::BEGIN => @caller[0..2]\n"; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
FILTER { |
40
|
|
|
|
|
|
|
print DIAG "A::SG::FILTER\n"; |
41
|
|
|
|
|
|
|
_set_current; |
42
|
|
|
|
|
|
|
}; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
{ |
45
|
|
|
|
|
|
|
package Filter::Simple; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# hijack Filter::Simple::filter_add to make filtered code |
48
|
|
|
|
|
|
|
# available to this module. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
*Filter::Simple::filter_add_ORIG = \&Filter::Simple::filter_add; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
*Filter::Simple::filter_add = sub ($) { |
53
|
2
|
|
|
2
|
|
216
|
my $code = shift; |
54
|
|
|
|
|
|
|
Filter::Simple::filter_add_ORIG( |
55
|
|
|
|
|
|
|
sub { |
56
|
4
|
|
|
4
|
|
54744
|
print Acme::SafetyGoggles::DIAG "IN F::S::fa\n"; |
57
|
4
|
|
|
|
|
20
|
my $count = $code->(); |
58
|
4
|
|
|
|
|
48
|
Acme::SafetyGoggles::_set_current; |
59
|
4
|
|
|
|
|
1823
|
return $count; |
60
|
2
|
|
|
|
|
27
|
} ); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub apply_safety_goggles { |
65
|
|
|
|
|
|
|
|
66
|
2
|
|
|
2
|
0
|
5
|
our @caller; |
67
|
2
|
|
|
|
|
4
|
our $current; |
68
|
|
|
|
|
|
|
|
69
|
2
|
|
|
|
|
3
|
print DIAG "applying safety googles\n"; |
70
|
|
|
|
|
|
|
|
71
|
2
|
|
|
0
|
|
18
|
FILTER { _set_current }; |
|
0
|
|
|
|
|
0
|
|
72
|
|
|
|
|
|
|
|
73
|
2
|
|
|
|
|
92
|
my ($pkg, $file, $l) = @caller; |
74
|
|
|
|
|
|
|
|
75
|
2
|
50
|
|
|
|
10
|
if ($file eq '-e') { |
76
|
0
|
|
|
|
|
0
|
carp "Acme::SafetyGoggles cannot protect against code in an '-e' construction"; |
77
|
0
|
|
|
|
|
0
|
return; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
2
|
|
|
|
|
4
|
my $vh; |
81
|
2
|
50
|
|
|
|
142
|
unless (open $vh, '<', $file) { |
82
|
0
|
|
|
|
|
0
|
carp "Acme::SafetyGoggles: cannot read source file $file ! $!\n"; |
83
|
0
|
|
|
|
|
0
|
return; |
84
|
|
|
|
|
|
|
} |
85
|
2
|
|
|
|
|
10
|
my $original = ''; |
86
|
2
|
|
|
|
|
5
|
my $original2 = ''; |
87
|
2
|
|
|
|
|
39
|
while (my $line = <$vh>) { |
88
|
29
|
50
|
|
|
|
66
|
last if $line =~ /^__END__$/; |
89
|
29
|
|
|
|
|
61
|
$original .= $line; |
90
|
29
|
|
|
|
|
38
|
$original2 .= $line; |
91
|
29
|
100
|
|
|
|
130
|
$original2 = "" if $line =~ /^use\s+Acme::SafetyGoggles\b/; |
92
|
|
|
|
|
|
|
} |
93
|
2
|
|
|
|
|
27
|
close $vh; |
94
|
|
|
|
|
|
|
|
95
|
2
|
|
|
|
|
18
|
$diff = Text::Diff::diff(\$original2, \$current, { STYLE => 'OldStyle' } ); |
96
|
2
|
|
66
|
|
|
1598
|
$diff &&= Text::Diff::diff(\$original, \$current, { STYLE => 'OldStyle' } ); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# it is ok if the original file contains extra lines at the top, ending |
99
|
|
|
|
|
|
|
# with the call to the source filter. |
100
|
|
|
|
|
|
|
# |
101
|
|
|
|
|
|
|
# Example: |
102
|
|
|
|
|
|
|
# |
103
|
|
|
|
|
|
|
# 1,3d0 |
104
|
|
|
|
|
|
|
# < #!/usr/bin/perl |
105
|
|
|
|
|
|
|
# < # this is my program with source filtering |
106
|
|
|
|
|
|
|
# < use The::Source::Filter; |
107
|
|
|
|
|
|
|
|
108
|
2
|
|
|
|
|
995
|
$diff =~ s{ |
109
|
|
|
|
|
|
|
^\d+(?:,\d+)?d0\s*\n |
110
|
|
|
|
|
|
|
(?:<.*\n)* |
111
|
|
|
|
|
|
|
<\s*use\s+\S+.*\n |
112
|
|
|
|
|
|
|
}{}x; |
113
|
|
|
|
|
|
|
|
114
|
2
|
100
|
|
|
|
10
|
if ($diff) { |
115
|
1
|
|
|
|
|
4
|
print DIAG "A::SG::asg: source code is unsafe\n"; |
116
|
1
|
|
|
|
|
3
|
$state = "unsafe"; |
117
|
1
|
|
|
|
|
1978
|
carp "File $file has been source filtered!\n", $diff, "===\n"; |
118
|
|
|
|
|
|
|
} else { |
119
|
1
|
|
|
|
|
3
|
print DIAG "A::SG::asg: source code is safe\n"; |
120
|
1
|
|
|
|
|
1332
|
$state = "safe"; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
}; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 NAME |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Acme::SafetyGoggles - Protects programmer's eyes from source filtering |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 VERSION |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Version 0.06 |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=cut |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head1 SYNOPSIS |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
$ perl -MAcme::SafetyGoggles possibly_dangerous_script.pl |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head1 DESCRIPTION |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Is some module you imported using source filtering? If the |
141
|
|
|
|
|
|
|
answer is yes, or if the answer is "I don't know", then |
142
|
|
|
|
|
|
|
you can't trust the code in front of your own eyes! |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
That's why you should always use patent-pending |
145
|
|
|
|
|
|
|
C in your untrusted Perl code. |
146
|
|
|
|
|
|
|
C compares your original source file |
147
|
|
|
|
|
|
|
with the code that is actually going to be run, and |
148
|
|
|
|
|
|
|
alerts you to any differences. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=head2 state |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=head2 Acme::SafetyGoggles->state |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
Returns this module's assessment of whether the source code |
157
|
|
|
|
|
|
|
of the current program has been modified. Return value is |
158
|
|
|
|
|
|
|
either C<"safe"> or C<"unsafe">. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 diff |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head2 Acme::SafetyGoggles->diff |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
If source code modification has been detected, returns the |
165
|
|
|
|
|
|
|
result of the C call between the pure and |
166
|
|
|
|
|
|
|
the modified source. This output will remind you of the |
167
|
|
|
|
|
|
|
output of the Unix C command. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
C can only (maybe) protect you from |
172
|
|
|
|
|
|
|
source filtering. It is not designed or warranted to |
173
|
|
|
|
|
|
|
protect you from improper use of any other potentially |
174
|
|
|
|
|
|
|
dangerous or evil Perl construction. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
C does not operate on code specified by |
177
|
|
|
|
|
|
|
perl's C<-e> command line option. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
C may yield a false positive if the input |
180
|
|
|
|
|
|
|
turns source code filtering on and off with calls to |
181
|
|
|
|
|
|
|
C |
182
|
|
|
|
|
|
|
in other files where the source filter has a limited scope. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
trustable_code(); |
185
|
|
|
|
|
|
|
use The::Source::Filter; |
186
|
|
|
|
|
|
|
some_code_you_cant_trust(); |
187
|
|
|
|
|
|
|
no The::Source::Filter; |
188
|
|
|
|
|
|
|
more_trustable_code(); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
trustable_code(); |
192
|
|
|
|
|
|
|
{ |
193
|
|
|
|
|
|
|
use The::Source::Filter; |
194
|
|
|
|
|
|
|
some_code_you_cant_trust(); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
more_trustable_code(); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=cut |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# How would we handle this case? Match a section of $original beginning |
201
|
|
|
|
|
|
|
# after a "use Some::Filter;" statement and before a "no Some::Filter;" |
202
|
|
|
|
|
|
|
# statement? |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=pod |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
This module really only works on source filters that already use |
207
|
|
|
|
|
|
|
the L mechanism. Even then, there are probably |
208
|
|
|
|
|
|
|
still a lot of ways to source filter the code so that it won't be |
209
|
|
|
|
|
|
|
detected by this module. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=cut |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# If we could intercept the source code in the Filter::Util::Call, |
214
|
|
|
|
|
|
|
# package, we could detect even more source code manipulation. |
215
|
|
|
|
|
|
|
# Filter::Util::Call has some XS, though. So is this possible? Feasible? |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=pod |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Please report any other bugs or feature requests to |
220
|
|
|
|
|
|
|
C, or through the web interface |
221
|
|
|
|
|
|
|
at L. |
222
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be given a commit bit |
223
|
|
|
|
|
|
|
for this distribution on PAUSE. Um, I mean that you'll |
224
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head1 AUTHOR |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Marty O'Brien, C<< >> |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 SUPPORT |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
perldoc Acme::SafetyGoggles |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
You can also look for information at: |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=over 4 |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
L |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
L |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=item * CPAN Ratings |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
L |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item * Search CPAN |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
L |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=back |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Inspired by comments on source filtering from stackoverflow.com's Ether: |
262
|
|
|
|
|
|
|
http://stackoverflow.com/questions/2818155/#2819871 |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Copyright 2010,2013 Marty O'Brien. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
269
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
270
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=cut |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
1; # End of Acme::SafetyGoggles |