lib/diagnostics.pm Print verbose diagnostics
lib/diagnostics.t See if diagnostics.pm works
lib/Digest.pm Digest extensions
-lib/Digest.t See if Digest extensions work
+lib/Digest/base.pm Digest extensions
+lib/Digest/t/base.t See if Digest extensions work
+lib/Digest/t/digest.t See if Digest extensions work
lib/DirHandle.pm like FileHandle only for directories
lib/DirHandle.t See if DirHandle works
lib/dotsh.pl Code to "dot" in a shell script
'Digest' =>
{
'MAINTAINER' => 'gaas',
- 'FILES' => q[lib/Digest.{pm,t}],
+ 'FILES' => q[lib/Digest.pm lib/Digest/base.pm lib/Digest],
'CPAN' => 1,
},
use strict;
use vars qw($VERSION %MMAP $AUTOLOAD);
-$VERSION = "1.02";
+$VERSION = "1.03";
%MMAP = (
- "SHA-1" => "Digest::SHA1",
+ "SHA-1" => ["Digest::SHA1", ["Digest::SHA", 1], ["Digest::SHA2", 1]],
+ "SHA-256" => [["Digest::SHA", 256], ["Digest::SHA2", 256]],
+ "SHA-384" => [["Digest::SHA", 384], ["Digest::SHA2", 384]],
+ "SHA-512" => [["Digest::SHA", 512], ["Digest::SHA2", 512]],
"HMAC-MD5" => "Digest::HMAC_MD5",
"HMAC-SHA-1" => "Digest::HMAC_SHA1",
);
{
shift; # class ignored
my $algorithm = shift;
- my $class = $MMAP{$algorithm} || "Digest::$algorithm";
- no strict 'refs';
- unless (exists ${"$class\::"}{"VERSION"}) {
- eval "require $class";
- die $@ if $@;
+ my $impl = $MMAP{$algorithm} || do {
+ $algorithm =~ s/\W+//;
+ "Digest::$algorithm";
+ };
+ $impl = [$impl] unless ref($impl);
+ my $err;
+ for (@$impl) {
+ my $class = $_;
+ my @args;
+ ($class, @args) = @$class if ref($class);
+ no strict 'refs';
+ unless (exists ${"$class\::"}{"VERSION"}) {
+ eval "require $class";
+ if ($@) {
+ $err ||= $@;
+ next;
+ }
+ }
+ return $class->new(@args, @_);
}
- $class->new(@_);
+ die $err;
}
sub AUTOLOAD
or "hashes", of some data, called a message. The digest is (usually)
some small/fixed size string. The actual size of the digest depend of
the algorithm used. The message is simply a sequence of arbitrary
-bytes.
+bytes or bits.
An important property of the digest algorithms is that the digest is
I<likely> to change if the message change in some way. Another
message we calculate the digest for. The return value is the $ctx
object itself.
+=item $ctx->add_bits($data, $nbits)
+
+=item $ctx->add_bits($bitstring)
+
+The bits provided are appended to the message we calculate the digest
+for. The return value is the $ctx object itself.
+
+The two argument form of add_bits() will add the first $nbits bits
+from data. For the last potentially partial byte only the high order
+C<< $nbits % 8 >> bits are used. If $nbits is greater than C<<
+length($data) * 8 >>, then this method would do the same as C<<
+$ctx->add($data) >>, i.e. $nbits is silently ignored.
+
+The one argument form of add_bits() takes a $bitstring of "1" and "0"
+chars as argument. It's a shorthand for C<< $ctx->add_bits(pack("B*",
+$bitstring), length($bitstring)) >>.
+
+This example shows two calls that should have the same effect:
+
+ $ctx->add_bits("111100001010");
+ $ctx->add_bits("\xF0\xA0", 12);
+
+Most digest algorithms are byte based. For those it is not possible
+to add bits that are not a multiple of 8, and the add_bits() method
+will croak if you try.
+
=item $ctx->digest
Return the binary digest for the message.
--- /dev/null
+#!perl -w
+
+use Test qw(plan ok);
+plan tests => 12;
+
+{
+ package LenDigest;
+ require Digest::base;
+ use vars qw(@ISA);
+ @ISA = qw(Digest::base);
+
+ sub new {
+ my $class = shift;
+ my $str = "";
+ bless \$str, $class;
+ }
+
+ sub add {
+ my $self = shift;
+ $$self .= join("", @_);
+ return $self;
+ }
+
+ sub digest {
+ my $self = shift;
+ my $len = length($$self);
+ my $first = ($len > 0) ? substr($$self, 0, 1) : "X";
+ $$self = "";
+ return sprintf "$first%04d", $len;
+ }
+}
+
+my $ctx = LenDigest->new;
+ok($ctx->digest, "X0000");
+ok($ctx->hexdigest, "5830303030");
+ok($ctx->b64digest, "WDAwMDA");
+
+$ctx->add("foo");
+ok($ctx->digest, "f0003");
+
+$ctx->add("foo");
+ok($ctx->hexdigest, "6630303033");
+
+$ctx->add("foo");
+ok($ctx->b64digest, "ZjAwMDM");
+
+open(F, ">xxtest$$") || die;
+binmode(F);
+print F "abc" x 100, "\n";
+close(F) || die;
+
+open(F, "xxtest$$") || die;
+$ctx->addfile(*F);
+close(F);
+unlink("xxtest$$") || warn;
+
+ok($ctx->digest, "a0301");
+
+eval {
+ $ctx->add_bits("1010");
+};
+ok($@ =~ /^Number of bits must be multiple of 8/);
+
+$ctx->add_bits("01010101");
+ok($ctx->digest, "U0001");
+
+eval {
+ $ctx->add_bits("abc", 12);
+};
+ok($@ =~ /^Number of bits must be multiple of 8/);
+
+$ctx->add_bits("abc", 16);
+ok($ctx->digest, "a0002");
+
+$ctx->add_bits("abc", 32);
+ok($ctx->digest, "a0003");
--- /dev/null
+print "1..3\n";
+
+use Digest;
+
+my $hexdigest = "900150983cd24fb0d6963f7d28e17f72"; # ASCII
+
+if (ord('A') == 193) { # EBCDIC
+ $hexdigest = "fe4ea0d98f9cd8d1d27f102a93cb0bb0"; # IBM-1047
+}
+
+print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
+print "ok 1\n";
+
+print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
+print "ok 2\n";
+
+eval {
+ # Not yet EBCDICified.
+ print "not " unless Digest->new("HMAC-MD5" => "Jefe")->add("what do ya want for nothing?")->hexdigest eq "750c783e6ab0b503eaa86e310a5db738";
+ print "ok 3\n";
+};
+print "ok 3\n" if $@ && $@ =~ /^Can't locate/;
+