line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Amon2::Util; |
2
|
26
|
|
|
26
|
|
100338
|
use strict; |
|
26
|
|
|
|
|
63
|
|
|
26
|
|
|
|
|
745
|
|
3
|
26
|
|
|
26
|
|
193
|
use warnings; |
|
26
|
|
|
|
|
47
|
|
|
26
|
|
|
|
|
751
|
|
4
|
26
|
|
|
26
|
|
126
|
use base qw/Exporter/; |
|
26
|
|
|
|
|
48
|
|
|
26
|
|
|
|
|
2052
|
|
5
|
26
|
|
|
26
|
|
169
|
use File::Spec; |
|
26
|
|
|
|
|
50
|
|
|
26
|
|
|
|
|
654
|
|
6
|
26
|
|
|
26
|
|
12691
|
use MIME::Base64 (); |
|
26
|
|
|
|
|
16531
|
|
|
26
|
|
|
|
|
624
|
|
7
|
26
|
|
|
26
|
|
13889
|
use Digest::SHA (); |
|
26
|
|
|
|
|
79750
|
|
|
26
|
|
|
|
|
793
|
|
8
|
26
|
|
|
26
|
|
13918
|
use Time::HiRes; |
|
26
|
|
|
|
|
31114
|
|
|
26
|
|
|
|
|
166
|
|
9
|
26
|
|
|
26
|
|
2981
|
use POSIX (); |
|
26
|
|
|
|
|
57
|
|
|
26
|
|
|
|
|
474
|
|
10
|
26
|
|
|
26
|
|
151
|
use Carp (); |
|
26
|
|
|
|
|
50
|
|
|
26
|
|
|
|
|
1410
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @EXPORT_OK = qw/add_method random_string/; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub add_method { |
15
|
13
|
|
|
13
|
0
|
46
|
my ($klass, $method, $code) = @_; |
16
|
26
|
|
|
26
|
|
171
|
no strict 'refs'; |
|
26
|
|
|
|
|
48
|
|
|
26
|
|
|
|
|
12815
|
|
17
|
13
|
|
|
|
|
26
|
*{"${klass}::${method}"} = $code; |
|
13
|
|
|
|
|
108
|
|
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub base_dir($) { |
21
|
0
|
|
|
0
|
0
|
0
|
my $path = shift; |
22
|
0
|
|
|
|
|
0
|
$path =~ s!::!/!g; |
23
|
0
|
0
|
|
|
|
0
|
if (my $libpath = $INC{"$path.pm"}) { |
24
|
0
|
|
|
|
|
0
|
$libpath =~ s!\\!/!g; # win32 |
25
|
0
|
|
|
|
|
0
|
$libpath =~ s!(?:blib/)?lib/+$path\.pm$!!; |
26
|
0
|
|
0
|
|
|
0
|
File::Spec->rel2abs($libpath || './'); |
27
|
|
|
|
|
|
|
} else { |
28
|
0
|
|
|
|
|
0
|
File::Spec->rel2abs('./'); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $URANDOM_FH; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# $URANDOM_FH is undef if there is no /dev/urandom |
35
|
|
|
|
|
|
|
open $URANDOM_FH, '<:raw', '/dev/urandom' |
36
|
|
|
|
|
|
|
or do { |
37
|
|
|
|
|
|
|
undef($URANDOM_FH); |
38
|
|
|
|
|
|
|
warn "Cannot open /dev/urandom: $!."; |
39
|
|
|
|
|
|
|
}; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub random_string { |
42
|
401
|
|
|
401
|
0
|
59211
|
my $len = shift; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# 27 is the sha1_base64() length. |
45
|
401
|
100
|
|
|
|
819
|
if ($len < 27) { |
46
|
52
|
|
|
|
|
6742
|
Carp::cluck("Amon2::Util::random_string: Length too short. You should use 27+ bytes for security reason."); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
401
|
100
|
|
|
|
909
|
if ($URANDOM_FH) { |
50
|
201
|
|
|
|
|
568
|
my $src_len = POSIX::ceil($len/3.0*4.0); |
51
|
|
|
|
|
|
|
# Generate session id from /dev/urandom. |
52
|
201
|
|
|
|
|
1854
|
my $read = read($URANDOM_FH, my $buf, $src_len); |
53
|
201
|
50
|
|
|
|
381
|
if ($read != $src_len) { |
54
|
0
|
|
|
|
|
0
|
die "Cannot read bytes from /dev/urandom: $!"; |
55
|
|
|
|
|
|
|
} |
56
|
201
|
|
|
|
|
572
|
my $result = MIME::Base64::encode_base64($buf, ''); |
57
|
201
|
|
|
|
|
369
|
$result =~ tr|+/=|\-_|d; # make it url safe |
58
|
201
|
|
|
|
|
734
|
return substr($result, 0, $len); |
59
|
|
|
|
|
|
|
} else { |
60
|
|
|
|
|
|
|
# It's weaker than above. But it's portable. |
61
|
200
|
|
|
|
|
274
|
my $out = ''; |
62
|
200
|
|
|
|
|
365
|
while (length($out) < $len) { |
63
|
438
|
|
|
|
|
4308
|
my $sha1 = Digest::SHA::sha1_base64(rand() . $$ . {} . Time::HiRes::time()); |
64
|
438
|
|
|
|
|
988
|
$sha1 =~ tr|+/=|\-_|d; # make it url safe |
65
|
438
|
|
|
|
|
899
|
$out .= $sha1; |
66
|
|
|
|
|
|
|
} |
67
|
200
|
|
|
|
|
719
|
return substr($out, 0, $len); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
1; |
72
|
|
|
|
|
|
|
__END__ |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head1 DESCRIPTION |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
This is a utility class for Amon2. Do not use this directly. |