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   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.