| 1 | BEGIN { |
| 2 | if ($ENV{PERL_CORE}) { |
| 3 | chdir 't' if -d 't'; |
| 4 | @INC = '../lib'; |
| 5 | } |
| 6 | } |
| 7 | |
| 8 | print "1..5\n"; |
| 9 | |
| 10 | use strict; |
| 11 | use Digest::MD5 qw(md5 md5_hex md5_base64); |
| 12 | |
| 13 | # To update the EBCDIC section even on a Latin 1 platform, |
| 14 | # run this script with $ENV{EBCDIC_MD5SUM} set to a true value. |
| 15 | # (You'll need to have Perl 5.7.3 or later, to have the Encode installed.) |
| 16 | # (And remember that under the Perl core distribution you should |
| 17 | # also have the $ENV{PERL_CORE} set to a true value.) |
| 18 | # Similarly, to update MacOS section, run with $ENV{MAC_MD5SUM} set. |
| 19 | |
| 20 | my $EXPECT; |
| 21 | if (ord "A" == 193) { # EBCDIC |
| 22 | $EXPECT = <<EOT; |
| 23 | fcc48d6bb88ca8065bf9ddfcb9e7483e Changes |
| 24 | 0565ec21b15c0f23f4c51fb327c8926d README |
| 25 | 1965beb0e48253b694220fbb5d6230f5 MD5.pm |
| 26 | 5b3c24da3f70f3c0938cc7c205a28ab7 MD5.xs |
| 27 | 276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt |
| 28 | EOT |
| 29 | } elsif ("\n" eq "\015") { # MacOS |
| 30 | $EXPECT = <<EOT; |
| 31 | f161f474603c54a0093ad2f6f93be33b Changes |
| 32 | 6c950a0211a5a28f023bb482037698cd README |
| 33 | 18178c90bc13d6824f6c96973b6e9433 MD5.pm |
| 34 | 2c7fdb2ffa3840dc4f8dcdcf13241015 MD5.xs |
| 35 | 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt |
| 36 | EOT |
| 37 | } else { |
| 38 | # This is the output of: 'md5sum Changes README MD5.pm MD5.xs rfc1321.txt' |
| 39 | $EXPECT = <<EOT; |
| 40 | 029fa5059ba0b2175cee09ab5d9b7b73 Changes |
| 41 | 6c950a0211a5a28f023bb482037698cd README |
| 42 | 18178c90bc13d6824f6c96973b6e9433 MD5.pm |
| 43 | 2c7fdb2ffa3840dc4f8dcdcf13241015 MD5.xs |
| 44 | 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt |
| 45 | EOT |
| 46 | } |
| 47 | |
| 48 | if (!(-f "README") && -f "../README") { |
| 49 | chdir("..") or die "Can't chdir: $!"; |
| 50 | } |
| 51 | |
| 52 | my $testno = 0; |
| 53 | |
| 54 | my $B64 = 1; |
| 55 | eval { require MIME::Base64; }; |
| 56 | if ($@) { |
| 57 | print "# $@: Will not test base64 methods\n"; |
| 58 | $B64 = 0; |
| 59 | } |
| 60 | |
| 61 | for (split /^/, $EXPECT) { |
| 62 | my($md5hex, $file) = split ' '; |
| 63 | my $base = $file; |
| 64 | # print "# $base\n"; |
| 65 | if ($ENV{PERL_CORE}) { |
| 66 | if ($file eq 'rfc1321.txt') { # Don't have it in core. |
| 67 | print "ok ", ++$testno, " # Skip: PERL_CORE\n"; |
| 68 | next; |
| 69 | } |
| 70 | use File::Spec; |
| 71 | my @path = qw(ext Digest MD5); |
| 72 | my $path = File::Spec->updir; |
| 73 | while (@path) { |
| 74 | $path = File::Spec->catdir($path, shift @path); |
| 75 | } |
| 76 | $file = File::Spec->catfile($path, $file); |
| 77 | } |
| 78 | # print "# file = $file\n"; |
| 79 | unless (-f $file) { |
| 80 | warn "No such file: $file\n"; |
| 81 | next; |
| 82 | } |
| 83 | if ($ENV{EBCDIC_MD5SUM}) { |
| 84 | require Encode; |
| 85 | my $data = cat_file($file); |
| 86 | Encode::from_to($data, 'latin1', 'cp1047'); |
| 87 | print md5_hex($data), " $base\n"; |
| 88 | next; |
| 89 | } |
| 90 | if ($ENV{MAC_MD5SUM}) { |
| 91 | require Encode; |
| 92 | my $data = cat_file($file); |
| 93 | Encode::from_to($data, 'latin1', 'MacRoman'); |
| 94 | print md5_hex($data), " $base\n"; |
| 95 | next; |
| 96 | } |
| 97 | my $md5bin = pack("H*", $md5hex); |
| 98 | my $md5b64; |
| 99 | if ($B64) { |
| 100 | $md5b64 = MIME::Base64::encode($md5bin, ""); |
| 101 | chop($md5b64); chop($md5b64); # remove padding |
| 102 | } |
| 103 | my $failed; |
| 104 | my $got; |
| 105 | |
| 106 | if (digest_file($file, 'digest') ne $md5bin) { |
| 107 | print "$file: Bad digest\n"; |
| 108 | $failed++; |
| 109 | } |
| 110 | |
| 111 | if (($got = digest_file($file, 'hexdigest')) ne $md5hex) { |
| 112 | print "$file: Bad hexdigest: got $got expected $md5hex\n"; |
| 113 | $failed++; |
| 114 | } |
| 115 | |
| 116 | if ($B64 && digest_file($file, 'b64digest') ne $md5b64) { |
| 117 | print "$file: Bad b64digest\n"; |
| 118 | $failed++; |
| 119 | } |
| 120 | |
| 121 | my $data = cat_file($file); |
| 122 | if (md5($data) ne $md5bin) { |
| 123 | print "$file: md5() failed\n"; |
| 124 | $failed++; |
| 125 | } |
| 126 | if (md5_hex($data) ne $md5hex) { |
| 127 | print "$file: md5_hex() failed\n"; |
| 128 | $failed++; |
| 129 | } |
| 130 | if ($B64 && md5_base64($data) ne $md5b64) { |
| 131 | print "$file: md5_base64() failed\n"; |
| 132 | $failed++; |
| 133 | } |
| 134 | |
| 135 | if (Digest::MD5->new->add($data)->digest ne $md5bin) { |
| 136 | print "$file: MD5->new->add(...)->digest failed\n"; |
| 137 | $failed++; |
| 138 | } |
| 139 | if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) { |
| 140 | print "$file: MD5->new->add(...)->hexdigest failed\n"; |
| 141 | $failed++; |
| 142 | } |
| 143 | if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) { |
| 144 | print "$file: MD5->new->add(...)->b64digest failed\n"; |
| 145 | $failed++; |
| 146 | } |
| 147 | |
| 148 | my @data = split //, $data; |
| 149 | if (md5(@data) ne $md5bin) { |
| 150 | print "$file: md5(\@data) failed\n"; |
| 151 | $failed++; |
| 152 | } |
| 153 | if (Digest::MD5->new->add(@data)->digest ne $md5bin) { |
| 154 | print "$file: MD5->new->add(\@data)->digest failed\n"; |
| 155 | $failed++; |
| 156 | } |
| 157 | my $md5 = Digest::MD5->new; |
| 158 | for (@data) { |
| 159 | $md5->add($_); |
| 160 | } |
| 161 | if ($md5->digest ne $md5bin) { |
| 162 | print "$file: $md5->add()-loop failed\n"; |
| 163 | $failed++; |
| 164 | } |
| 165 | |
| 166 | print "not " if $failed; |
| 167 | print "ok ", ++$testno, "\n"; |
| 168 | } |
| 169 | |
| 170 | |
| 171 | sub digest_file |
| 172 | { |
| 173 | my($file, $method) = @_; |
| 174 | $method ||= "digest"; |
| 175 | #print "$file $method\n"; |
| 176 | |
| 177 | open(FILE, $file) or die "Can't open $file: $!"; |
| 178 | my $digest = Digest::MD5->new->addfile(*FILE)->$method(); |
| 179 | close(FILE); |
| 180 | |
| 181 | $digest; |
| 182 | } |
| 183 | |
| 184 | sub cat_file |
| 185 | { |
| 186 | my($file) = @_; |
| 187 | local $/; # slurp |
| 188 | open(FILE, $file) or die "Can't open $file: $!"; |
| 189 | |
| 190 | # For PerlIO in case of UTF-8 locales. |
| 191 | eval 'binmode(FILE, ":bytes")' if $] >= 5.008; |
| 192 | |
| 193 | my $tmp = <FILE>; |
| 194 | close(FILE); |
| 195 | $tmp; |
| 196 | } |
| 197 | |