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