File Coverage

blib/lib/Crypt/Rhash.pm
Criterion Covered Total %
statement 178 188 94.6
branch 14 34 41.1
condition 5 10 50.0
subroutine 56 58 96.5
pod 14 16 87.5
total 267 306 87.2


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