File Coverage

blib/lib/Amon2/Util.pm
Criterion Covered Total %
statement 49 57 85.9
branch 5 8 62.5
condition 0 2 0.0
subroutine 12 13 92.3
pod 0 3 0.0
total 66 83 79.5


line stmt bran cond sub pod time code
1             use strict;
2 26     26   106258 use warnings;
  26         66  
  26         738  
3 26     26   128 use base qw/Exporter/;
  26         53  
  26         707  
4 26     26   132 use File::Spec;
  26         77  
  26         2147  
5 26     26   164 use MIME::Base64 ();
  26         50  
  26         664  
6 26     26   11957 use Digest::SHA ();
  26         17029  
  26         625  
7 26     26   13281 use Time::HiRes;
  26         79862  
  26         734  
8 26     26   191 use POSIX ();
  26         81  
  26         348  
9 26     26   2848 use Carp ();
  26         61  
  26         374  
10 26     26   114  
  26         52  
  26         1351  
11             our @EXPORT_OK = qw/add_method random_string/;
12              
13             my ($klass, $method, $code) = @_;
14             no strict 'refs';
15 13     13 0 38 *{"${klass}::${method}"} = $code;
16 26     26   169 }
  26         54  
  26         13182  
17 13         23  
  13         114  
18             my $path = shift;
19             $path =~ s!::!/!g;
20             if (my $libpath = $INC{"$path.pm"}) {
21 0     0 0 0 $libpath =~ s!\\!/!g; # win32
22 0         0 $libpath =~ s!(?:blib/)?lib/+$path\.pm$!!;
23 0 0       0 File::Spec->rel2abs($libpath || './');
24 0         0 } else {
25 0         0 File::Spec->rel2abs('./');
26 0   0     0 }
27             }
28 0         0  
29             our $URANDOM_FH;
30              
31             # $URANDOM_FH is undef if there is no /dev/urandom
32             open $URANDOM_FH, '<:raw', '/dev/urandom'
33             or do {
34             undef($URANDOM_FH);
35             warn "Cannot open /dev/urandom: $!.";
36             };
37              
38             my $len = shift;
39              
40             # 27 is the sha1_base64() length.
41             if ($len < 27) {
42 401     401 0 73679 Carp::cluck("Amon2::Util::random_string: Length too short. You should use 27+ bytes for security reason.");
43             }
44              
45 401 100       769 if ($URANDOM_FH) {
46 52         7633 my $src_len = POSIX::ceil($len/3.0*4.0);
47             # Generate session id from /dev/urandom.
48             my $read = read($URANDOM_FH, my $buf, $src_len);
49 401 100       884 if ($read != $src_len) {
50 201         586 die "Cannot read bytes from /dev/urandom: $!";
51             }
52 201         660 my $result = MIME::Base64::encode_base64($buf, '');
53 201 50       361 $result =~ tr|+/=|\-_|d; # make it url safe
54 0         0 return substr($result, 0, $len);
55             } else {
56 201         569 # It's weaker than above. But it's portable.
57 201         963 my $out = '';
58 201         758 while (length($out) < $len) {
59             my $sha1 = Digest::SHA::sha1_base64(rand() . $$ . {} . Time::HiRes::time());
60             $sha1 =~ tr|+/=|\-_|d; # make it url safe
61 200         277 $out .= $sha1;
62 200         364 }
63 438         4363 return substr($out, 0, $len);
64 438         951 }
65 438         914 }
66              
67 200         762 1;
68              
69             =head1 DESCRIPTION
70              
71             This is a utility class for Amon2. Do not use this directly.