File Coverage

blib/lib/Crypt/Rhash.pm
Criterion Covered Total %
statement 164 173 94.8
branch 13 32 40.6
condition 4 7 57.1
subroutine 53 55 96.3
pod 14 16 87.5
total 248 283 87.6


line stmt bran cond sub pod time code
1             package Crypt::Rhash;
2              
3 3     3   49042 use 5.008008;
  3         9  
4 3     3   11 use strict;
  3         3  
  3         59  
5 3     3   10 use warnings;
  3         11  
  3         364  
6              
7             require Exporter;
8             our @ISA = (qw(Exporter));
9              
10             # possible tags for export
11             our %EXPORT_TAGS = (
12             Functions => [qw(raw2hex raw2base32 raw2base64)],
13             Constants => [qw(RHASH_CRC32 RHASH_MD4 RHASH_MD5 RHASH_SHA1 RHASH_TIGER
14             RHASH_TTH RHASH_BTIH RHASH_ED2K RHASH_AICH RHASH_WHIRLPOOL
15             RHASH_RIPEMD160 RHASH_GOST RHASH_GOST_CRYPTOPRO RHASH_HAS160
16             RHASH_SNEFRU128 RHASH_SNEFRU256 RHASH_SHA224 RHASH_SHA256
17             RHASH_SHA384 RHASH_SHA512 RHASH_EDONR256 RHASH_EDONR512
18             RHASH_SHA3_224 RHASH_SHA3_256 RHASH_SHA3_384 RHASH_SHA3_512 RHASH_ALL)]
19             );
20              
21             Exporter::export_tags( );
22             Exporter::export_ok_tags( qw(Functions Constants) );
23              
24             our $VERSION = '0.93';
25              
26             require XSLoader;
27             XSLoader::load('Crypt::Rhash', $VERSION);
28              
29             ##############################################################################
30             # ids of hash functions
31 3     3   17 use constant RHASH_CRC32 => 0x01;
  3         3  
  3         310  
32 3     3   13 use constant RHASH_MD4 => 0x02;
  3         3  
  3         138  
33 3     3   10 use constant RHASH_MD5 => 0x04;
  3         4  
  3         128  
34 3     3   13 use constant RHASH_SHA1 => 0x08;
  3         4  
  3         140  
35 3     3   12 use constant RHASH_TIGER => 0x10;
  3         3  
  3         137  
36 3     3   13 use constant RHASH_TTH => 0x20;
  3         3  
  3         122  
37 3     3   24 use constant RHASH_BTIH => 0x40;
  3         5  
  3         139  
38 3     3   10 use constant RHASH_ED2K => 0x80;
  3         5  
  3         131  
39 3     3   16 use constant RHASH_AICH => 0x100;
  3         3  
  3         113  
40 3     3   12 use constant RHASH_WHIRLPOOL => 0x200;
  3         3  
  3         550  
41 3     3   21 use constant RHASH_RIPEMD160 => 0x400;
  3         4  
  3         123  
42 3     3   10 use constant RHASH_GOST => 0x800;
  3         3  
  3         120  
43 3     3   11 use constant RHASH_GOST_CRYPTOPRO => 0x1000;
  3         3  
  3         120  
44 3     3   12 use constant RHASH_HAS160 => 0x2000;
  3         2  
  3         110  
45 3     3   14 use constant RHASH_SNEFRU128 => 0x4000;
  3         4  
  3         115  
46 3     3   12 use constant RHASH_SNEFRU256 => 0x8000;
  3         3  
  3         139  
47 3     3   11 use constant RHASH_SHA224 => 0x10000;
  3         4  
  3         119  
48 3     3   11 use constant RHASH_SHA256 => 0x20000;
  3         18  
  3         152  
49 3     3   12 use constant RHASH_SHA384 => 0x40000;
  3         3  
  3         117  
50 3     3   20 use constant RHASH_SHA512 => 0x80000;
  3         4  
  3         130  
51 3     3   12 use constant RHASH_EDONR256 => 0x100000;
  3         3  
  3         127  
52 3     3   9 use constant RHASH_EDONR512 => 0x200000;
  3         3  
  3         118  
53 3     3   10 use constant RHASH_SHA3_224 => 0x0400000;
  3         4  
  3         106  
54 3     3   10 use constant RHASH_SHA3_256 => 0x0800000;
  3         3  
  3         155  
55 3     3   12 use constant RHASH_SHA3_384 => 0x1000000;
  3         4  
  3         120  
56 3     3   10 use constant RHASH_SHA3_512 => 0x2000000;
  3         3  
  3         111  
57 3     3   10 use constant RHASH_ALL => 0x3FFFFFF;
  3         4  
  3         1552  
