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