]> iEval git - acme-evil.git/blob - lib/evil.pm
449b6c160f691e87ec8cd6eb36f1cc19466614a3
[acme-evil.git] / lib / evil.pm
1 #!/usr/bin/perl
2 package evil;
3
4 use 5.010001;
5 use strict;
6 use warnings;
7
8 use Carp;
9
10 my $INTERMEDIATE = __PACKAGE__.'/intermediate';
11 my $LAX = __PACKAGE__.'/lax';
12
13 our $VERSION = 0.003;
14
15 our %tainted;
16 our %wants_strict;
17
18 sub import {
19 croak "Cannot load evil module when \"no evil ':strict'\" is in effect" if %wants_strict;
20
21 my $hinthash = (caller 0)[10] || {};
22 croak "Current module requested no evilness" if $hinthash->{$LAX};
23
24 $hinthash = (caller 3)[10] || {};
25 croak "Cannot load evil module when parent requested \"no evil ':lax'\"" if $hinthash->{$LAX};
26
27 my $level = 4;
28 my @caller;
29 while (@caller = caller $level) {
30 $hinthash = $caller[10] || {};
31 croak "Cannot load evil module when ancestor requested \"no evil ':intermediate'\""
32 if $hinthash->{$INTERMEDIATE};
33 $level++;
34 }
35
36 $tainted{caller()} = 1;
37 }
38
39 sub unimport {
40 my $strict_arg = grep /^:strict$/i, @_;
41 my $intermediate_arg = grep /^:intermediate$/i, @_;
42 my $lax_arg = grep /^:lax$/i, @_;
43 my $disable_arg = grep /^:disable$/i, @_;
44
45 if (!$disable_arg && $tainted{caller()}) { # caller is evil
46 croak 'Current module is evil'
47 }
48
49 if ($strict_arg) {
50 $wants_strict{caller()} = 1;
51 croak "Evil module already loaded. Cannot enforce \"no evil ':strict'\"" if %tainted
52 } elsif ($lax_arg) {
53 $^H{$LAX} = 1
54 } elsif ($disable_arg) {
55 delete $wants_strict{caller()};
56 delete $^H{$LAX};
57 delete $^H{$INTERMEDIATE};
58 } else { # $intermediate_arg or no arg
59 $^H{$INTERMEDIATE} = $^H{$LAX} = 1
60 }
61 }
62
63 1;
64 __END__
65
66 =encoding utf-8
67
68 =head1 NAME
69
70 evil - RFC 3514 (evil bit) implementation for Perl modules
71
72 =head1 SYNOPSIS
73
74 # in A.pm
75 package A;
76 use evil;
77
78 # in B.pm
79 package B;
80 no evil ':strict';
81 use A; # <dies>
82
83 # in C.pm
84 package C;
85 use A;
86
87 # in D.pm
88 package D;
89 no evil;
90 use C; # <dies>
91
92 # in E.pm
93 package E;
94 no evil ':lax';
95 use C; # does not die, as C is not evil
96
97 # in F.pm
98 package F;
99 use C;
100 no evil;
101 # does not die, as modules loaded before the pragma are ignored
102
103 =head1 DESCRIPTION
104
105 L<RFC3514|https://www.ietf.org/rfc/rfc3514.txt> introduces a new flag
106 called the "evil bit" in all IP packets. The intention is to simplify
107 the work of firewalls. Software that sends IP packets with malicious
108 intent must set the evil bit to true, and firewalls can simply drop
109 such packets.
110
111 The evil pragma is a Perl implementation of the same concept. With
112 this pragma malicious modules can declare their evil intent while
113 critical modules can request that they will only use / run alongside
114 non-evil code.
115
116 The pragma can be used in the following ways:
117
118 =over
119
120 =item use B<evil>;
121
122 Marks the current package as evil. All malicious modules MUST use this
123 directive to ensure the full functionality of this pragma.
124
125 =item no B<evil> ':strict';
126
127 The calling module function properly if malignant code is loaded
128 anywhere in the program. Throws an exception if an evil module is
129 loaded, whether at the moment of calling this pragma or in the future.
130
131 =item no B<evil> ':disable';
132
133 Removes the effect of any previous C<no B<evil> ':something'> used in
134 this module, thus stating the module does not care about evil code.
135
136 =item no B<evil> ':intermediate'
137
138 The calling module cannot function properly if it is using evil code,
139 whether directly or indirectly. Throws an exception if an evil module
140 is subsequently loaded by the calling module or by one of the children
141 modules (or by one of their children modules, etc). Also throws an
142 exception if the current module is evil.
143
144 =item no B<evil> ':lax';
145
146 The calling module cannot function properly if it is using evil code
147 direcly. Throws an exception if the calling module subsequently loads
148 an evil module, or if the current module is evil.
149
150 =item no B<evil>;
151
152 Synonym for C<no evil ':intermediate'>.
153
154 =back
155
156 =head1 BUGS
157
158 The following does not die:
159
160 # Evil.pm
161 package Evil;
162 use evil;
163
164 # A.pm
165 package A;
166 use Evil;
167
168 # B.pm
169 package B;
170 no evil ':intermediate';
171 use Evil;
172
173 # script.pl
174 #!/usr/bin/perl
175 use A;
176 use B;
177
178 Since Evil was loaded by A, B does not load Evil and therefore does
179 not detect that Evil is... evil. If we loaded B before A in script.pl,
180 we would get an exception. So order of loading modules matters for
181 intermediate and lax modes. Strict mode is unaffected by this bug.
182
183 =head1 CAVEATS
184
185 When using intermediate and lax modes, any evil modules loaded before
186 the pragma is enabled are ignored. This is by design, to allow
187 temporarily disabling the pragma. An example:
188
189 package MyModule;
190 no evil;
191 use Some::Module;
192 use Another::Module;
193
194 no evil ':disable';
195 use Evil::Module; # does not die
196 no evil;
197
198 use Some::More::Modules;
199 ...
200
201 Correct functioning of this pragma depends critically on the evil bit
202 being set properly. If a faulty evil module fails to C<use evil;>, the
203 pragma will not function properly.
204
205 =head1 AUTHOR
206
207 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
208
209 =head1 COPYRIGHT AND LICENSE
210
211 Copyright (C) 2016-2017 by Marius Gavrilescu
212
213 This library is free software; you can redistribute it and/or modify
214 it under the same terms as Perl itself, either Perl version 5.22.2 or,
215 at your option, any later version of Perl 5 you may have available.
216
217
218 =cut
This page took 0.064501 seconds and 3 git commands to generate.