diff --git a/.github/README.md b/.github/README.md new file mode 100644 index 0000000..dabe000 --- /dev/null +++ b/.github/README.md @@ -0,0 +1,247 @@ +# NAME + +Digest - Modules that calculate message digests + +# SYNOPSIS + + $md5 = Digest->new("MD5"); + $sha1 = Digest->new("SHA-1"); + $sha256 = Digest->new("SHA-256"); + $sha384 = Digest->new("SHA-384"); + $sha512 = Digest->new("SHA-512"); + + $hmac = Digest->HMAC_MD5($key); + +# DESCRIPTION + +The `Digest::` 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 or bits. + +An important property of the digest algorithms is that the digest is +_likely_ to change if the message change in some way. Another +property is that digest functions are one-way functions, that is it +should be _hard_ to find a message that correspond to some given +digest. Algorithms differ in how "likely" and how "hard", as well as +how efficient they are to compute. + +Note that the properties of the algorithms change over time, as the +algorithms are analyzed and machines grow faster. If your application +for instance depends on it being "impossible" to generate the same +digest for a different message it is wise to make it easy to plug in +stronger algorithms as the one used grow weaker. Using the interface +documented here should make it easy to change algorithms later. + +All `Digest::` modules provide the same programming interface. A +functional interface for simple use, as well as an object oriented +interface that can handle messages of arbitrary length and which can +read files directly. + +The digest can be delivered in three formats: + +- _binary_ + + This is the most compact form, but it is not well suited for printing + or embedding in places that can't handle arbitrary data. + +- _hex_ + + A twice as long string of lowercase hexadecimal digits. + +- _base64_ + + A string of portable printable characters. This is the base64 encoded + representation of the digest with any trailing padding removed. The + string will be about 30% longer than the binary version. + [MIME::Base64](https://metacpan.org/pod/MIME::Base64) tells you more about this encoding. + +The functional interface is simply importable functions with the same +name as the algorithm. The functions take the message as argument and +return the digest. Example: + + use Digest::MD5 qw(md5); + $digest = md5($message); + +There are also versions of the functions with "\_hex" or "\_base64" +appended to the name, which returns the digest in the indicated form. + +# OO INTERFACE + +The following methods are available for all `Digest::` modules: + +- $ctx = Digest->XXX($arg,...) +- $ctx = Digest->new(XXX => $arg,...) +- $ctx = Digest::XXX->new($arg,...) + + The constructor returns some object that encapsulate the state of the + message-digest algorithm. You can add data to the object and finally + ask for the digest. The "XXX" should of course be replaced by the proper + name of the digest algorithm you want to use. + + The two first forms are simply syntactic sugar which automatically + load the right module on first use. The second form allow you to use + algorithm names which contains letters which are not legal perl + identifiers, e.g. "SHA-1". If no implementation for the given algorithm + can be found, then an exception is raised. + + To know what arguments (if any) the constructor takes (the `$args,...` above) + consult the docs for the specific digest implementation. + + If new() is called as an instance method (i.e. $ctx->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, and the return value is the + reference to the object (i.e. $ctx). + +- $other\_ctx = $ctx->clone + + The clone method creates a copy of the digest state object and returns + a reference to the copy. + +- $ctx->reset + + This is just an alias for $ctx->new. + +- $ctx->add( $data ) +- $ctx->add( $chunk1, $chunk2, ... ) + + The string value of the $data provided as argument is appended to the + message we calculate the digest for. The return value is the $ctx + object itself. + + If more arguments are provided then they are all appended to the + message, thus all these lines will have the same effect on the state + of the $ctx object: + + $ctx->add("a"); $ctx->add("b"); $ctx->add("c"); + $ctx->add("a")->add("b")->add("c"); + $ctx->add("a", "b", "c"); + $ctx->add("abc"); + + Most algorithms are only defined for strings of bytes and this method + might therefore croak if the provided arguments contain chars with + ordinal number above 255. + +- $ctx->addfile( $io\_handle ) + + 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. + + The addfile() method will croak() if it fails reading data for some + reason. If it croaks it is unpredictable what the state of the $ctx + 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 $ctx object if this occurs. + + In most cases you want to make sure that the $io\_handle is in + "binmode" before you pass it as argument to the addfile() method. + +- $ctx->add\_bits( $data, $nbits ) +- $ctx->add\_bits( $bitstring ) + + The add\_bits() method is an alternative to add() that allow partial + bytes to be appended to the message. Most users can just ignore + this method since typical applications involve only whole-byte data. + + 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 + `$nbits % 8` bits are used. If $nbits is greater than `length($data) * 8`, then this method would do the same as `$ctx->add($data)`. + + The one argument form of add\_bits() takes a $bitstring of "1" and "0" + chars as argument. It's a shorthand for `$ctx->add_bits(pack("B*", + $bitstring), length($bitstring))`. + + The return value is the $ctx object itself. + + 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 and for these it is not possible + to add bits that are not a multiple of 8, and the add\_bits() method + will croak if you try. + +- $ctx->digest + + Return the binary digest for the message. + + Note that the `digest` operation is effectively a destructive, + read-once operation. Once it has been performed, the $ctx object is + automatically `reset` and can be used to calculate another digest + value. Call $ctx->clone->digest if you want to calculate the digest + without resetting the digest state. + +- $ctx->hexdigest + + Same as $ctx->digest, but will return the digest in hexadecimal form. + +- $ctx->b64digest + + Same as $ctx->digest, but will return the digest as a base64 encoded + string without padding. + +- $ctx->base64\_padded\_digest + + Same as $ctx->digest, but will return the digest as a base64 encoded + string. + +# Digest speed + +This table should give some indication on the relative speed of +different algorithms. It is sorted by throughput based on a benchmark +done with of some implementations of this API: + + Algorithm Size Implementation MB/s + + MD4 128 Digest::MD4 v1.3 165.0 + MD5 128 Digest::MD5 v2.33 98.8 + SHA-256 256 Digest::SHA2 v1.1.0 66.7 + SHA-1 160 Digest::SHA v4.3.1 58.9 + SHA-1 160 Digest::SHA1 v2.10 48.8 + SHA-256 256 Digest::SHA v4.3.1 41.3 + Haval-256 256 Digest::Haval256 v1.0.4 39.8 + SHA-384 384 Digest::SHA2 v1.1.0 19.6 + SHA-512 512 Digest::SHA2 v1.1.0 19.3 + SHA-384 384 Digest::SHA v4.3.1 19.2 + SHA-512 512 Digest::SHA v4.3.1 19.2 + Whirlpool 512 Digest::Whirlpool v1.0.2 13.0 + MD2 128 Digest::MD2 v2.03 9.5 + + Adler-32 32 Digest::Adler32 v0.03 1.3 + CRC-16 16 Digest::CRC v0.05 1.1 + CRC-32 32 Digest::CRC v0.05 1.1 + MD5 128 Digest::Perl::MD5 v1.5 1.0 + CRC-CCITT 16 Digest::CRC v0.05 0.8 + +These numbers was achieved Apr 2004 with ActivePerl-5.8.3 running +under Linux on a P4 2.8 GHz CPU. The last 5 entries differ by being +pure perl implementations of the algorithms, which explains why they +are so slow. + +# SEE ALSO + +[Digest::Adler32](https://metacpan.org/pod/Digest::Adler32), [Digest::CRC](https://metacpan.org/pod/Digest::CRC), [Digest::Haval256](https://metacpan.org/pod/Digest::Haval256), +[Digest::HMAC](https://metacpan.org/pod/Digest::HMAC), [Digest::MD2](https://metacpan.org/pod/Digest::MD2), [Digest::MD4](https://metacpan.org/pod/Digest::MD4), [Digest::MD5](https://metacpan.org/pod/Digest::MD5), +[Digest::SHA](https://metacpan.org/pod/Digest::SHA), [Digest::SHA1](https://metacpan.org/pod/Digest::SHA1), [Digest::SHA2](https://metacpan.org/pod/Digest::SHA2), [Digest::Whirlpool](https://metacpan.org/pod/Digest::Whirlpool) + +New digest implementations should consider subclassing from [Digest::base](https://metacpan.org/pod/Digest::base). + +[MIME::Base64](https://metacpan.org/pod/MIME::Base64) + +http://en.wikipedia.org/wiki/Cryptographic\_hash\_function + +# AUTHOR + +Gisle Aas + +The `Digest::` interface is based on the interface originally +developed by Neil Winton for his `MD5` module. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + Copyright 1998-2006 Gisle Aas. + Copyright 1995,1996 Neil Winton. diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml new file mode 100644 index 0000000..3cd0e3e --- /dev/null +++ b/.github/workflows/testsuite.yml @@ -0,0 +1,105 @@ +name: testsuite + +on: + push: + branches: + - "*" + tags-ignore: + - "*" + pull_request: + +jobs: + ubuntu: + env: + PERL_USE_UNSAFE_INC: 0 + AUTHOR_TESTING: 1 + AUTOMATED_TESTING: 1 + RELEASE_TESTING: 1 + + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v2 + - run: perl -V + - name: install dependencies + uses: perl-actions/install-with-cpm@v1 + with: + cpanfile: "cpanfile" + - name: Makefile.PL + run: perl -I$(pwd) Makefile.PL + - name: make test + run: make test + + linux: + name: "linux ${{ matrix.perl-version }}" + needs: [ubuntu] + env: + PERL_USE_UNSAFE_INC: 0 + AUTHOR_TESTING: 1 + AUTOMATED_TESTING: 1 + RELEASE_TESTING: 1 + + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + perl-version: + [ + "5.32", + "5.30", + "5.28", + "5.26", + "5.24", + "5.22", + "5.20", + "5.18", + "5.16", + "5.14", + "5.12", + "5.10", + "5.8", + ] + + container: + image: perl:${{ matrix.perl-version }} + + steps: + - uses: actions/checkout@v2 + - run: perl -V + - name: install dependencies + uses: perl-actions/install-with-cpm@v1 + with: + sudo: false + cpanfile: "cpanfile" + - name: Makefile.PL + run: perl -I$(pwd) Makefile.PL + - name: make test + run: make test + + macOS: + needs: [ubuntu] + env: + PERL_USE_UNSAFE_INC: 0 + AUTHOR_TESTING: 1 + AUTOMATED_TESTING: 1 + RELEASE_TESTING: 1 + + runs-on: macOS-latest + + strategy: + fail-fast: false + matrix: + perl-version: [latest] + + steps: + - uses: actions/checkout@v2 + - run: perl -V + - name: install dependencies + uses: perl-actions/install-with-cpm@v1 + with: + cpanfile: "cpanfile" + - name: Makefile.PL + run: perl -I$(pwd) Makefile.PL + - name: make test + run: make test diff --git a/.gitignore b/.gitignore index 09d1765..d5df0b2 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,12 @@ +*~ +/*.tar.gz /Makefile -/MYMETA.yml -/blib/ +/*.old /pm_to_blib -*.old -*.tar.gz +/blib +/MYMETA.* +/META.* +/MANIFEST.bak +/Digest-[0-9]* +*.ERR +*.bak diff --git a/.perltidyrc b/.perltidyrc new file mode 100644 index 0000000..3403898 --- /dev/null +++ b/.perltidyrc @@ -0,0 +1,8 @@ +-l=400 +-i=4 +-dt=4 +-it=4 +-bar +-nsfs +-nolq +--break-at-old-comma-breakpoints diff --git a/Changes b/Changes index d91cb35..41a8b3c 100644 --- a/Changes +++ b/Changes @@ -1,185 +1,102 @@ -2011-10-02 Gisle Aas - - Release 1.17. - - Gisle Aas (6): - Less noisy 'git status' output - Merge pull request #1 from schwern/bug/require_eval - Don't clobber $@ in Digest->new [RT#50663] - More meta info added to Makefile.PL - Fix typo in RIPEMD160 [RT#50629] - Add schwern's test files - - Michael G. Schwern (5): - Turn on strict. - Convert tests to use Test::More - Untabify - Turn Digest::Dummy into a real file which exercises the Digest->new() require logic. - Close the eval "require $module" security hole in Digest->new($algorithm) - - - -2009-06-09 Gisle Aas - - Release 1.16. - - Gisle Aas (3): - For SHA-1 try Digest::SHA before tryign Digest::SHA1 as suggested by Adam Trickett - Support Digest->new("RIPEMD-160") as suggested by Zefram - Use 3-arg open for fewer surprises - - Jarkko Hietaniemi (1): - Sync up with EBCDIC changes from core perl. - - - -2006-03-20 Gisle Aas - - Release 1.15. - - Improved documentation. - - - -2005-11-26 Gisle Aas - - Release 1.14 - - Documentation tweaks. - - - -2005-10-18 Gisle Aas - - Release 1.13 - - Fixed documentation typo. - - - -2005-09-29 Gisle Aas - - Release 1.12 - - Fix documentation typo. Patch by . - - - -2005-09-11 Gisle Aas - - Release 1.11 - - Make Digest->new("SHA-224") work. Patch by Mark Shelor - . - - - -2004-11-08 Gisle Aas - - Release 1.10 - - Added Digest::file module which provide convenience functions - that calculate digests of files. - - - -2004-11-05 Gisle Aas - - Release 1.09 - - Fix trivial documentation typo. - - - -2004-04-29 Gisle Aas - - Release 1.08 - - Make Digest->new("CRC-16"), Digest->new("CRC-32") and - Digest->new("CRC-CCITT") work. - Patch by Oliver Maul . - - - -2004-04-25 Gisle Aas - - Release 1.07 - - Updated benchmark. - - - -2004-04-01 Gisle Aas - - Release 1.06 - - Added MIME::Base64 dependency. - - Minor doc tweak. - - - -2003-12-01 Gisle Aas - - Release 1.05 - - Drop Digest::MD5 dependency. Avoids circular dependency - now that Digest::MD5 depend on this package to inherit - Digest::base. - - Included a section about digest speed with benchmark - results for some implementations of this API. - - - -2003-11-29 Gisle Aas - - Release 1.04 - - Doc tweaks to unconfuse search.cpan.org. - - - -2003-11-28 Gisle Aas - - Release 1.03 - - Added add_bits() method as requested by the - Digest::SHA author Mark Shelor. - - Added Digest::base class that Digest implementations - can use to get default implementations of addfile(), - add_bits(), hexdigest() and b64digest(). - - Digest->new("SHA-256") and similar should work now - given that you have either Digest::SHA or Digest::SHA2 - installed. - - - -2003-01-18 Gisle Aas - - Release 1.02 - - Sync up with version bundled with perl-5.8. - Patch by Jarkko Hietaniemi . - - Override INSTALLDIRS for 5.8 as suggested by - Guido Ostkamp . - - - -2003-01-04 Gisle Aas - - Release 1.01 - - Document the clone() method. - - - -2001-03-13 Gisle Aas - - Release 1.00 - - Broken out of the Digest-MD5-2.12 distribution and made into - a separate dist. +1.20 Tue 2021-08-24 +- Remove temp files during unit tests. + +1.19 Tue 2020-10-13 +- Merge blead change: Remove . from @INC when loading optional modules. + +1.18 Tue 2020-10-13 +- Correct documentation for add_bits +- Explain $args,... in constructor prototypes +- Add base64_padded_digest method +- Add support for the SHA3 digests +- Update .gitignore and get make manifest working +- Github CI +- Move Digest to a more modern directory tree layout +- Enable strict/warnings for code and tests +- Drop use vars +- Provide a consistent tidy to the code base +- Get rid of the use of bareword file handles +- Modernize the changelog +- Use File::Temp for temporary test files + +1.17 Sun 2011-10-02 +- Less noisy 'git status' output - Gisle Aas +- Merge pull request #1 from schwern/bug/require_eval - Gisle Aas +- Don't clobber $@ in Digest->new [RT#50663] - Gisle Aas +- More meta info added to Makefile.PL - Gisle Aas +- Fix typo in RIPEMD160 [RT#50629] - Gisle Aas +- Add schwern's test files - Gisle Aas +- Turn on strict. - Michael G. Schwern +- Convert tests to use Test::More - Michael G. Schwern +- Untabify - Michael G. Schwern +- Turn Digest::Dummy into a real file which exercises the Digest->new() require logic. - Michael G. Schwern +- Close the eval "require $module" security hole in Digest->new($algorithm) - Michael G. Schwern + +1.16 Tue 2009-06-09 +- For SHA-1 try Digest::SHA before tryign Digest::SHA1 as suggested by Adam Trickett - Gisle Aas +- Support Digest->new("RIPEMD-160") as suggested by Zefram - Gisle Aas +- Use 3-arg open for fewer surprises - Gisle Aas +- Sync up with EBCDIC changes from core perl - Jarkko Hietaniemi + +1.15 Mon 2006-03-20 +- Improved documentation. + +1.14 Sat 2005-11-26 +- Documentation tweaks. + +1.13 Tue 2005-10-18 +- Fixed documentation typo. + +1.12 Thu 2005-09-29 +- Fix documentation typo. Patch by . + +1.11 Sun 2005-09-11 +- Make Digest->new("SHA-224") work. Patch by Mark Shelor . + +1.10 Mon 2004-11-08 +- Added Digest::file module which provide convenience functions that calculate digests of files. + +1.09 Fri 2004-11-05 +- Fix trivial documentation typo. + +1.08 Thu 2004-04-29 +- Make Digest->new("CRC-16"), Digest->new("CRC-32") and +- Digest->new("CRC-CCITT") work. + Patch by Oliver Maul . + +1.07 Sun 2004-04-25 +- Updated benchmark. + +1.06 Thu 2004-04-01 +- Added MIME::Base64 dependency. +- Minor doc tweak. + +1.05 Mon 2003-12-01 +- Drop Digest::MD5 dependency. Avoids circular dependency + now that Digest::MD5 depend on this package to inherit + Digest::base. +- Included a section about digest speed with benchmark + results for some implementations of this API. + +1.04 Sat 2003-11-29 +- Doc tweaks to unconfuse search.cpan.org. + +1.03 Fri 2003-11-28 +- Added add_bits() method as requested by the Digest::SHA author Mark Shelor. +- Added Digest::base class that Digest implementations + can use to get default implementations of addfile(), + add_bits(), hexdigest() and b64digest(). +- Digest->new("SHA-256") and similar should work now + given that you have either Digest::SHA or Digest::SHA2 + installed. + +1.02 Sat 2003-01-18 +- Sync up with version bundled with perl-5.8. Patch by Jarkko Hietaniemi . +- Override INSTALLDIRS for 5.8 as suggested by Guido Ostkamp . + +1.01 Sat 2003-01-04 +- Document the clone() method. + +1.00 Tue 2001-03-13 +- Broken out of the Digest-MD5-2.12 distribution and made into + a separate dist. diff --git a/MANIFEST b/MANIFEST index 2ffedf0..7664f70 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,10 +1,10 @@ Changes -Digest.pm -Digest/base.pm -Digest/file.pm digest-bench -MANIFEST +lib/Digest.pm +lib/Digest/base.pm +lib/Digest/file.pm Makefile.PL +MANIFEST This list of files README t/base.t t/digest.t diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index fa0a818..1f5a709 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -1,13 +1,23 @@ ^blib/ -^.git/ -^.gitignore$ \.old$ \.bak$ -\.tar.gz$ Makefile$ -^MYMETA.yml$ ^MANIFEST.SKIP$ ^# /# ~$ +\b(RCS|CVS)/[^/]+$ +\.cvsignore$ pm_to_blib$ +\.o$ +\.c$ +\.bs$ +^Digest-.*\.tar\.gz$ +^other/ +^.git/ +^\.github/ +^cpanfile$ +^\.gitignore$ +^\.travis.yml$ +^MYMETA\. +^\.perltidyrc$ diff --git a/Makefile.PL b/Makefile.PL index 5da801f..08ca4ec 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,43 +1,50 @@ -require 5.004; +require 5.006; +use strict; +use warnings; use ExtUtils::MakeMaker; -WriteMakefile( - 'NAME' => 'Digest', - 'VERSION_FROM' => 'Digest.pm', - ($] >= 5.008 ? ('INSTALLDIRS' => 'perl') : ()), - ABSTRACT_FROM => 'Digest.pm', - AUTHOR => 'Gisle Aas ', - LICENSE => 'perl', - MIN_PERL_VERSION => '5.004', - 'PREREQ_PM' => { +my %WriteMakefile_args = ( + 'NAME' => 'Digest', + 'AUTHOR' => 'Gisle Aas ', + 'VERSION_FROM' => 'lib/Digest.pm', + 'ABSTRACT_FROM' => 'lib/Digest.pm', + 'LICENSE' => 'perl', + 'MIN_PERL_VERSION' => '5.006', + 'PREREQ_PM' => { 'MIME::Base64' => 0, - 'Test::More' => '0.47' }, - META_MERGE => { - resources => { - repository => 'http://github.com/gisle/digest', + 'TEST_REQUIRES' => { + 'Test::More' => '0.47', + 'File::Temp' => '0', + }, + 'INSTALLDIRS' => ( ( $] >= '5.009005' && $] < '5.012' ) ? 'perl' : 'site' ), + 'dist' => { 'COMPRESS' => 'gzip -9f', 'SUFFIX' => 'gz', }, + 'clean' => { 'FILES' => 'Digest-*' }, + + 'META_MERGE' => { + 'meta-spec' => { 'version' => 2 }, + 'dynamic_config' => 0, + 'resources' => { + 'license' => ['http://dev.perl.org/licenses/'], + 'bugtracker' => { 'web' => 'https://github.com/Dual-Life/digest/issues' }, + 'repository' => { + 'type' => 'git', + 'url' => 'https://github.com/Dual-Life/digest.git', + 'web' => 'https://github.com/Dual-Life/digest', + }, } }, ); -BEGIN { - # compatibility with older versions of MakeMaker - my $developer = -f ".gitignore"; - my %mm_req = ( - LICENCE => 6.31, - META_MERGE => 6.45, - META_ADD => 6.45, - MIN_PERL_VERSION => 6.48, - ); - undef(*WriteMakefile); - *WriteMakefile = sub { - my %arg = @_; - for (keys %mm_req) { - unless (eval { ExtUtils::MakeMaker->VERSION($mm_req{$_}) }) { - warn "$_ $@" if $developer; - delete $arg{$_}; - } - } - ExtUtils::MakeMaker::WriteMakefile(%arg); - }; +delete $WriteMakefile_args{LICENSE} + unless eval { ExtUtils::MakeMaker->VERSION('6.31') }; +delete $WriteMakefile_args{META_MERGE} + unless eval { ExtUtils::MakeMaker->VERSION('6.46') }; +delete $WriteMakefile_args{MIN_PERL_VERSION} + unless eval { ExtUtils::MakeMaker->VERSION('6.48') }; +unless ( eval { ExtUtils::MakeMaker->VERSION('6.64') } ) { + my $test_requires = delete $WriteMakefile_args{TEST_REQUIRES}; + $WriteMakefile_args{PREREQ_PM}{$_} = $test_requires->{$_} for keys %$test_requires; } + +WriteMakefile(%WriteMakefile_args); diff --git a/README b/README index 1c062a1..9712b64 100644 --- a/README +++ b/README @@ -1,11 +1,232 @@ -This is just a simple frontend module for autoloading of various -Digest:: modules. It also provide documentation of the interface that -all Digest:: modules should provide. +NAME + Digest - Modules that calculate message digests -You will need perl version 5.004 or better to install this module. +SYNOPSIS + $md5 = Digest->new("MD5"); + $sha1 = Digest->new("SHA-1"); + $sha256 = Digest->new("SHA-256"); + $sha384 = Digest->new("SHA-384"); + $sha512 = Digest->new("SHA-512"); -Copyright 1998-2006 Gisle Aas. -Copyright 1995-1996 Neil Winton. + $hmac = Digest->HMAC_MD5($key); + +DESCRIPTION + The "Digest::" 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 or + bits. + + An important property of the digest algorithms is that the digest is + *likely* to change if the message change in some way. Another property + is that digest functions are one-way functions, that is it should be + *hard* to find a message that correspond to some given digest. + Algorithms differ in how "likely" and how "hard", as well as how + efficient they are to compute. + + Note that the properties of the algorithms change over time, as the + algorithms are analyzed and machines grow faster. If your application + for instance depends on it being "impossible" to generate the same + digest for a different message it is wise to make it easy to plug in + stronger algorithms as the one used grow weaker. Using the interface + documented here should make it easy to change algorithms later. + + All "Digest::" modules provide the same programming interface. A + functional interface for simple use, as well as an object oriented + interface that can handle messages of arbitrary length and which can + read files directly. + + The digest can be delivered in three formats: + + *binary* + This is the most compact form, but it is not well suited for + printing or embedding in places that can't handle arbitrary + data. + + *hex* A twice as long string of lowercase hexadecimal digits. + + *base64* + A string of portable printable characters. This is the base64 + encoded representation of the digest with any trailing padding + removed. The string will be about 30% longer than the binary + version. MIME::Base64 tells you more about this encoding. + + The functional interface is simply importable functions with the same + name as the algorithm. The functions take the message as argument and + return the digest. Example: + + use Digest::MD5 qw(md5); + $digest = md5($message); + + There are also versions of the functions with "_hex" or "_base64" + appended to the name, which returns the digest in the indicated form. + +OO INTERFACE + The following methods are available for all "Digest::" modules: + + $ctx = Digest->XXX($arg,...) + $ctx = Digest->new(XXX => $arg,...) + $ctx = Digest::XXX->new($arg,...) + The constructor returns some object that encapsulate the state of + the message-digest algorithm. You can add data to the object and + finally ask for the digest. The "XXX" should of course be replaced + by the proper name of the digest algorithm you want to use. + + The two first forms are simply syntactic sugar which automatically + load the right module on first use. The second form allow you to use + algorithm names which contains letters which are not legal perl + identifiers, e.g. "SHA-1". If no implementation for the given + algorithm can be found, then an exception is raised. + + To know what arguments (if any) the constructor takes (the + "$args,..." above) consult the docs for the specific digest + implementation. + + If new() is called as an instance method (i.e. $ctx->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, and the return value + is the reference to the object (i.e. $ctx). + + $other_ctx = $ctx->clone + The clone method creates a copy of the digest state object and + returns a reference to the copy. + + $ctx->reset + This is just an alias for $ctx->new. + + $ctx->add( $data ) + $ctx->add( $chunk1, $chunk2, ... ) + The string value of the $data provided as argument is appended to + the message we calculate the digest for. The return value is the + $ctx object itself. + + If more arguments are provided then they are all appended to the + message, thus all these lines will have the same effect on the state + of the $ctx object: + + $ctx->add("a"); $ctx->add("b"); $ctx->add("c"); + $ctx->add("a")->add("b")->add("c"); + $ctx->add("a", "b", "c"); + $ctx->add("abc"); + + Most algorithms are only defined for strings of bytes and this + method might therefore croak if the provided arguments contain chars + with ordinal number above 255. + + $ctx->addfile( $io_handle ) + 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. + + The addfile() method will croak() if it fails reading data for some + reason. If it croaks it is unpredictable what the state of the $ctx + 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 $ctx object if this occurs. + + In most cases you want to make sure that the $io_handle is in + "binmode" before you pass it as argument to the addfile() method. + + $ctx->add_bits( $data, $nbits ) + $ctx->add_bits( $bitstring ) + The add_bits() method is an alternative to add() that allow partial + bytes to be appended to the message. Most users can just ignore this + method since typical applications involve only whole-byte data. + + 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 "$nbits % 8" bits are used. If $nbits is greater than + "length($data) * 8", then this method would do the same as + "$ctx->add($data)". + + The one argument form of add_bits() takes a $bitstring of "1" and + "0" chars as argument. It's a shorthand for + "$ctx->add_bits(pack("B*", $bitstring), length($bitstring))". + + The return value is the $ctx object itself. + + 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 and for these it is not + possible to add bits that are not a multiple of 8, and the + add_bits() method will croak if you try. + + $ctx->digest + Return the binary digest for the message. + + Note that the "digest" operation is effectively a destructive, + read-once operation. Once it has been performed, the $ctx object is + automatically "reset" and can be used to calculate another digest + value. Call $ctx->clone->digest if you want to calculate the digest + without resetting the digest state. + + $ctx->hexdigest + Same as $ctx->digest, but will return the digest in hexadecimal + form. + + $ctx->b64digest + Same as $ctx->digest, but will return the digest as a base64 encoded + string without padding. + + $ctx->base64_padded_digest + Same as $ctx->digest, but will return the digest as a base64 encoded + string. + +Digest speed + This table should give some indication on the relative speed of + different algorithms. It is sorted by throughput based on a benchmark + done with of some implementations of this API: + + Algorithm Size Implementation MB/s + + MD4 128 Digest::MD4 v1.3 165.0 + MD5 128 Digest::MD5 v2.33 98.8 + SHA-256 256 Digest::SHA2 v1.1.0 66.7 + SHA-1 160 Digest::SHA v4.3.1 58.9 + SHA-1 160 Digest::SHA1 v2.10 48.8 + SHA-256 256 Digest::SHA v4.3.1 41.3 + Haval-256 256 Digest::Haval256 v1.0.4 39.8 + SHA-384 384 Digest::SHA2 v1.1.0 19.6 + SHA-512 512 Digest::SHA2 v1.1.0 19.3 + SHA-384 384 Digest::SHA v4.3.1 19.2 + SHA-512 512 Digest::SHA v4.3.1 19.2 + Whirlpool 512 Digest::Whirlpool v1.0.2 13.0 + MD2 128 Digest::MD2 v2.03 9.5 + + Adler-32 32 Digest::Adler32 v0.03 1.3 + CRC-16 16 Digest::CRC v0.05 1.1 + CRC-32 32 Digest::CRC v0.05 1.1 + MD5 128 Digest::Perl::MD5 v1.5 1.0 + CRC-CCITT 16 Digest::CRC v0.05 0.8 + + These numbers was achieved Apr 2004 with ActivePerl-5.8.3 running under + Linux on a P4 2.8 GHz CPU. The last 5 entries differ by being pure perl + implementations of the algorithms, which explains why they are so slow. + +SEE ALSO + Digest::Adler32, Digest::CRC, Digest::Haval256, Digest::HMAC, + Digest::MD2, Digest::MD4, Digest::MD5, Digest::SHA, Digest::SHA1, + Digest::SHA2, Digest::Whirlpool + + New digest implementations should consider subclassing from + Digest::base. + + MIME::Base64 + + http://en.wikipedia.org/wiki/Cryptographic_hash_function + +AUTHOR + Gisle Aas + + The "Digest::" interface is based on the interface originally developed + by Neil Winton for his "MD5" module. + + This library is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + + Copyright 1998-2006 Gisle Aas. + Copyright 1995,1996 Neil Winton. -This library is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..30651e1 --- /dev/null +++ b/cpanfile @@ -0,0 +1,11 @@ +requires "strict" => "0"; +requires "warnings" => "0"; +requires "Exporter" => "0"; +requires "Carp" => "0"; +requires "Digest::MD5" => "0"; + +on 'test' => sub { + requires 'Test::More' => '0'; + requires 'File::Temp' => '0'; +}; + diff --git a/digest-bench b/digest-bench index 909e5eb..f828b2b 100755 --- a/digest-bench +++ b/digest-bench @@ -3,26 +3,27 @@ use strict; die unless @ARGV; -my($mod, @args) = @ARGV; +my ( $mod, @args ) = @ARGV; -eval "require $mod"; die $@ if $@; +eval "require $mod"; +die $@ if $@; -$a = substr(join("", "a" .. "z",) x 800, 0, 8 * 1024); -my $count = 4*1024; +$a = substr( join( "", "a" .. "z", ) x 800, 0, 8 * 1024 ); +my $count = 4 * 1024; use Time::HiRes qw(time); my $before = time; -my $ctx = $mod->new(@args); -for (1 .. $count) { +my $ctx = $mod->new(@args); +for ( 1 .. $count ) { $ctx->add($a); } print $ctx->hexdigest, "\n"; -my $sec = time - $before; +my $sec = time - $before; my $bytes = length($a) * $count; print "$bytes/$sec\n"; -my $vers = do { no strict 'refs'; ${$mod . '::VERSION'} }; -printf "$mod $vers\t%.2f MB/s\n", $bytes/(1024*1024*$sec) +my $vers = do { no strict 'refs'; ${ $mod . '::VERSION' } }; +printf "$mod $vers\t%.2f MB/s\n", $bytes / ( 1024 * 1024 * $sec ) diff --git a/Digest.pm b/lib/Digest.pm similarity index 86% rename from Digest.pm rename to lib/Digest.pm index 2ae6eec..087274a 100644 --- a/Digest.pm +++ b/lib/Digest.pm @@ -1,65 +1,71 @@ package Digest; use strict; -use vars qw($VERSION %MMAP $AUTOLOAD); - -$VERSION = "1.17"; - -%MMAP = ( - "SHA-1" => [["Digest::SHA", 1], "Digest::SHA1", ["Digest::SHA2", 1]], - "SHA-224" => [["Digest::SHA", 224]], - "SHA-256" => [["Digest::SHA", 256], ["Digest::SHA2", 256]], - "SHA-384" => [["Digest::SHA", 384], ["Digest::SHA2", 384]], - "SHA-512" => [["Digest::SHA", 512], ["Digest::SHA2", 512]], - "SHA3-224" => [["Digest::SHA3", 224]], - "SHA3-256" => [["Digest::SHA3", 256]], - "SHA3-384" => [["Digest::SHA3", 384]], - "SHA3-512" => [["Digest::SHA3", 512]], - "HMAC-MD5" => "Digest::HMAC_MD5", - "HMAC-SHA-1" => "Digest::HMAC_SHA1", - "CRC-16" => [["Digest::CRC", type => "crc16"]], - "CRC-32" => [["Digest::CRC", type => "crc32"]], - "CRC-CCITT" => [["Digest::CRC", type => "crcccitt"]], - "RIPEMD-160" => "Crypt::RIPEMD160", +use warnings; + +our $VERSION = "1.20"; + +our %MMAP = ( + "SHA-1" => [ [ "Digest::SHA", 1 ], "Digest::SHA1", [ "Digest::SHA2", 1 ] ], + "SHA-224" => [ [ "Digest::SHA", 224 ] ], + "SHA-256" => [ [ "Digest::SHA", 256 ], [ "Digest::SHA2", 256 ] ], + "SHA-384" => [ [ "Digest::SHA", 384 ], [ "Digest::SHA2", 384 ] ], + "SHA-512" => [ [ "Digest::SHA", 512 ], [ "Digest::SHA2", 512 ] ], + "SHA3-224" => [ [ "Digest::SHA3", 224 ] ], + "SHA3-256" => [ [ "Digest::SHA3", 256 ] ], + "SHA3-384" => [ [ "Digest::SHA3", 384 ] ], + "SHA3-512" => [ [ "Digest::SHA3", 512 ] ], + "HMAC-MD5" => "Digest::HMAC_MD5", + "HMAC-SHA-1" => "Digest::HMAC_SHA1", + "CRC-16" => [ [ "Digest::CRC", type => "crc16" ] ], + "CRC-32" => [ [ "Digest::CRC", type => "crc32" ] ], + "CRC-CCITT" => [ [ "Digest::CRC", type => "crcccitt" ] ], + "RIPEMD-160" => "Crypt::RIPEMD160", ); -sub new -{ - shift; # class ignored +sub new { + shift; # class ignored my $algorithm = shift; - my $impl = $MMAP{$algorithm} || do { + my $impl = $MMAP{$algorithm} || do { $algorithm =~ s/\W+//g; "Digest::$algorithm"; }; $impl = [$impl] unless ref($impl); - local $@; # don't clobber it for our caller + local $@; # don't clobber it for our caller my $err; - for (@$impl) { + for (@$impl) { my $class = $_; my @args; - ($class, @args) = @$class if ref($class); + ( $class, @args ) = @$class if ref($class); no strict 'refs'; - unless (exists ${"$class\::"}{"VERSION"}) { + unless ( exists ${"$class\::"}{"VERSION"} ) { my $pm_file = $class . ".pm"; $pm_file =~ s{::}{/}g; - eval { require $pm_file }; + eval { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require $pm_file + }; if ($@) { $err ||= $@; next; } } - return $class->new(@args, @_); + return $class->new( @args, @_ ); } die $err; } -sub AUTOLOAD -{ - my $class = shift; - my $algorithm = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2); - $class->new($algorithm, @_); +our $AUTOLOAD; + +sub AUTOLOAD { + my $class = shift; + my $algorithm = substr( $AUTOLOAD, rindex( $AUTOLOAD, '::' ) + 2 ); + $class->new( $algorithm, @_ ); } +sub DESTROY { } # prevent AUTOLOAD from catching implicit DESTROY calls + 1; __END__ diff --git a/Digest/base.pm b/lib/Digest/base.pm similarity index 63% rename from Digest/base.pm rename to lib/Digest/base.pm index 2535901..539559b 100644 --- a/Digest/base.pm +++ b/lib/Digest/base.pm @@ -1,8 +1,9 @@ package Digest::base; use strict; -use vars qw($VERSION); -$VERSION = "1.16"; +use warnings; + +our $VERSION = "1.20"; # subclass is supposed to implement at least these sub new; @@ -12,21 +13,21 @@ sub digest; sub reset { my $self = shift; - $self->new(@_); # ugly + $self->new(@_); # ugly } sub addfile { - my ($self, $handle) = @_; + my ( $self, $handle ) = @_; my $n; my $buf = ""; - while (($n = read($handle, $buf, 4*1024))) { + while ( ( $n = read( $handle, $buf, 4 * 1024 ) ) ) { $self->add($buf); } - unless (defined $n) { - require Carp; - Carp::croak("Read failed: $!"); + unless ( defined $n ) { + require Carp; + Carp::croak("Read failed: $!"); } $self; @@ -36,29 +37,29 @@ sub add_bits { my $self = shift; my $bits; my $nbits; - if (@_ == 1) { - my $arg = shift; - $bits = pack("B*", $arg); - $nbits = length($arg); + if ( @_ == 1 ) { + my $arg = shift; + $bits = pack( "B*", $arg ); + $nbits = length($arg); } else { - ($bits, $nbits) = @_; + ( $bits, $nbits ) = @_; } - if (($nbits % 8) != 0) { - require Carp; - Carp::croak("Number of bits must be multiple of 8 for this algorithm"); + 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)); + return $self->add( substr( $bits, 0, $nbits / 8 ) ); } sub hexdigest { my $self = shift; - return unpack("H*", $self->digest(@_)); + return unpack( "H*", $self->digest(@_) ); } sub b64digest { my $self = shift; - my $b64 = $self->base64_padded_digest; + my $b64 = $self->base64_padded_digest; $b64 =~ s/=+$//; return $b64; } @@ -66,7 +67,7 @@ sub b64digest { sub base64_padded_digest { my $self = shift; require MIME::Base64; - return MIME::Base64::encode($self->digest(@_), ""); + return MIME::Base64::encode( $self->digest(@_), "" ); } 1; diff --git a/Digest/file.pm b/lib/Digest/file.pm similarity index 59% rename from Digest/file.pm rename to lib/Digest/file.pm index 3b86e63..1bcfff0 100644 --- a/Digest/file.pm +++ b/lib/Digest/file.pm @@ -1,26 +1,23 @@ package Digest::file; use strict; +use warnings; -use Exporter (); +use base 'Exporter'; use Carp qw(croak); use Digest (); -use vars qw($VERSION @ISA @EXPORT_OK); - -$VERSION = "1.16"; -@ISA = qw(Exporter); -@EXPORT_OK = qw(digest_file_ctx digest_file digest_file_hex digest_file_base64); +our $VERSION = "1.20"; +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 @_; - local *F; - open(F, "<", $file) || croak("Can't open '$file': $!"); - binmode(F); + open( my $fh, "<", $file ) || croak("Can't open '$file': $!"); + binmode($fh); my $ctx = Digest->new(@_); - $ctx->addfile(*F); - close(F); + $ctx->addfile($fh); + close($fh); return $ctx; } @@ -54,11 +51,24 @@ Digest::file - Calculate digests of files =head1 DESCRIPTION -This module provide 3 convenience functions to calculate the digest +This module provide 4 convenience functions to calculate the digest of files. The following functions are provided: =over +=item digest_file_ctx( $file, $algorithm, [$arg,...] ) + +This function will open the given file in binary mode, feed its +contents to a new digest object, and return the L context +object. This is useful when you need to call a specific digest +method yourself rather than using one of the shorthand functions +below. The function will croak if no algorithm is specified or 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( $file, $algorithm, [$arg,...] ) This function will calculate and return the binary digest of the bytes diff --git a/t/base.t b/t/base.t index 9fc861e..153d4d4 100644 --- a/t/base.t +++ b/t/base.t @@ -1,85 +1,88 @@ #!perl -w +use strict; +use warnings; + use Test::More tests => 13; +use File::Temp 'tempfile'; + { - 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; - } + + package LenDigest; + require Digest::base; + our @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; -is($ctx->digest, "X0000"); +is( $ctx->digest, "X0000" ); my $EBCDIC = ord('A') == 193; if ($EBCDIC) { - is($ctx->hexdigest, "e7f0f0f0f0"); - is($ctx->b64digest, "5/Dw8PA"); - is($ctx->base64_padded_digest, "5/Dw8PA="); -} else { - is($ctx->hexdigest, "5830303030"); - is($ctx->b64digest, "WDAwMDA"); - is($ctx->base64_padded_digest, "WDAwMDA="); + is( $ctx->hexdigest, "e7f0f0f0f0" ); + is( $ctx->b64digest, "5/Dw8PA" ); + is( $ctx->base64_padded_digest, "5/Dw8PA=" ); +} +else { + is( $ctx->hexdigest, "5830303030" ); + is( $ctx->b64digest, "WDAwMDA" ); + is( $ctx->base64_padded_digest, "WDAwMDA=" ); } $ctx->add("foo"); -is($ctx->digest, "f0003"); +is( $ctx->digest, "f0003" ); $ctx->add("foo"); -is($ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033"); +is( $ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033" ); $ctx->add("foo"); -is($ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM"); +is( $ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM" ); -open(F, ">xxtest$$") || die; -binmode(F); -print F "abc" x 100, "\n"; -close(F) || die; +{ + my ( $fh, $tempfile ) = tempfile( UNLINK => 1 ); + binmode($fh); + print $fh "abc" x 100, "\n"; + close($fh) || die; -open(F, "xxtest$$") || die; -$ctx->addfile(*F); -close(F); -unlink("xxtest$$") || warn; + open( my $fh2, $tempfile ) || die; + $ctx->addfile($fh2); + close($fh2); -is($ctx->digest, "a0301"); + is( $ctx->digest, "a0301" ); +} -eval { - $ctx->add_bits("1010"); -}; -like($@, '/^Number of bits must be multiple of 8/'); +eval { $ctx->add_bits("1010"); }; +like( $@, '/^Number of bits must be multiple of 8/' ); -$ctx->add_bits($EBCDIC ? "11100100" : "01010101"); -is($ctx->digest, "U0001"); +$ctx->add_bits( $EBCDIC ? "11100100" : "01010101" ); +is( $ctx->digest, "U0001" ); -eval { - $ctx->add_bits("abc", 12); -}; -like($@, '/^Number of bits must be multiple of 8/'); +eval { $ctx->add_bits( "abc", 12 ); }; +like( $@, '/^Number of bits must be multiple of 8/' ); -$ctx->add_bits("abc", 16); -is($ctx->digest, "a0002"); +$ctx->add_bits( "abc", 16 ); +is( $ctx->digest, "a0002" ); -$ctx->add_bits("abc", 32); -is($ctx->digest, "a0003"); +$ctx->add_bits( "abc", 32 ); +is( $ctx->digest, "a0003" ); diff --git a/t/digest.t b/t/digest.t index 8126027..0f5dfe4 100644 --- a/t/digest.t +++ b/t/digest.t @@ -1,7 +1,9 @@ #!/usr/bin/env perl use strict; -use Test::More tests => 4; +use warnings; + +use Test::More tests => 5; # To find Digest::Dummy use lib 't/lib'; @@ -17,6 +19,9 @@ is $d->digest, "ooo"; $d = Digest->Dummy; is $d->digest, "ooo"; -$Digest::MMAP{"Dummy-24"} = [["NotThere"], "NotThereEither", ["Digest::Dummy", 24]]; +$Digest::MMAP{"Dummy-24"} = [ ["NotThere"], "NotThereEither", [ "Digest::Dummy", 24 ] ]; $d = Digest->new("Dummy-24"); is $d->digest, "24"; + +# DESTROY should not trigger AUTOLOAD +ok( Digest->can("DESTROY"), "Digest has explicit DESTROY method" ); diff --git a/t/file.t b/t/file.t index 79f32de..b83a563 100644 --- a/t/file.t +++ b/t/file.t @@ -1,51 +1,72 @@ #!perl -w -use Test::More tests => 5; +use strict; +use warnings; + +use Test::More tests => 9; + +use File::Temp 'tempfile'; { - package Digest::Foo; - require Digest::base; - use vars qw(@ISA $VERSION); - @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; - return sprintf "%04d", length($$self); - } + + package Digest::Foo; + $INC{'Digest/Foo.pm'} = "local"; + require Digest::base; + our @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; + return sprintf "%04d", length($$self); + } } -use Digest::file qw(digest_file digest_file_hex digest_file_base64); +use Digest::file qw(digest_file_ctx digest_file digest_file_hex digest_file_base64); -my $file = "test-$$"; -die if -f $file; -open(F, ">$file") || die "Can't create '$file': $!"; -binmode(F); -print F "foo\0\n"; -close(F) || die "Can't write '$file': $!"; +{ + my ( $fh, $file ) = tempfile( UNLINK => 1 ); + binmode($fh); + print $fh "foo\0\n"; + close($fh) || die "Can't write '$file': $!"; + + is( digest_file( $file, "Foo" ), "0005" ); -is(digest_file($file, "Foo"), "0005"); + if ( ord('A') == 193 ) { # EBCDIC. + is( digest_file_hex( $file, "Foo" ), "f0f0f0f5" ); + is( digest_file_base64( $file, "Foo" ), "8PDw9Q" ); + } + else { + is( digest_file_hex( $file, "Foo" ), "30303035" ); + is( digest_file_base64( $file, "Foo" ), "MDAwNQ" ); + } +} + +# digest_file_ctx returns a usable Digest context object +{ + my ( $fh2, $file2 ) = tempfile( UNLINK => 1 ); + binmode($fh2); + print $fh2 "test data"; + close($fh2) || die "Can't write '$file2': $!"; -if (ord('A') == 193) { # EBCDIC. - is(digest_file_hex($file, "Foo"), "f0f0f0f5"); - is(digest_file_base64($file, "Foo"), "8PDw9Q"); -} else { - is(digest_file_hex($file, "Foo"), "30303035"); - is(digest_file_base64($file, "Foo"), "MDAwNQ"); + my $ctx = digest_file_ctx( $file2, "Foo" ); + isa_ok( $ctx, "Digest::Foo", "digest_file_ctx returns correct class" ); + is( $ctx->digest, "0009", "digest_file_ctx feeds file content to context" ); } -unlink($file) || warn "Can't unlink '$file': $!"; +# Error handling +ok !eval { digest_file_ctx( "not-there.txt", "Foo" ) }; +like $@, qr/Can't open/, "digest_file_ctx croaks on missing file"; -ok !eval { digest_file("not-there.txt", "Foo") }; +ok !eval { digest_file( "not-there.txt", "Foo" ) }; ok $@; diff --git a/t/lib/Digest/Dummy.pm b/t/lib/Digest/Dummy.pm index b3db0db..018e12c 100644 --- a/t/lib/Digest/Dummy.pm +++ b/t/lib/Digest/Dummy.pm @@ -1,19 +1,20 @@ package Digest::Dummy; use strict; -use vars qw($VERSION @ISA); -$VERSION = 1; +use warnings; + +our $VERSION = 1; +our @ISA = qw(Digest::base); require Digest::base; -@ISA = qw(Digest::base); sub new { my $class = shift; - my $d = shift || "ooo"; + my $d = shift || "ooo"; bless { d => $d }, $class; } -sub add {} +sub add { } sub digest { shift->{d} } 1;