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             package Amon2::Util;
2 26     26   100772 use strict;
  26         60  
  26         739  
3 26     26   126 use warnings;
  26         44  
  26         748  
4 26     26   136 use base qw/Exporter/;
  26         45  
  26         2114  
5 26     26   164 use File::Spec;
  26         60  
  26         734  
6 26     26   12301 use MIME::Base64 ();
  26         16951  
  26         695  
7 26     26   13199 use Digest::SHA ();
  26         80362  
  26         767  
8 26     26   12883 use Time::HiRes;
  26         30591  
  26         148  
9 26     26   3208 use POSIX ();
  26         103  
  26         474  
10 26     26   135 use Carp ();
  26         56  
  26         1429  
11              
12             our @EXPORT_OK = qw/add_method random_string/;
13              
14             sub add_method {
15 13     13 0 39 my ($klass, $method, $code) = @_;
16 26     26   178 no strict 'refs';
  26         53  
  26         12728  
17 13         24 *{"${klass}::${method}"} = $code;
  13         112  
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 66164 my $len = shift;
43              
44             # 27 is the sha1_base64() length.
45 401 100       757 if ($len < 27) {
46 52         7094 Carp::cluck("Amon2::Util::random_string: Length too short. You should use 27+ bytes for security reason.");
47             }
48              
49 401 100       847 if ($URANDOM_FH) {
50 201         569 my $src_len = POSIX::ceil($len/3.0*4.0);
51             # Generate session id from /dev/urandom.
52 201         1809 my $read = read($URANDOM_FH, my $buf, $src_len);
53 201 50       378 if ($read != $src_len) {
54 0         0 die "Cannot read bytes from /dev/urandom: $!";
55             }
56 201         512 my $result = MIME::Base64::encode_base64($buf, '');
57 201         410 $result =~ tr|+/=|\-_|d; # make it url safe
58 201         768 return substr($result, 0, $len);
59             } else {
60             # It's weaker than above. But it's portable.
61 200         276 my $out = '';
62 200         347 while (length($out) < $len) {
63 438         3969 my $sha1 = Digest::SHA::sha1_base64(rand() . $$ . {} . Time::HiRes::time());
64 438         937 $sha1 =~ tr|+/=|\-_|d; # make it url safe
65 438         951 $out .= $sha1;
66             }
67 200         663 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.