line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- mode: perl; coding: utf-8 -*- |
2
|
|
|
|
|
|
|
package YATT::Util::Taint; |
3
|
13
|
|
|
13
|
|
49
|
use base qw(Exporter); |
|
13
|
|
|
|
|
14
|
|
|
13
|
|
|
|
|
710
|
|
4
|
13
|
|
|
13
|
|
48
|
use strict; |
|
13
|
|
|
|
|
15
|
|
|
13
|
|
|
|
|
303
|
|
5
|
13
|
|
|
13
|
|
39
|
use warnings FATAL => qw(all); |
|
13
|
|
|
|
|
12
|
|
|
13
|
|
|
|
|
629
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
13
|
|
|
13
|
|
30
|
our @EXPORT_OK = qw(&untaint_any &is_tainted); |
9
|
13
|
|
|
|
|
1500
|
our @EXPORT = @EXPORT_OK; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
if (eval {require Scalar::Util} and not $@) { |
13
|
|
|
|
|
|
|
*is_tainted = \&Scalar::Util::tainted; |
14
|
|
|
|
|
|
|
} else { |
15
|
|
|
|
|
|
|
*is_tainted = sub { |
16
|
|
|
|
|
|
|
return not eval { eval("#" . substr(join("", @_), 0, 0)); 1 }; |
17
|
|
|
|
|
|
|
}; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub untaint_any ($) { |
21
|
545
|
50
|
33
|
545
|
0
|
5764
|
$1 if defined $_[0] && $_[0] =~ m{(.*)}s; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
1; |