This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Digest-SHA to CPAN version 5.97
[perl5.git] / cpan / Digest-SHA / shasum
1 #!perl
2
3         ## shasum: filter for computing SHA digests (ref. sha1sum/md5sum)
4         ##
5         ## Copyright (C) 2003-2017 Mark Shelor, All Rights Reserved
6         ##
7         ## Version: 5.97
8         ## Wed Sep  6 02:23:02 MST 2017
9
10         ## shasum SYNOPSIS adapted from GNU Coreutils sha1sum. Add
11         ## "-a" option for algorithm selection,
12         ## "-U" option for Universal Newlines support,
13         ## "-0" option for reading bit strings, and
14         ## "-p" option for portable digests (to be deprecated).
15
16 BEGIN { pop @INC if $INC[-1] eq '.' }
17
18 use strict;
19 use warnings;
20 use Fcntl;
21 use Getopt::Long;
22
23 my $POD = <<'END_OF_POD';
24
25 =head1 NAME
26
27 shasum - Print or Check SHA Checksums
28
29 =head1 SYNOPSIS
30
31  Usage: shasum [OPTION]... [FILE]...
32  Print or check SHA checksums.
33  With no FILE, or when FILE is -, read standard input.
34
35    -a, --algorithm   1 (default), 224, 256, 384, 512, 512224, 512256
36    -b, --binary      read in binary mode
37    -c, --check       read SHA sums from the FILEs and check them
38    -t, --text        read in text mode (default)
39    -U, --UNIVERSAL   read in Universal Newlines mode
40                          produces same digest on Windows/Unix/Mac
41    -0, --01          read in BITS mode
42                          ASCII '0' interpreted as 0-bit,
43                          ASCII '1' interpreted as 1-bit,
44                          all other characters ignored
45    -p, --portable    read in portable mode (to be deprecated)
46
47  The following three options are useful only when verifying checksums:
48    -s, --status      don't output anything, status code shows success
49    -q, --quiet       don't print OK for each successfully verified file
50    -w, --warn        warn about improperly formatted checksum lines
51
52    -h, --help        display this help and exit
53    -v, --version     output version information and exit
54
55  When verifying SHA-512/224 or SHA-512/256 checksums, indicate the
56  algorithm explicitly using the -a option, e.g.
57
58    shasum -a 512224 -c checksumfile
59
60  The sums are computed as described in FIPS PUB 180-4.  When checking,
61  the input should be a former output of this program.  The default
62  mode is to print a line with checksum, a character indicating type
63  (`*' for binary, ` ' for text, `U' for UNIVERSAL, `^' for BITS, `?'
64  for portable), and name for each FILE.  The line starts with a `\'
65  character if the FILE name contains either newlines or backslashes,
66  which are then replaced by the two-character sequences `\n' and `\\'
67  respectively.
68
69  Report shasum bugs to mshelor@cpan.org
70
71 =head1 DESCRIPTION
72
73 Running I<shasum> is often the quickest way to compute SHA message
74 digests.  The user simply feeds data to the script through files or
75 standard input, and then collects the results from standard output.
76
77 The following command shows how to compute digests for typical inputs
78 such as the NIST test vector "abc":
79
80         perl -e "print qq(abc)" | shasum
81
82 Or, if you want to use SHA-256 instead of the default SHA-1, simply say:
83
84         perl -e "print qq(abc)" | shasum -a 256
85
86 Since I<shasum> mimics the behavior of the combined GNU I<sha1sum>,
87 I<sha224sum>, I<sha256sum>, I<sha384sum>, and I<sha512sum> programs,
88 you can install this script as a convenient drop-in replacement.
89
90 Unlike the GNU programs, I<shasum> encompasses the full SHA standard by
91 allowing partial-byte inputs.  This is accomplished through the BITS
92 option (I<-0>).  The following example computes the SHA-224 digest of
93 the 7-bit message I<0001100>:
94
95         perl -e "print qq(0001100)" | shasum -0 -a 224
96
97 =head1 AUTHOR
98
99 Copyright (c) 2003-2017 Mark Shelor <mshelor@cpan.org>.
100
101 =head1 SEE ALSO
102
103 I<shasum> is implemented using the Perl module L<Digest::SHA> or
104 L<Digest::SHA::PurePerl>.
105
106 =cut
107
108 END_OF_POD
109
110 my $VERSION = "5.97";
111
112 sub usage {
113         my($err, $msg) = @_;
114
115         $msg = "" unless defined $msg;
116         if ($err) {
117                 warn($msg . "Type shasum -h for help\n");
118                 exit($err);
119         }
120         my($USAGE) = $POD =~ /SYNOPSIS(.+?)^=/sm;
121         $USAGE =~ s/^\s*//;
122         $USAGE =~ s/\s*$//;
123         $USAGE =~ s/^ //gm;
124         print $USAGE, "\n";
125         exit($err);
126 }
127
128
129         ## Sync stdout and stderr by forcing a flush after every write
130
131 select((select(STDOUT), $| = 1)[0]);
132 select((select(STDERR), $| = 1)[0]);
133
134
135         ## Collect options from command line
136
137 my ($alg, $binary, $check, $text, $status, $quiet, $warn, $help, $version);
138 my ($portable, $BITS, $reverse, $UNIVERSAL, $versions);
139
140 eval { Getopt::Long::Configure ("bundling") };
141 GetOptions(
142         'b|binary' => \$binary, 'c|check' => \$check,
143         't|text' => \$text, 'a|algorithm=i' => \$alg,
144         's|status' => \$status, 'w|warn' => \$warn,
145         'q|quiet' => \$quiet,
146         'h|help' => \$help, 'v|version' => \$version,
147         'p|portable' => \$portable,
148         '0|01' => \$BITS,
149         'R|REVERSE' => \$reverse,
150         'U|UNIVERSAL' => \$UNIVERSAL,
151         'V|VERSIONS' => \$versions,
152 ) or usage(1, "");
153
154
155         ## Deal with help requests and incorrect uses
156
157 usage(0)
158         if $help;
159 usage(1, "shasum: Ambiguous file mode\n")
160         if scalar(grep {defined $_}
161                 ($binary, $portable, $text, $BITS, $UNIVERSAL)) > 1;
162 usage(1, "shasum: --warn option used only when verifying checksums\n")
163         if $warn && !$check;
164 usage(1, "shasum: --status option used only when verifying checksums\n")
165         if $status && !$check;
166 usage(1, "shasum: --quiet option used only when verifying checksums\n")
167         if $quiet && !$check;
168
169
170         ## Try to use Digest::SHA.  If not installed, use the slower
171         ## but functionally equivalent Digest::SHA::PurePerl instead.
172
173         ## If option -R is invoked, reverse the module preference,
174         ## i.e. try Digest::SHA::PurePerl first, then Digest::SHA.
175
176 my @MODS = qw(Digest::SHA Digest::SHA::PurePerl);
177 @MODS[0, 1] = @MODS[1, 0] if $reverse;
178
179 my $module;
180 for (@MODS) {
181         my $mod = $_;
182         if (eval "require $mod") {
183                 $module = $mod;
184                 last;
185         }
186 }
187 die "shasum: Unable to find " . join(" or ", @MODS) . "\n"
188         unless defined $module;
189
190
191         ## Default to SHA-1 unless overridden by command line option
192
193 $alg = 1 unless defined $alg;
194 grep { $_ == $alg } (1, 224, 256, 384, 512, 512224, 512256)
195         or usage(1, "shasum: Unrecognized algorithm\n");
196
197
198         ## Display version information if requested
199
200 if ($version) {
201         print "$VERSION\n";
202         exit(0);
203 }
204
205 if ($versions) {
206         print "shasum $VERSION\n";
207         print "$module ", eval "\$${module}::VERSION", "\n";
208         print "perl ", defined $^V ? sprintf("%vd", $^V) : $], "\n";
209         exit(0);
210 }
211
212
213         ## Try to figure out if the OS is DOS-like.  If it is,
214         ## default to binary mode when reading files, unless
215         ## explicitly overridden by command line "--text" or
216         ## "--UNIVERSAL" or "--portable" options.
217
218 my $isDOSish = ($^O =~ /^(MSWin\d\d|os2|dos|mint|cygwin)$/);
219 if ($isDOSish) { $binary = 1 unless $text || $UNIVERSAL || $portable }
220
221 my $modesym = $binary ? '*' : ($UNIVERSAL ? 'U' :
222                 ($BITS ? '^' : ($portable ? '?' : ' ')));
223
224
225         ## Read from STDIN (-) if no files listed on command line
226
227 @ARGV = ("-") unless @ARGV;
228
229
230         ## sumfile($file): computes SHA digest of $file
231
232 sub sumfile {
233         my $file = shift;
234
235         my $mode = $binary ? 'b' : ($UNIVERSAL ? 'U' :
236                         ($BITS ? '0' : ($portable ? 'p' : '')));
237         my $digest = eval { $module->new($alg)->addfile($file, $mode) };
238         if ($@) { warn "shasum: $file: $!\n"; return }
239         $digest->hexdigest;
240 }
241
242
243         ## %len2alg: maps hex digest length to SHA algorithm
244
245 my %len2alg = (40 => 1, 56 => 224, 64 => 256, 96 => 384, 128 => 512);
246 $len2alg{56} = 512224 if $alg == 512224;
247 $len2alg{64} = 512256 if $alg == 512256;
248
249
250         ## unescape: convert backslashed filename to plain filename
251
252 sub unescape {
253         $_ = shift;
254         s/\\\\/\0/g;
255         s/\\n/\n/g;
256         return if /\\/;
257         s/\0/\\/g;
258         return $_;
259 }
260
261
262         ## verify: confirm the digest values in a checksum file
263
264 sub verify {
265         my $checkfile = shift;
266         my ($err, $fmt_errs, $read_errs, $match_errs) = (0, 0, 0, 0);
267         my ($num_lines, $num_files) = (0, 0);
268         my ($bslash, $sum, $fname, $rsp, $digest, $isOK);
269
270         local *FH;
271         $checkfile eq '-' and open(FH, '< -')
272                 and $checkfile = 'standard input'
273         or sysopen(FH, $checkfile, O_RDONLY)
274                 or die "shasum: $checkfile: $!\n";
275         while (<FH>) {
276                 next if /^#/; s/\n$//; s/^[ \t]+//; $num_lines++;
277                 $bslash = s/^\\//;
278                 ($sum, $modesym, $fname) =
279                         /^([\da-fA-F]+)[ \t]([ *?^U])([^\0]*)/;
280                 $alg = defined $sum ? $len2alg{length($sum)} : undef;
281                 $fname = unescape($fname) if defined $fname && $bslash;
282                 if (grep { ! defined $_ } ($alg, $sum, $modesym, $fname)) {
283                         $alg = 1 unless defined $alg;
284                         warn("shasum: $checkfile: $.: improperly " .
285                                 "formatted SHA$alg checksum line\n") if $warn;
286                         $fmt_errs++;
287                         next;
288                 }
289                 $fname =~ s/\r$// unless -e $fname;
290                 $rsp = "$fname: "; $num_files++;
291                 ($binary, $text, $UNIVERSAL, $BITS, $portable) =
292                         map { $_ eq $modesym } ('*', ' ', 'U', '^', 'p');
293                 $isOK = 0;
294                 unless ($digest = sumfile($fname)) {
295                         $rsp .= "FAILED open or read\n";
296                         $err = 1; $read_errs++;
297                 }
298                 else {
299                         if (lc($sum) eq $digest) { $rsp .= "OK\n"; $isOK = 1 }
300                         else { $rsp .= "FAILED\n"; $err = 1; $match_errs++ }
301                 }
302                 print $rsp unless ($status || ($quiet && $isOK));
303         }
304         close(FH);
305         unless ($num_files) {
306                 $alg = 1 unless defined $alg;
307                 warn("shasum: $checkfile: no properly formatted " .
308                         "SHA$alg checksum lines found\n");
309                 $err = 1;
310         }
311         elsif (! $status) {
312                 warn("shasum: WARNING: $fmt_errs line" . ($fmt_errs>1?
313                 's are':' is') . " improperly formatted\n") if $fmt_errs;
314                 warn("shasum: WARNING: $read_errs listed file" .
315                 ($read_errs>1?'s':'') . " could not be read\n") if $read_errs;
316                 warn("shasum: WARNING: $match_errs computed checksum" .
317                 ($match_errs>1?'s':'') . " did NOT match\n") if $match_errs;
318         }
319         return($err == 0);
320 }
321
322
323         ## Verify or compute SHA checksums of requested files
324
325 my($file, $digest);
326
327 my $STATUS = 0;
328 for $file (@ARGV) {
329         if ($check) { $STATUS = 1 unless verify($file) }
330         elsif ($digest = sumfile($file)) {
331                 if ($file =~ /[\n\\]/) {
332                         $file =~ s/\\/\\\\/g; $file =~ s/\n/\\n/g;
333                         $digest = "\\$digest";
334                 }
335                 print "$digest $modesym", "$file\n";
336         }
337         else { $STATUS = 1 }
338 }
339 exit($STATUS)