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