From: Nicholas Clark Date: Sat, 29 Nov 2003 16:45:19 +0000 (+0000) Subject: Update Digest to 1.03 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b12d758ccb90fef7a772525595989e740b018ed3;p=p5sagit%2Fp5-mst-13.2.git Update Digest to 1.03 p4raw-id: //depot/perl@21807 --- diff --git a/MANIFEST b/MANIFEST index 7dd4edf..368cdbd 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1081,7 +1081,9 @@ lib/Devel/SelfStubber.t See if Devel::SelfStubber works 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 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index b835f0f..bcdb25a 100644 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -132,7 +132,7 @@ package Maintainers; 'Digest' => { 'MAINTAINER' => 'gaas', - 'FILES' => q[lib/Digest.{pm,t}], + 'FILES' => q[lib/Digest.pm lib/Digest/base.pm lib/Digest], 'CPAN' => 1, }, diff --git a/lib/Digest.pm b/lib/Digest.pm index 8ebf61a..c0e9cc1 100644 --- a/lib/Digest.pm +++ b/lib/Digest.pm @@ -3,10 +3,13 @@ package Digest; 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", ); @@ -15,13 +18,27 @@ sub new { 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 @@ -55,7 +72,7 @@ The C modules calculate digests, also called "fingerprints" 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 to change if the message change in some way. Another @@ -149,6 +166,32 @@ The $io_handle is read until EOF and the content is appended to the 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. diff --git a/lib/Digest/t/base.t b/lib/Digest/t/base.t new file mode 100644 index 0000000..c398346 --- /dev/null +++ b/lib/Digest/t/base.t @@ -0,0 +1,76 @@ +#!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"); diff --git a/lib/Digest/t/digest.t b/lib/Digest/t/digest.t new file mode 100644 index 0000000..fbc2dac --- /dev/null +++ b/lib/Digest/t/digest.t @@ -0,0 +1,23 @@ +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/; +