File Coverage

blib/lib/Acme/SafetyGoggles.pm
Criterion Covered Total %
statement 61 66 92.4
branch 9 12 75.0
condition 2 3 66.6
subroutine 15 16 93.7
pod 2 3 66.6
total 89 100 89.0


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 ... C, or
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