]> iEval git - acme-evil.git/blame - lib/evil.pm
Add lots of tests
[acme-evil.git] / lib / evil.pm
CommitLineData
f17ddf12
MG
1#!/usr/bin/perl
2package evil;
3
4use 5.008009;
5use strict;
6use warnings;
7
8use Carp;
9
2f63ec14
MG
10my $INTERMEDIATE = __PACKAGE__.'/intermediate';
11my $LAX = __PACKAGE__.'/lax';
12
23276fbe 13our $VERSION = 0.002;
f17ddf12
MG
14
15our %tainted;
2f63ec14 16our %wants_strict;
f17ddf12
MG
17
18sub import {
2f63ec14
MG
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
f17ddf12 36 $tainted{caller()} = 1;
f17ddf12
MG
37}
38
39sub unimport {
277b168d
MG
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, @_;
2f63ec14
MG
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
f17ddf12
MG
60 }
61}
62
631;
64__END__
65
66=encoding utf-8
67
68=head1 NAME
69
70evil - RFC 3514 (evil bit) implementation for Perl modules
71
72=head1 SYNOPSIS
73
74 # in A.pm
75 package A;
76 use evil;
f17ddf12
MG
77
78 # in B.pm
79 package B;
80 no evil ':strict';
81 use A; # <dies>
f17ddf12 82
177e0245
MG
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
f17ddf12
MG
102
103=head1 DESCRIPTION
104
105L<RFC3514|https://www.ietf.org/rfc/rfc3514.txt> introduces a new flag
106called the "evil bit" in all IP packets. The intention is to simplify
107the work of firewalls. Software that sends IP packets with malicious
108intent must set the evil bit to true, and firewalls can simply drop
109such packets.
110
111The evil pragma is a Perl implementation of the same concept. With
112this pragma malicious modules can declare their evil intent while
113critical modules can request that they will only use / run alongside
114non-evil code.
115
116The pragma can be used in the following ways:
117
118=over
119
120=item use B<evil>;
121
122Marks the current package as evil. All malicious modules MUST use this
177e0245 123directive to ensure the full functionality of this pragma.
f17ddf12
MG
124
125=item no B<evil> ':strict';
126
127The calling module function properly if malignant code is loaded
128anywhere in the program. Throws an exception if an evil module is
129loaded, whether at the moment of calling this pragma or in the future.
130
c72607e1
MG
131=item no B<evil> ':disable';
132
177e0245
MG
133Removes the effect of any previous C<no B<evil> ':something'> used in
134this module, thus stating the module does not care about evil code.
c72607e1 135
177e0245 136=item no B<evil> ':intermediate'
f17ddf12 137
177e0245
MG
138The calling module cannot function properly if it is using evil code,
139whether directly or indirectly. Throws an exception if an evil module
140is subsequently loaded by the calling module or by one of the children
141modules (or by one of their children modules, etc). Also throws an
142exception if the current module is evil.
f17ddf12 143
177e0245 144=item no B<evil> ':lax';
f17ddf12 145
177e0245
MG
146The calling module cannot function properly if it is using evil code
147direcly. Throws an exception if the calling module subsequently loads
148an evil module, or if the current module is evil.
f17ddf12
MG
149
150=item no B<evil>;
151
177e0245 152Synonym for C<no evil ':intermediate'>.
f17ddf12
MG
153
154=back
155
177e0245
MG
156=head1 CAVEATS
157
158When using intermediate and lax modes, any evil modules loaded before
159the pragma is enabled are ignored. This is by design, to allow
160temporarily disabling the pragma. An example:
161
162 package MyModule;
163 no evil;
164 use Some::Module;
165 use Another::Module;
166
167 no evil ':disable';
168 use Evil::Module; # does not die
169 no evil;
170
171 use Some::More::Modules;
172 ...
173
174Correct functioning of this pragma depends critically on the evil bit
175being set properly. If a faulty evil module fails to C<use evil;>, the
176pragma will not function properly.
177
f17ddf12
MG
178=head1 AUTHOR
179
180Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
181
182=head1 COPYRIGHT AND LICENSE
183
184Copyright (C) 2016 by Marius Gavrilescu
185
186This library is free software; you can redistribute it and/or modify
187it under the same terms as Perl itself, either Perl version 5.22.2 or,
188at your option, any later version of Perl 5 you may have available.
189
190
191=cut
This page took 0.04532 seconds and 4 git commands to generate.