Initial Commit
This commit is contained in:
Riley Schneider
388
database/perl/lib/Digest/MD5.pm
Normal file
388
database/perl/lib/Digest/MD5.pm
Normal file
@@ -0,0 +1,388 @@
|
||||
package Digest::MD5;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.58';
|
||||
|
||||
require Exporter;
|
||||
*import = \&Exporter::import;
|
||||
our @EXPORT_OK = qw(md5 md5_hex md5_base64);
|
||||
|
||||
our @ISA;
|
||||
eval {
|
||||
require Digest::base;
|
||||
@ISA = qw/Digest::base/;
|
||||
};
|
||||
if ($@) {
|
||||
my $err = $@;
|
||||
*add_bits = sub { die $err };
|
||||
}
|
||||
|
||||
|
||||
eval {
|
||||
require XSLoader;
|
||||
XSLoader::load('Digest::MD5', $VERSION);
|
||||
};
|
||||
if ($@) {
|
||||
my $olderr = $@;
|
||||
eval {
|
||||
# Try to load the pure perl version
|
||||
require Digest::Perl::MD5;
|
||||
|
||||
Digest::Perl::MD5->import(qw(md5 md5_hex md5_base64));
|
||||
unshift(@ISA, "Digest::Perl::MD5"); # make OO interface work
|
||||
};
|
||||
if ($@) {
|
||||
# restore the original error
|
||||
die $olderr;
|
||||
}
|
||||
}
|
||||
else {
|
||||
*reset = \&new;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Digest::MD5 - Perl interface to the MD5 Algorithm
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# Functional style
|
||||
use Digest::MD5 qw(md5 md5_hex md5_base64);
|
||||
|
||||
$digest = md5($data);
|
||||
$digest = md5_hex($data);
|
||||
$digest = md5_base64($data);
|
||||
|
||||
# OO style
|
||||
use Digest::MD5;
|
||||
|
||||
$ctx = Digest::MD5->new;
|
||||
|
||||
$ctx->add($data);
|
||||
$ctx->addfile($file_handle);
|
||||
|
||||
$digest = $ctx->digest;
|
||||
$digest = $ctx->hexdigest;
|
||||
$digest = $ctx->b64digest;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The C<Digest::MD5> module allows you to use the RSA Data Security
|
||||
Inc. MD5 Message Digest algorithm from within Perl programs. The
|
||||
algorithm takes as input a message of arbitrary length and produces as
|
||||
output a 128-bit "fingerprint" or "message digest" of the input.
|
||||
|
||||
Note that the MD5 algorithm is not as strong as it used to be. It has
|
||||
since 2005 been easy to generate different messages that produce the
|
||||
same MD5 digest. It still seems hard to generate messages that
|
||||
produce a given digest, but it is probably wise to move to stronger
|
||||
algorithms for applications that depend on the digest to uniquely identify
|
||||
a message.
|
||||
|
||||
The C<Digest::MD5> module provide a procedural interface for simple
|
||||
use, as well as an object oriented interface that can handle messages
|
||||
of arbitrary length and which can read files directly.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
The following functions are provided by the C<Digest::MD5> module.
|
||||
None of these functions are exported by default.
|
||||
|
||||
=over 4
|
||||
|
||||
=item md5($data,...)
|
||||
|
||||
This function will concatenate all arguments, calculate the MD5 digest
|
||||
of this "message", and return it in binary form. The returned string
|
||||
will be 16 bytes long.
|
||||
|
||||
The result of md5("a", "b", "c") will be exactly the same as the
|
||||
result of md5("abc").
|
||||
|
||||
=item md5_hex($data,...)
|
||||
|
||||
Same as md5(), but will return the digest in hexadecimal form. The
|
||||
length of the returned string will be 32 and it will only contain
|
||||
characters from this set: '0'..'9' and 'a'..'f'.
|
||||
|
||||
=item md5_base64($data,...)
|
||||
|
||||
Same as md5(), but will return the digest as a base64 encoded string.
|
||||
The length of the returned string will be 22 and it will only contain
|
||||
characters from this set: 'A'..'Z', 'a'..'z', '0'..'9', '+' and
|
||||
'/'.
|
||||
|
||||
Note that the base64 encoded string returned is not padded to be a
|
||||
multiple of 4 bytes long. If you want interoperability with other
|
||||
base64 encoded md5 digests you might want to append the redundant
|
||||
string "==" to the result.
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
The object oriented interface to C<Digest::MD5> is described in this
|
||||
section. After a C<Digest::MD5> object has been created, you will add
|
||||
data to it and finally ask for the digest in a suitable format. A
|
||||
single object can be used to calculate multiple digests.
|
||||
|
||||
The following methods are provided:
|
||||
|
||||
=over 4
|
||||
|
||||
=item $md5 = Digest::MD5->new
|
||||
|
||||
The constructor returns a new C<Digest::MD5> object which encapsulate
|
||||
the state of the MD5 message-digest algorithm.
|
||||
|
||||
If called as an instance method (i.e. $md5->new) it will just reset the
|
||||
state the object to the state of a newly created object. No new
|
||||
object is created in this case.
|
||||
|
||||
=item $md5->reset
|
||||
|
||||
This is just an alias for $md5->new.
|
||||
|
||||
=item $md5->clone
|
||||
|
||||
This a copy of the $md5 object. It is useful when you do not want to
|
||||
destroy the digests state, but need an intermediate value of the
|
||||
digest, e.g. when calculating digests iteratively on a continuous data
|
||||
stream. Example:
|
||||
|
||||
my $md5 = Digest::MD5->new;
|
||||
while (<>) {
|
||||
$md5->add($_);
|
||||
print "Line $.: ", $md5->clone->hexdigest, "\n";
|
||||
}
|
||||
|
||||
=item $md5->add($data,...)
|
||||
|
||||
The $data provided as argument are appended to the message we
|
||||
calculate the digest for. The return value is the $md5 object itself.
|
||||
|
||||
All these lines will have the same effect on the state of the $md5
|
||||
object:
|
||||
|
||||
$md5->add("a"); $md5->add("b"); $md5->add("c");
|
||||
$md5->add("a")->add("b")->add("c");
|
||||
$md5->add("a", "b", "c");
|
||||
$md5->add("abc");
|
||||
|
||||
=item $md5->addfile($io_handle)
|
||||
|
||||
The $io_handle will be read until EOF and its content appended to the
|
||||
message we calculate the digest for. The return value is the $md5
|
||||
object itself.
|
||||
|
||||
The addfile() method will croak() if it fails reading data for some
|
||||
reason. If it croaks it is unpredictable what the state of the $md5
|
||||
object will be in. The addfile() method might have been able to read
|
||||
the file partially before it failed. It is probably wise to discard
|
||||
or reset the $md5 object if this occurs.
|
||||
|
||||
In most cases you want to make sure that the $io_handle is in
|
||||
C<binmode> before you pass it as argument to the addfile() method.
|
||||
|
||||
=item $md5->add_bits($data, $nbits)
|
||||
|
||||
=item $md5->add_bits($bitstring)
|
||||
|
||||
Since the MD5 algorithm is byte oriented you might only add bits as
|
||||
multiples of 8, so you probably want to just use add() instead. The
|
||||
add_bits() method is provided for compatibility with other digest
|
||||
implementations. See L<Digest> for description of the arguments
|
||||
that add_bits() take.
|
||||
|
||||
=item $md5->digest
|
||||
|
||||
Return the binary digest for the message. The returned string will be
|
||||
16 bytes long.
|
||||
|
||||
Note that the C<digest> operation is effectively a destructive,
|
||||
read-once operation. Once it has been performed, the C<Digest::MD5>
|
||||
object is automatically C<reset> and can be used to calculate another
|
||||
digest value. Call $md5->clone->digest if you want to calculate the
|
||||
digest without resetting the digest state.
|
||||
|
||||
=item $md5->hexdigest
|
||||
|
||||
Same as $md5->digest, but will return the digest in hexadecimal
|
||||
form. The length of the returned string will be 32 and it will only
|
||||
contain characters from this set: '0'..'9' and 'a'..'f'.
|
||||
|
||||
=item $md5->b64digest
|
||||
|
||||
Same as $md5->digest, but will return the digest as a base64 encoded
|
||||
string. The length of the returned string will be 22 and it will only
|
||||
contain characters from this set: 'A'..'Z', 'a'..'z', '0'..'9', '+'
|
||||
and '/'.
|
||||
|
||||
|
||||
The base64 encoded string returned is not padded to be a multiple of 4
|
||||
bytes long. If you want interoperability with other base64 encoded
|
||||
md5 digests you might want to append the string "==" to the result.
|
||||
|
||||
=item @ctx = $md5->context
|
||||
|
||||
=item $md5->context(@ctx)
|
||||
|
||||
Saves or restores the internal state.
|
||||
When called with no arguments, returns a list:
|
||||
number of blocks processed,
|
||||
a 16-byte internal state buffer,
|
||||
then optionally up to 63 bytes of unprocessed data if there are any.
|
||||
When passed those same arguments, restores the state.
|
||||
This is only useful for specialised operations.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
The simplest way to use this library is to import the md5_hex()
|
||||
function (or one of its cousins):
|
||||
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
print "Digest is ", md5_hex("foobarbaz"), "\n";
|
||||
|
||||
The above example would print out the message:
|
||||
|
||||
Digest is 6df23dc03f9b54cc38a0fc1483df6e21
|
||||
|
||||
The same checksum can also be calculated in OO style:
|
||||
|
||||
use Digest::MD5;
|
||||
|
||||
$md5 = Digest::MD5->new;
|
||||
$md5->add('foo', 'bar');
|
||||
$md5->add('baz');
|
||||
$digest = $md5->hexdigest;
|
||||
|
||||
print "Digest is $digest\n";
|
||||
|
||||
With OO style, you can break the message arbitrarily. This means that we
|
||||
are no longer limited to have space for the whole message in memory, i.e.
|
||||
we can handle messages of any size.
|
||||
|
||||
This is useful when calculating checksum for files:
|
||||
|
||||
use Digest::MD5;
|
||||
|
||||
my $filename = shift || "/etc/passwd";
|
||||
open (my $fh, '<', $filename) or die "Can't open '$filename': $!";
|
||||
binmode($fh);
|
||||
|
||||
$md5 = Digest::MD5->new;
|
||||
while (<$fh>) {
|
||||
$md5->add($_);
|
||||
}
|
||||
close($fh);
|
||||
print $md5->b64digest, " $filename\n";
|
||||
|
||||
Or we can use the addfile method for more efficient reading of
|
||||
the file:
|
||||
|
||||
use Digest::MD5;
|
||||
|
||||
my $filename = shift || "/etc/passwd";
|
||||
open (my $fh, '<', $filename) or die "Can't open '$filename': $!";
|
||||
binmode ($fh);
|
||||
|
||||
print Digest::MD5->new->addfile($fh)->hexdigest, " $filename\n";
|
||||
|
||||
Since the MD5 algorithm is only defined for strings of bytes, it can not be
|
||||
used on strings that contains chars with ordinal number above 255 (Unicode
|
||||
strings). The MD5 functions and methods will croak if you try to feed them
|
||||
such input data:
|
||||
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
|
||||
my $str = "abc\x{300}";
|
||||
print md5_hex($str), "\n"; # croaks
|
||||
# Wide character in subroutine entry
|
||||
|
||||
What you can do is calculate the MD5 checksum of the UTF-8
|
||||
representation of such strings. This is achieved by filtering the
|
||||
string through encode_utf8() function:
|
||||
|
||||
use Digest::MD5 qw(md5_hex);
|
||||
use Encode qw(encode_utf8);
|
||||
|
||||
my $str = "abc\x{300}";
|
||||
print md5_hex(encode_utf8($str)), "\n";
|
||||
# 8c2d46911f3f5a326455f0ed7a8ed3b3
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Digest>,
|
||||
L<Digest::MD2>,
|
||||
L<Digest::SHA>,
|
||||
L<Digest::HMAC>
|
||||
|
||||
L<md5sum(1)>
|
||||
|
||||
RFC 1321
|
||||
|
||||
http://en.wikipedia.org/wiki/MD5
|
||||
|
||||
The paper "How to Break MD5 and Other Hash Functions" by Xiaoyun Wang
|
||||
and Hongbo Yu.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
Copyright 1998-2003 Gisle Aas.
|
||||
Copyright 1995-1996 Neil Winton.
|
||||
Copyright 1991-1992 RSA Data Security, Inc.
|
||||
|
||||
The MD5 algorithm is defined in RFC 1321. This implementation is
|
||||
derived from the reference C code in RFC 1321 which is covered by
|
||||
the following copyright statement:
|
||||
|
||||
=over 4
|
||||
|
||||
=item
|
||||
|
||||
Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
|
||||
rights reserved.
|
||||
|
||||
License to copy and use this software is granted provided that it
|
||||
is identified as the "RSA Data Security, Inc. MD5 Message-Digest
|
||||
Algorithm" in all material mentioning or referencing this software
|
||||
or this function.
|
||||
|
||||
License is also granted to make and use derivative works provided
|
||||
that such works are identified as "derived from the RSA Data
|
||||
Security, Inc. MD5 Message-Digest Algorithm" in all material
|
||||
mentioning or referencing the derived work.
|
||||
|
||||
RSA Data Security, Inc. makes no representations concerning either
|
||||
the merchantability of this software or the suitability of this
|
||||
software for any particular purpose. It is provided "as is"
|
||||
without express or implied warranty of any kind.
|
||||
|
||||
These notices must be retained in any copies of any part of this
|
||||
documentation and/or software.
|
||||
|
||||
=back
|
||||
|
||||
This copyright does not prohibit distribution of any version of Perl
|
||||
containing this extension under the terms of the GNU or Artistic
|
||||
licenses.
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
The original C<MD5> interface was written by Neil Winton
|
||||
(C<N.Winton@axion.bt.co.uk>).
|
||||
|
||||
The C<Digest::MD5> module is written by Gisle Aas <gisle@ActiveState.com>.
|
||||
|
||||
=cut
|
||||
820
database/perl/lib/Digest/SHA.pm
Normal file
820
database/perl/lib/Digest/SHA.pm
Normal file
@@ -0,0 +1,820 @@
|
||||
package Digest::SHA;
|
||||
|
||||
require 5.003000;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw($VERSION @ISA @EXPORT_OK $errmsg);
|
||||
use Fcntl qw(O_RDONLY O_RDWR);
|
||||
use integer;
|
||||
|
||||
$VERSION = '6.02';
|
||||
|
||||
require Exporter;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(
|
||||
$errmsg
|
||||
hmac_sha1 hmac_sha1_base64 hmac_sha1_hex
|
||||
hmac_sha224 hmac_sha224_base64 hmac_sha224_hex
|
||||
hmac_sha256 hmac_sha256_base64 hmac_sha256_hex
|
||||
hmac_sha384 hmac_sha384_base64 hmac_sha384_hex
|
||||
hmac_sha512 hmac_sha512_base64 hmac_sha512_hex
|
||||
hmac_sha512224 hmac_sha512224_base64 hmac_sha512224_hex
|
||||
hmac_sha512256 hmac_sha512256_base64 hmac_sha512256_hex
|
||||
sha1 sha1_base64 sha1_hex
|
||||
sha224 sha224_base64 sha224_hex
|
||||
sha256 sha256_base64 sha256_hex
|
||||
sha384 sha384_base64 sha384_hex
|
||||
sha512 sha512_base64 sha512_hex
|
||||
sha512224 sha512224_base64 sha512224_hex
|
||||
sha512256 sha512256_base64 sha512256_hex);
|
||||
|
||||
# Inherit from Digest::base if possible
|
||||
|
||||
eval {
|
||||
require Digest::base;
|
||||
push(@ISA, 'Digest::base');
|
||||
};
|
||||
|
||||
# The following routines aren't time-critical, so they can be left in Perl
|
||||
|
||||
sub new {
|
||||
my($class, $alg) = @_;
|
||||
$alg =~ s/\D+//g if defined $alg;
|
||||
if (ref($class)) { # instance method
|
||||
if (!defined($alg) || ($alg == $class->algorithm)) {
|
||||
sharewind($class);
|
||||
return($class);
|
||||
}
|
||||
return shainit($class, $alg) ? $class : undef;
|
||||
}
|
||||
$alg = 1 unless defined $alg;
|
||||
return $class->newSHA($alg);
|
||||
}
|
||||
|
||||
BEGIN { *reset = \&new }
|
||||
|
||||
sub add_bits {
|
||||
my($self, $data, $nbits) = @_;
|
||||
unless (defined $nbits) {
|
||||
$nbits = length($data);
|
||||
$data = pack("B*", $data);
|
||||
}
|
||||
$nbits = length($data) * 8 if $nbits > length($data) * 8;
|
||||
shawrite($data, $nbits, $self);
|
||||
return($self);
|
||||
}
|
||||
|
||||
sub _bail {
|
||||
my $msg = shift;
|
||||
|
||||
$errmsg = $!;
|
||||
$msg .= ": $!";
|
||||
require Carp;
|
||||
Carp::croak($msg);
|
||||
}
|
||||
|
||||
{
|
||||
my $_can_T_filehandle;
|
||||
|
||||
sub _istext {
|
||||
local *FH = shift;
|
||||
my $file = shift;
|
||||
|
||||
if (! defined $_can_T_filehandle) {
|
||||
local $^W = 0;
|
||||
my $istext = eval { -T FH };
|
||||
$_can_T_filehandle = $@ ? 0 : 1;
|
||||
return $_can_T_filehandle ? $istext : -T $file;
|
||||
}
|
||||
return $_can_T_filehandle ? -T FH : -T $file;
|
||||
}
|
||||
}
|
||||
|
||||
sub _addfile {
|
||||
my ($self, $handle) = @_;
|
||||
|
||||
my $n;
|
||||
my $buf = "";
|
||||
|
||||
while (($n = read($handle, $buf, 4096))) {
|
||||
$self->add($buf);
|
||||
}
|
||||
_bail("Read failed") unless defined $n;
|
||||
|
||||
$self;
|
||||
}
|
||||
|
||||
sub addfile {
|
||||
my ($self, $file, $mode) = @_;
|
||||
|
||||
return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';
|
||||
|
||||
$mode = defined($mode) ? $mode : "";
|
||||
my ($binary, $UNIVERSAL, $BITS) =
|
||||
map { $_ eq $mode } ("b", "U", "0");
|
||||
|
||||
## Always interpret "-" to mean STDIN; otherwise use
|
||||
## sysopen to handle full range of POSIX file names.
|
||||
## If $file is a directory, force an EISDIR error
|
||||
## by attempting to open with mode O_RDWR
|
||||
|
||||
local *FH;
|
||||
$file eq '-' and open(FH, '< -')
|
||||
or sysopen(FH, $file, -d $file ? O_RDWR : O_RDONLY)
|
||||
or _bail('Open failed');
|
||||
|
||||
if ($BITS) {
|
||||
my ($n, $buf) = (0, "");
|
||||
while (($n = read(FH, $buf, 4096))) {
|
||||
$buf =~ tr/01//cd;
|
||||
$self->add_bits($buf);
|
||||
}
|
||||
_bail("Read failed") unless defined $n;
|
||||
close(FH);
|
||||
return($self);
|
||||
}
|
||||
|
||||
binmode(FH) if $binary || $UNIVERSAL;
|
||||
if ($UNIVERSAL && _istext(*FH, $file)) {
|
||||
$self->_addfileuniv(*FH);
|
||||
}
|
||||
else { $self->_addfilebin(*FH) }
|
||||
close(FH);
|
||||
|
||||
$self;
|
||||
}
|
||||
|
||||
sub getstate {
|
||||
my $self = shift;
|
||||
|
||||
my $alg = $self->algorithm or return;
|
||||
my $state = $self->_getstate or return;
|
||||
my $nD = $alg <= 256 ? 8 : 16;
|
||||
my $nH = $alg <= 256 ? 32 : 64;
|
||||
my $nB = $alg <= 256 ? 64 : 128;
|
||||
my($H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) =
|
||||
$state =~ /^(.{$nH})(.{$nB})(.{4})(.{4})(.{4})(.{4})(.{4})$/s;
|
||||
for ($alg, $H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) {
|
||||
return unless defined $_;
|
||||
}
|
||||
|
||||
my @s = ();
|
||||
push(@s, "alg:" . $alg);
|
||||
push(@s, "H:" . join(":", unpack("H*", $H) =~ /.{$nD}/g));
|
||||
push(@s, "block:" . join(":", unpack("H*", $block) =~ /.{2}/g));
|
||||
push(@s, "blockcnt:" . unpack("N", $blockcnt));
|
||||
push(@s, "lenhh:" . unpack("N", $lenhh));
|
||||
push(@s, "lenhl:" . unpack("N", $lenhl));
|
||||
push(@s, "lenlh:" . unpack("N", $lenlh));
|
||||
push(@s, "lenll:" . unpack("N", $lenll));
|
||||
join("\n", @s) . "\n";
|
||||
}
|
||||
|
||||
sub putstate {
|
||||
my($class, $state) = @_;
|
||||
|
||||
my %s = ();
|
||||
for (split(/\n/, $state)) {
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
next if (/^(#|$)/);
|
||||
my @f = split(/[:\s]+/);
|
||||
my $tag = shift(@f);
|
||||
$s{$tag} = join('', @f);
|
||||
}
|
||||
|
||||
# H and block may contain arbitrary values, but check everything else
|
||||
grep { $_ == $s{'alg'} } (1,224,256,384,512,512224,512256) or return;
|
||||
length($s{'H'}) == ($s{'alg'} <= 256 ? 64 : 128) or return;
|
||||
length($s{'block'}) == ($s{'alg'} <= 256 ? 128 : 256) or return;
|
||||
{
|
||||
no integer;
|
||||
for (qw(blockcnt lenhh lenhl lenlh lenll)) {
|
||||
0 <= $s{$_} or return;
|
||||
$s{$_} <= 4294967295 or return;
|
||||
}
|
||||
$s{'blockcnt'} < ($s{'alg'} <= 256 ? 512 : 1024) or return;
|
||||
}
|
||||
|
||||
my $packed_state = (
|
||||
pack("H*", $s{'H'}) .
|
||||
pack("H*", $s{'block'}) .
|
||||
pack("N", $s{'blockcnt'}) .
|
||||
pack("N", $s{'lenhh'}) .
|
||||
pack("N", $s{'lenhl'}) .
|
||||
pack("N", $s{'lenlh'}) .
|
||||
pack("N", $s{'lenll'})
|
||||
);
|
||||
|
||||
return $class->new($s{'alg'})->_putstate($packed_state);
|
||||
}
|
||||
|
||||
sub dump {
|
||||
my $self = shift;
|
||||
my $file = shift;
|
||||
|
||||
my $state = $self->getstate or return;
|
||||
$file = "-" if (!defined($file) || $file eq "");
|
||||
|
||||
local *FH;
|
||||
open(FH, "> $file") or return;
|
||||
print FH $state;
|
||||
close(FH);
|
||||
|
||||
return($self);
|
||||
}
|
||||
|
||||
sub load {
|
||||
my $class = shift;
|
||||
my $file = shift;
|
||||
|
||||
$file = "-" if (!defined($file) || $file eq "");
|
||||
|
||||
local *FH;
|
||||
open(FH, "< $file") or return;
|
||||
my $str = join('', <FH>);
|
||||
close(FH);
|
||||
|
||||
$class->putstate($str);
|
||||
}
|
||||
|
||||
eval {
|
||||
require XSLoader;
|
||||
XSLoader::load('Digest::SHA', $VERSION);
|
||||
1;
|
||||
} or do {
|
||||
require DynaLoader;
|
||||
push @ISA, 'DynaLoader';
|
||||
Digest::SHA->bootstrap($VERSION);
|
||||
};
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Digest::SHA - Perl extension for SHA-1/224/256/384/512
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
In programs:
|
||||
|
||||
# Functional interface
|
||||
|
||||
use Digest::SHA qw(sha1 sha1_hex sha1_base64 ...);
|
||||
|
||||
$digest = sha1($data);
|
||||
$digest = sha1_hex($data);
|
||||
$digest = sha1_base64($data);
|
||||
|
||||
$digest = sha256($data);
|
||||
$digest = sha384_hex($data);
|
||||
$digest = sha512_base64($data);
|
||||
|
||||
# Object-oriented
|
||||
|
||||
use Digest::SHA;
|
||||
|
||||
$sha = Digest::SHA->new($alg);
|
||||
|
||||
$sha->add($data); # feed data into stream
|
||||
|
||||
$sha->addfile(*F);
|
||||
$sha->addfile($filename);
|
||||
|
||||
$sha->add_bits($bits);
|
||||
$sha->add_bits($data, $nbits);
|
||||
|
||||
$sha_copy = $sha->clone; # make copy of digest object
|
||||
$state = $sha->getstate; # save current state to string
|
||||
$sha->putstate($state); # restore previous $state
|
||||
|
||||
$digest = $sha->digest; # compute digest
|
||||
$digest = $sha->hexdigest;
|
||||
$digest = $sha->b64digest;
|
||||
|
||||
From the command line:
|
||||
|
||||
$ shasum files
|
||||
|
||||
$ shasum --help
|
||||
|
||||
=head1 SYNOPSIS (HMAC-SHA)
|
||||
|
||||
# Functional interface only
|
||||
|
||||
use Digest::SHA qw(hmac_sha1 hmac_sha1_hex ...);
|
||||
|
||||
$digest = hmac_sha1($data, $key);
|
||||
$digest = hmac_sha224_hex($data, $key);
|
||||
$digest = hmac_sha256_base64($data, $key);
|
||||
|
||||
=head1 ABSTRACT
|
||||
|
||||
Digest::SHA is a complete implementation of the NIST Secure Hash Standard.
|
||||
It gives Perl programmers a convenient way to calculate SHA-1, SHA-224,
|
||||
SHA-256, SHA-384, SHA-512, SHA-512/224, and SHA-512/256 message digests.
|
||||
The module can handle all types of input, including partial-byte data.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Digest::SHA is written in C for speed. If your platform lacks a
|
||||
C compiler, you can install the functionally equivalent (but much
|
||||
slower) L<Digest::SHA::PurePerl> module.
|
||||
|
||||
The programming interface is easy to use: it's the same one found
|
||||
in CPAN's L<Digest> module. So, if your applications currently
|
||||
use L<Digest::MD5> and you'd prefer the stronger security of SHA,
|
||||
it's a simple matter to convert them.
|
||||
|
||||
The interface provides two ways to calculate digests: all-at-once,
|
||||
or in stages. To illustrate, the following short program computes
|
||||
the SHA-256 digest of "hello world" using each approach:
|
||||
|
||||
use Digest::SHA qw(sha256_hex);
|
||||
|
||||
$data = "hello world";
|
||||
@frags = split(//, $data);
|
||||
|
||||
# all-at-once (Functional style)
|
||||
$digest1 = sha256_hex($data);
|
||||
|
||||
# in-stages (OOP style)
|
||||
$state = Digest::SHA->new(256);
|
||||
for (@frags) { $state->add($_) }
|
||||
$digest2 = $state->hexdigest;
|
||||
|
||||
print $digest1 eq $digest2 ?
|
||||
"whew!\n" : "oops!\n";
|
||||
|
||||
To calculate the digest of an n-bit message where I<n> is not a
|
||||
multiple of 8, use the I<add_bits()> method. For example, consider
|
||||
the 446-bit message consisting of the bit-string "110" repeated
|
||||
148 times, followed by "11". Here's how to display its SHA-1
|
||||
digest:
|
||||
|
||||
use Digest::SHA;
|
||||
$bits = "110" x 148 . "11";
|
||||
$sha = Digest::SHA->new(1)->add_bits($bits);
|
||||
print $sha->hexdigest, "\n";
|
||||
|
||||
Note that for larger bit-strings, it's more efficient to use the
|
||||
two-argument version I<add_bits($data, $nbits)>, where I<$data> is
|
||||
in the customary packed binary format used for Perl strings.
|
||||
|
||||
The module also lets you save intermediate SHA states to a string. The
|
||||
I<getstate()> method generates portable, human-readable text describing
|
||||
the current state of computation. You can subsequently restore that
|
||||
state with I<putstate()> to resume where the calculation left off.
|
||||
|
||||
To see what a state description looks like, just run the following:
|
||||
|
||||
use Digest::SHA;
|
||||
print Digest::SHA->new->add("Shaw" x 1962)->getstate;
|
||||
|
||||
As an added convenience, the Digest::SHA module offers routines to
|
||||
calculate keyed hashes using the HMAC-SHA-1/224/256/384/512
|
||||
algorithms. These services exist in functional form only, and
|
||||
mimic the style and behavior of the I<sha()>, I<sha_hex()>, and
|
||||
I<sha_base64()> functions.
|
||||
|
||||
# Test vector from draft-ietf-ipsec-ciph-sha-256-01.txt
|
||||
|
||||
use Digest::SHA qw(hmac_sha256_hex);
|
||||
print hmac_sha256_hex("Hi There", chr(0x0b) x 32), "\n";
|
||||
|
||||
=head1 UNICODE AND SIDE EFFECTS
|
||||
|
||||
Perl supports Unicode strings as of version 5.6. Such strings may
|
||||
contain wide characters, namely, characters whose ordinal values are
|
||||
greater than 255. This can cause problems for digest algorithms such
|
||||
as SHA that are specified to operate on sequences of bytes.
|
||||
|
||||
The rule by which Digest::SHA handles a Unicode string is easy
|
||||
to state, but potentially confusing to grasp: the string is interpreted
|
||||
as a sequence of byte values, where each byte value is equal to the
|
||||
ordinal value (viz. code point) of its corresponding Unicode character.
|
||||
That way, the Unicode string 'abc' has exactly the same digest value as
|
||||
the ordinary string 'abc'.
|
||||
|
||||
Since a wide character does not fit into a byte, the Digest::SHA
|
||||
routines croak if they encounter one. Whereas if a Unicode string
|
||||
contains no wide characters, the module accepts it quite happily.
|
||||
The following code illustrates the two cases:
|
||||
|
||||
$str1 = pack('U*', (0..255));
|
||||
print sha1_hex($str1); # ok
|
||||
|
||||
$str2 = pack('U*', (0..256));
|
||||
print sha1_hex($str2); # croaks
|
||||
|
||||
Be aware that the digest routines silently convert UTF-8 input into its
|
||||
equivalent byte sequence in the native encoding (cf. utf8::downgrade).
|
||||
This side effect influences only the way Perl stores the data internally,
|
||||
but otherwise leaves the actual value of the data intact.
|
||||
|
||||
=head1 NIST STATEMENT ON SHA-1
|
||||
|
||||
NIST acknowledges that the work of Prof. Xiaoyun Wang constitutes a
|
||||
practical collision attack on SHA-1. Therefore, NIST encourages the
|
||||
rapid adoption of the SHA-2 hash functions (e.g. SHA-256) for applications
|
||||
requiring strong collision resistance, such as digital signatures.
|
||||
|
||||
ref. L<http://csrc.nist.gov/groups/ST/hash/statement.html>
|
||||
|
||||
=head1 PADDING OF BASE64 DIGESTS
|
||||
|
||||
By convention, CPAN Digest modules do B<not> pad their Base64 output.
|
||||
Problems can occur when feeding such digests to other software that
|
||||
expects properly padded Base64 encodings.
|
||||
|
||||
For the time being, any necessary padding must be done by the user.
|
||||
Fortunately, this is a simple operation: if the length of a Base64-encoded
|
||||
digest isn't a multiple of 4, simply append "=" characters to the end
|
||||
of the digest until it is:
|
||||
|
||||
while (length($b64_digest) % 4) {
|
||||
$b64_digest .= '=';
|
||||
}
|
||||
|
||||
To illustrate, I<sha256_base64("abc")> is computed to be
|
||||
|
||||
ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0
|
||||
|
||||
which has a length of 43. So, the properly padded version is
|
||||
|
||||
ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=
|
||||
|
||||
=head1 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
=head1 EXPORTABLE FUNCTIONS
|
||||
|
||||
Provided your C compiler supports a 64-bit type (e.g. the I<long
|
||||
long> of C99, or I<__int64> used by Microsoft C/C++), all of these
|
||||
functions will be available for use. Otherwise, you won't be able
|
||||
to perform the SHA-384 and SHA-512 transforms, both of which require
|
||||
64-bit operations.
|
||||
|
||||
I<Functional style>
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<sha1($data, ...)>
|
||||
|
||||
=item B<sha224($data, ...)>
|
||||
|
||||
=item B<sha256($data, ...)>
|
||||
|
||||
=item B<sha384($data, ...)>
|
||||
|
||||
=item B<sha512($data, ...)>
|
||||
|
||||
=item B<sha512224($data, ...)>
|
||||
|
||||
=item B<sha512256($data, ...)>
|
||||
|
||||
Logically joins the arguments into a single string, and returns
|
||||
its SHA-1/224/256/384/512 digest encoded as a binary string.
|
||||
|
||||
=item B<sha1_hex($data, ...)>
|
||||
|
||||
=item B<sha224_hex($data, ...)>
|
||||
|
||||
=item B<sha256_hex($data, ...)>
|
||||
|
||||
=item B<sha384_hex($data, ...)>
|
||||
|
||||
=item B<sha512_hex($data, ...)>
|
||||
|
||||
=item B<sha512224_hex($data, ...)>
|
||||
|
||||
=item B<sha512256_hex($data, ...)>
|
||||
|
||||
Logically joins the arguments into a single string, and returns
|
||||
its SHA-1/224/256/384/512 digest encoded as a hexadecimal string.
|
||||
|
||||
=item B<sha1_base64($data, ...)>
|
||||
|
||||
=item B<sha224_base64($data, ...)>
|
||||
|
||||
=item B<sha256_base64($data, ...)>
|
||||
|
||||
=item B<sha384_base64($data, ...)>
|
||||
|
||||
=item B<sha512_base64($data, ...)>
|
||||
|
||||
=item B<sha512224_base64($data, ...)>
|
||||
|
||||
=item B<sha512256_base64($data, ...)>
|
||||
|
||||
Logically joins the arguments into a single string, and returns
|
||||
its SHA-1/224/256/384/512 digest encoded as a Base64 string.
|
||||
|
||||
It's important to note that the resulting string does B<not> contain
|
||||
the padding characters typical of Base64 encodings. This omission is
|
||||
deliberate, and is done to maintain compatibility with the family of
|
||||
CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
|
||||
|
||||
=back
|
||||
|
||||
I<OOP style>
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<new($alg)>
|
||||
|
||||
Returns a new Digest::SHA object. Allowed values for I<$alg> are 1,
|
||||
224, 256, 384, 512, 512224, or 512256. It's also possible to use
|
||||
common string representations of the algorithm (e.g. "sha256",
|
||||
"SHA-384"). If the argument is missing, SHA-1 will be used by
|
||||
default.
|
||||
|
||||
Invoking I<new> as an instance method will reset the object to the
|
||||
initial state associated with I<$alg>. If the argument is missing,
|
||||
the object will continue using the same algorithm that was selected
|
||||
at creation.
|
||||
|
||||
=item B<reset($alg)>
|
||||
|
||||
This method has exactly the same effect as I<new($alg)>. In fact,
|
||||
I<reset> is just an alias for I<new>.
|
||||
|
||||
=item B<hashsize>
|
||||
|
||||
Returns the number of digest bits for this object. The values are
|
||||
160, 224, 256, 384, 512, 224, and 256 for SHA-1, SHA-224, SHA-256,
|
||||
SHA-384, SHA-512, SHA-512/224 and SHA-512/256, respectively.
|
||||
|
||||
=item B<algorithm>
|
||||
|
||||
Returns the digest algorithm for this object. The values are 1,
|
||||
224, 256, 384, 512, 512224, and 512256 for SHA-1, SHA-224, SHA-256,
|
||||
SHA-384, SHA-512, SHA-512/224, and SHA-512/256, respectively.
|
||||
|
||||
=item B<clone>
|
||||
|
||||
Returns a duplicate copy of the object.
|
||||
|
||||
=item B<add($data, ...)>
|
||||
|
||||
Logically joins the arguments into a single string, and uses it to
|
||||
update the current digest state. In other words, the following
|
||||
statements have the same effect:
|
||||
|
||||
$sha->add("a"); $sha->add("b"); $sha->add("c");
|
||||
$sha->add("a")->add("b")->add("c");
|
||||
$sha->add("a", "b", "c");
|
||||
$sha->add("abc");
|
||||
|
||||
The return value is the updated object itself.
|
||||
|
||||
=item B<add_bits($data, $nbits)>
|
||||
|
||||
=item B<add_bits($bits)>
|
||||
|
||||
Updates the current digest state by appending bits to it. The
|
||||
return value is the updated object itself.
|
||||
|
||||
The first form causes the most-significant I<$nbits> of I<$data>
|
||||
to be appended to the stream. The I<$data> argument is in the
|
||||
customary binary format used for Perl strings.
|
||||
|
||||
The second form takes an ASCII string of "0" and "1" characters as
|
||||
its argument. It's equivalent to
|
||||
|
||||
$sha->add_bits(pack("B*", $bits), length($bits));
|
||||
|
||||
So, the following two statements do the same thing:
|
||||
|
||||
$sha->add_bits("111100001010");
|
||||
$sha->add_bits("\xF0\xA0", 12);
|
||||
|
||||
Note that SHA-1 and SHA-2 use I<most-significant-bit ordering>
|
||||
for their internal state. This means that
|
||||
|
||||
$sha3->add_bits("110");
|
||||
|
||||
is equivalent to
|
||||
|
||||
$sha3->add_bits("1")->add_bits("1")->add_bits("0");
|
||||
|
||||
=item B<addfile(*FILE)>
|
||||
|
||||
Reads from I<FILE> until EOF, and appends that data to the current
|
||||
state. The return value is the updated object itself.
|
||||
|
||||
=item B<addfile($filename [, $mode])>
|
||||
|
||||
Reads the contents of I<$filename>, and appends that data to the current
|
||||
state. The return value is the updated object itself.
|
||||
|
||||
By default, I<$filename> is simply opened and read; no special modes
|
||||
or I/O disciplines are used. To change this, set the optional I<$mode>
|
||||
argument to one of the following values:
|
||||
|
||||
"b" read file in binary mode
|
||||
|
||||
"U" use universal newlines
|
||||
|
||||
"0" use BITS mode
|
||||
|
||||
The "U" mode is modeled on Python's "Universal Newlines" concept, whereby
|
||||
DOS and Mac OS line terminators are converted internally to UNIX newlines
|
||||
before processing. This ensures consistent digest values when working
|
||||
simultaneously across multiple file systems. B<The "U" mode influences
|
||||
only text files>, namely those passing Perl's I<-T> test; binary files
|
||||
are processed with no translation whatsoever.
|
||||
|
||||
The BITS mode ("0") interprets the contents of I<$filename> as a logical
|
||||
stream of bits, where each ASCII '0' or '1' character represents a 0 or
|
||||
1 bit, respectively. All other characters are ignored. This provides
|
||||
a convenient way to calculate the digest values of partial-byte data
|
||||
by using files, rather than having to write separate programs employing
|
||||
the I<add_bits> method.
|
||||
|
||||
=item B<getstate>
|
||||
|
||||
Returns a string containing a portable, human-readable representation
|
||||
of the current SHA state.
|
||||
|
||||
=item B<putstate($str)>
|
||||
|
||||
Returns a Digest::SHA object representing the SHA state contained
|
||||
in I<$str>. The format of I<$str> matches the format of the output
|
||||
produced by method I<getstate>. If called as a class method, a new
|
||||
object is created; if called as an instance method, the object is reset
|
||||
to the state contained in I<$str>.
|
||||
|
||||
=item B<dump($filename)>
|
||||
|
||||
Writes the output of I<getstate> to I<$filename>. If the argument is
|
||||
missing, or equal to the empty string, the state information will be
|
||||
written to STDOUT.
|
||||
|
||||
=item B<load($filename)>
|
||||
|
||||
Returns a Digest::SHA object that results from calling I<putstate> on
|
||||
the contents of I<$filename>. If the argument is missing, or equal to
|
||||
the empty string, the state information will be read from STDIN.
|
||||
|
||||
=item B<digest>
|
||||
|
||||
Returns the digest encoded as a binary string.
|
||||
|
||||
Note that the I<digest> method is a read-once operation. Once it
|
||||
has been performed, the Digest::SHA object is automatically reset
|
||||
in preparation for calculating another digest value. Call
|
||||
I<$sha-E<gt>clone-E<gt>digest> if it's necessary to preserve the
|
||||
original digest state.
|
||||
|
||||
=item B<hexdigest>
|
||||
|
||||
Returns the digest encoded as a hexadecimal string.
|
||||
|
||||
Like I<digest>, this method is a read-once operation. Call
|
||||
I<$sha-E<gt>clone-E<gt>hexdigest> if it's necessary to preserve
|
||||
the original digest state.
|
||||
|
||||
=item B<b64digest>
|
||||
|
||||
Returns the digest encoded as a Base64 string.
|
||||
|
||||
Like I<digest>, this method is a read-once operation. Call
|
||||
I<$sha-E<gt>clone-E<gt>b64digest> if it's necessary to preserve
|
||||
the original digest state.
|
||||
|
||||
It's important to note that the resulting string does B<not> contain
|
||||
the padding characters typical of Base64 encodings. This omission is
|
||||
deliberate, and is done to maintain compatibility with the family of
|
||||
CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
|
||||
|
||||
=back
|
||||
|
||||
I<HMAC-SHA-1/224/256/384/512>
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<hmac_sha1($data, $key)>
|
||||
|
||||
=item B<hmac_sha224($data, $key)>
|
||||
|
||||
=item B<hmac_sha256($data, $key)>
|
||||
|
||||
=item B<hmac_sha384($data, $key)>
|
||||
|
||||
=item B<hmac_sha512($data, $key)>
|
||||
|
||||
=item B<hmac_sha512224($data, $key)>
|
||||
|
||||
=item B<hmac_sha512256($data, $key)>
|
||||
|
||||
Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
|
||||
with the result encoded as a binary string. Multiple I<$data>
|
||||
arguments are allowed, provided that I<$key> is the last argument
|
||||
in the list.
|
||||
|
||||
=item B<hmac_sha1_hex($data, $key)>
|
||||
|
||||
=item B<hmac_sha224_hex($data, $key)>
|
||||
|
||||
=item B<hmac_sha256_hex($data, $key)>
|
||||
|
||||
=item B<hmac_sha384_hex($data, $key)>
|
||||
|
||||
=item B<hmac_sha512_hex($data, $key)>
|
||||
|
||||
=item B<hmac_sha512224_hex($data, $key)>
|
||||
|
||||
=item B<hmac_sha512256_hex($data, $key)>
|
||||
|
||||
Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
|
||||
with the result encoded as a hexadecimal string. Multiple I<$data>
|
||||
arguments are allowed, provided that I<$key> is the last argument
|
||||
in the list.
|
||||
|
||||
=item B<hmac_sha1_base64($data, $key)>
|
||||
|
||||
=item B<hmac_sha224_base64($data, $key)>
|
||||
|
||||
=item B<hmac_sha256_base64($data, $key)>
|
||||
|
||||
=item B<hmac_sha384_base64($data, $key)>
|
||||
|
||||
=item B<hmac_sha512_base64($data, $key)>
|
||||
|
||||
=item B<hmac_sha512224_base64($data, $key)>
|
||||
|
||||
=item B<hmac_sha512256_base64($data, $key)>
|
||||
|
||||
Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
|
||||
with the result encoded as a Base64 string. Multiple I<$data>
|
||||
arguments are allowed, provided that I<$key> is the last argument
|
||||
in the list.
|
||||
|
||||
It's important to note that the resulting string does B<not> contain
|
||||
the padding characters typical of Base64 encodings. This omission is
|
||||
deliberate, and is done to maintain compatibility with the family of
|
||||
CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Digest>, L<Digest::SHA::PurePerl>
|
||||
|
||||
The Secure Hash Standard (Draft FIPS PUB 180-4) can be found at:
|
||||
|
||||
L<http://csrc.nist.gov/publications/drafts/fips180-4/Draft-FIPS180-4_Feb2011.pdf>
|
||||
|
||||
The Keyed-Hash Message Authentication Code (HMAC):
|
||||
|
||||
L<http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mark Shelor <mshelor@cpan.org>
|
||||
|
||||
=head1 ACKNOWLEDGMENTS
|
||||
|
||||
The author is particularly grateful to
|
||||
|
||||
Gisle Aas
|
||||
H. Merijn Brand
|
||||
Sean Burke
|
||||
Chris Carey
|
||||
Alexandr Ciornii
|
||||
Chris David
|
||||
Jim Doble
|
||||
Thomas Drugeon
|
||||
Julius Duque
|
||||
Jeffrey Friedl
|
||||
Robert Gilmour
|
||||
Brian Gladman
|
||||
Jarkko Hietaniemi
|
||||
Adam Kennedy
|
||||
Mark Lawrence
|
||||
Andy Lester
|
||||
Alex Muntada
|
||||
Steve Peters
|
||||
Chris Skiscim
|
||||
Martin Thurn
|
||||
Gunnar Wolf
|
||||
Adam Woodbury
|
||||
|
||||
"who by trained skill rescued life from such great billows and such thick
|
||||
darkness and moored it in so perfect a calm and in so brilliant a light"
|
||||
- Lucretius
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2003-2018 Mark Shelor
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
L<perlartistic>
|
||||
|
||||
=cut
|
||||
106
database/perl/lib/Digest/base.pm
Normal file
106
database/perl/lib/Digest/base.pm
Normal file
@@ -0,0 +1,106 @@
|
||||
package Digest::base;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = "1.19";
|
||||
|
||||
# subclass is supposed to implement at least these
|
||||
sub new;
|
||||
sub clone;
|
||||
sub add;
|
||||
sub digest;
|
||||
|
||||
sub reset {
|
||||
my $self = shift;
|
||||
$self->new(@_); # ugly
|
||||
}
|
||||
|
||||
sub addfile {
|
||||
my ( $self, $handle ) = @_;
|
||||
|
||||
my $n;
|
||||
my $buf = "";
|
||||
|
||||
while ( ( $n = read( $handle, $buf, 4 * 1024 ) ) ) {
|
||||
$self->add($buf);
|
||||
}
|
||||
unless ( defined $n ) {
|
||||
require Carp;
|
||||
Carp::croak("Read failed: $!");
|
||||
}
|
||||
|
||||
$self;
|
||||
}
|
||||
|
||||
sub add_bits {
|
||||
my $self = shift;
|
||||
my $bits;
|
||||
my $nbits;
|
||||
if ( @_ == 1 ) {
|
||||
my $arg = shift;
|
||||
$bits = pack( "B*", $arg );
|
||||
$nbits = length($arg);
|
||||
}
|
||||
else {
|
||||
( $bits, $nbits ) = @_;
|
||||
}
|
||||
if ( ( $nbits % 8 ) != 0 ) {
|
||||
require Carp;
|
||||
Carp::croak("Number of bits must be multiple of 8 for this algorithm");
|
||||
}
|
||||
return $self->add( substr( $bits, 0, $nbits / 8 ) );
|
||||
}
|
||||
|
||||
sub hexdigest {
|
||||
my $self = shift;
|
||||
return unpack( "H*", $self->digest(@_) );
|
||||
}
|
||||
|
||||
sub b64digest {
|
||||
my $self = shift;
|
||||
my $b64 = $self->base64_padded_digest;
|
||||
$b64 =~ s/=+$//;
|
||||
return $b64;
|
||||
}
|
||||
|
||||
sub base64_padded_digest {
|
||||
my $self = shift;
|
||||
require MIME::Base64;
|
||||
return MIME::Base64::encode( $self->digest(@_), "" );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Digest::base - Digest base class
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Digest::Foo;
|
||||
use base 'Digest::base';
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The C<Digest::base> class provide implementations of the methods
|
||||
C<addfile> and C<add_bits> in terms of C<add>, and of the methods
|
||||
C<hexdigest> and C<b64digest> in terms of C<digest>.
|
||||
|
||||
Digest implementations might want to inherit from this class to get
|
||||
this implementations of the alternative I<add> and I<digest> methods.
|
||||
A minimal subclass needs to implement the following methods by itself:
|
||||
|
||||
new
|
||||
clone
|
||||
add
|
||||
digest
|
||||
|
||||
The arguments and expected behaviour of these methods are described in
|
||||
L<Digest>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Digest>
|
||||
83
database/perl/lib/Digest/file.pm
Normal file
83
database/perl/lib/Digest/file.pm
Normal file
@@ -0,0 +1,83 @@
|
||||
package Digest::file;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Exporter ();
|
||||
use Carp qw(croak);
|
||||
use Digest ();
|
||||
|
||||
our $VERSION = "1.19";
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(digest_file_ctx digest_file digest_file_hex digest_file_base64);
|
||||
|
||||
sub digest_file_ctx {
|
||||
my $file = shift;
|
||||
croak("No digest algorithm specified") unless @_;
|
||||
open( my $fh, "<", $file ) || croak("Can't open '$file': $!");
|
||||
binmode($fh);
|
||||
my $ctx = Digest->new(@_);
|
||||
$ctx->addfile($fh);
|
||||
close($fh);
|
||||
return $ctx;
|
||||
}
|
||||
|
||||
sub digest_file {
|
||||
digest_file_ctx(@_)->digest;
|
||||
}
|
||||
|
||||
sub digest_file_hex {
|
||||
digest_file_ctx(@_)->hexdigest;
|
||||
}
|
||||
|
||||
sub digest_file_base64 {
|
||||
digest_file_ctx(@_)->b64digest;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Digest::file - Calculate digests of files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# Poor mans "md5sum" command
|
||||
use Digest::file qw(digest_file_hex);
|
||||
for (@ARGV) {
|
||||
print digest_file_hex($_, "MD5"), " $_\n";
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provide 3 convenience functions to calculate the digest
|
||||
of files. The following functions are provided:
|
||||
|
||||
=over
|
||||
|
||||
=item digest_file( $file, $algorithm, [$arg,...] )
|
||||
|
||||
This function will calculate and return the binary digest of the bytes
|
||||
of the given file. The function will croak if it fails to open or
|
||||
read the file.
|
||||
|
||||
The $algorithm is a string like "MD2", "MD5", "SHA-1", "SHA-512".
|
||||
Additional arguments are passed to the constructor for the
|
||||
implementation of the given algorithm.
|
||||
|
||||
=item digest_file_hex( $file, $algorithm, [$arg,...] )
|
||||
|
||||
Same as digest_file(), but return the digest in hex form.
|
||||
|
||||
=item digest_file_base64( $file, $algorithm, [$arg,...] )
|
||||
|
||||
Same as digest_file(), but return the digest as a base64 encoded
|
||||
string.
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Digest>
|
||||
Reference in New Issue
Block a user