cpan/Digest-SHA/shasum

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