58              
59             ##############################################################################
60             # Rhash class methods
61              
62             # Rhash object constructor
63             sub new
64             {
65 5 50   5 0 193 my $hash_id = $_[1] or die "hash_id not specified";
66 5 50       103 my $context = rhash_init(scalar($hash_id)) or return undef;
67 5         24 my $self = {
68             context => $context,
69             };
70 5         16 return bless $self;
71             }
72              
73             # destructor
74             sub DESTROY($)
75             {
76 3     3   7 my $self = shift;
77             # the 'if' added as workaround for perl 'global destruction' bug
78             # ($self->{context} can disappear on global destruction)
79 3 50       32 rhash_free($self->{context}) if $self->{context};
80             }
81              
82             sub update($$)
83             {
84 4     4 1 9 my $self = shift;
85 4         6 my $message = shift;
86 4         51 rhash_update($self->{context}, $message);
87 4         14 return $self;
88             }
89              
90             sub update_fd($$;$$)
91             {
92 3     3 1 3 my ($self, $fd, $start, $size) = @_;
93 3         4 my $res = 0;
94 3         3 my $num = 0;
95              
96 3         6 binmode($fd);
97 3 100       7 if(defined($start)) {
98 1 50       9 seek($fd, scalar($start), 0) or return undef;
99             }
100              
101 3         3 my $data;
102 3 100       7 if(defined($size)) {
103 1         5 for(my $left = scalar($size); $left > 0; $left -= 8192) {
104 1 50       17 ($res = read($fd, $data,
    50          
105             ($left < 8192 ? $left : 8192))) || last;
106 1         5 rhash_update($self->{context}, $data);
107 1         4 $num += $res;
108             }
109             } else {
110 2         33 while( ($res = read($fd, $data, 8192)) ) {
111 2         8 rhash_update($self->{context}, $data);
112 2         7 $num += $res;
113             }
114             }
115              
116 3 50       9 return (defined($res) ? $num : undef); # return undef on read error
117             }
118              
119             sub update_file($$;$$)
120             {
121 2     2 1 7 my ($self, $file, $start, $size) = @_;
122 2 50       56 open(my $fd, "<", $file) or return undef;
123 2         7 my $res = $self->update_fd($fd, $start, $size);
124 2         15 close($fd);
125 2         11 return $res;
126             }
127              
128             sub final($)
129             {
130 3     3 1 4 my $self = shift;
131 3         394 rhash_final($self->{context});
132 3         7 return $self;
133             }
134              
135             sub reset($)
136             {
137 3     3 1 5 my $self = shift;
138 3         13 rhash_reset($self->{context});
139 3         9 return $self;
140             }
141              
142             sub hashed_length($)
143             {
144 1     1 1 2 my $self = shift;
145 1         7 return rhash_get_hashed_length($self->{context});
146             }
147              
148             sub hash_id($)
149             {
150 1     1 1 2 my $self = shift;
151 1         9 return rhash_get_hash_id($self->{context});
152             }
153              
154             ##############################################################################
155             # Hash formatting functions
156              
157             # printing constants
158 3     3   17 use constant RHPR_DEFAULT => 0x0;
  3         26  
  3         142  
159 3     3   11 use constant RHPR_RAW => 0x1;
  3         3  
  3         112  
160 3     3   12 use constant RHPR_HEX => 0x2;
  3         3  
  3         107  
161 3     3   11 use constant RHPR_BASE32 => 0x3;
  3         2  
  3         115  
162 3     3   12 use constant RHPR_BASE64 => 0x4;
  3         21  
  3         114  
163 3     3   11 use constant RHPR_UPPERCASE => 0x8;
  3         4  
  3         105  
164 3     3   12 use constant RHPR_REVERSE => 0x10;
  3         3  
  3         1565  
165              
166             sub hash($;$$)
167             {
168 37     37 1 55 my $self = shift;
169 37   100     105 my $hash_id = scalar(shift) || 0;
170 37   100     121 my $print_flags = scalar(shift) || RHPR_DEFAULT;
171 37         401 return rhash_print($self->{context}, $hash_id, $print_flags);
172             }
173              
174             sub hash_base32($;$)
175             {
176 1     1 1 4 hash($_[0], $_[1], RHPR_BASE32);
177             }
178              
179             sub hash_base64($;$)
180             {
181 0     0 1 0 hash($_[0], $_[1], RHPR_BASE64);
182             }
183              
184             sub hash_hex($;$)
185             {
186 2     2 1 6 hash($_[0], $_[1], RHPR_HEX);
187             }
188              
189             sub hash_rhex($;$)
190             {
191 1     1 1 6 hash($_[0], $_[1], RHPR_HEX | RHPR_REVERSE);
192             }
193              
194             sub hash_raw($;$)
195             {
196 1     1 0 3 hash($_[0], $_[1], RHPR_RAW);
197             }
198              
199             sub magnet_link($;$$)
200             {
201 3     3 1 5 my ($self, $filename, $hash_mask) = @_;
202 3         31 return rhash_print_magnet($self->{context}, $filename, $hash_mask);
203             }
204              
205             our $AUTOLOAD;
206              
207             # report error if a script called unexisting method/field
208             sub AUTOLOAD
209             {
210 0     0   0 my ($self, $field, $type, $pkg) = ($_[0], $AUTOLOAD, undef, __PACKAGE__);
211 0         0 $field =~ s/.*://;
212 0 0       0 die "function $field does not exist" if $field =~ /^(rhash_|raw2)/;
213 0 0       0 die "no arguments specified to $field()" if !@_;
214 0 0       0 die "the $field() argument is undefined" if !defined $self;
215              
216 0 0 0     0 ($type = ref($self)) && $type eq $pkg || die "the $field() argument is not a $pkg reference";
217 0 0       0 my $text = (exists $self->{$field} ? "is not accessible" : "does not exist");
218 0         0 die "the method $field() $text in the class $pkg";
219             }
220              
221             # static functions
222              
223             sub msg($$)
224             {
225 1     1 1 3027 my ($hash_id, $msg) = @_;
226 1         15 my $raw = rhash_msg_raw($hash_id, $msg); # get binary hash
227 1 50       14 return (is_base32($hash_id) ? raw2base32($raw) : raw2hex($raw));
228             }
229              
230             1;
231             __END__