tests/cksum/cksum-base64.pl

   1 #!/usr/bin/perl
   2 # Exercise cksum's --base64 option.
   3
   4 # Copyright (C) 2023-2024 Free Software Foundation, Inc.
   5
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  18
  19 use strict;
  20
  21 (my $program_name = $0) =~ s|.*/||;
  22
  23 # Turn off localization of executable's output.
  24 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  25
  26 # Pairs of hash,degenerate_output, given file name of "f":
  27 my @pairs =
  28   (
  29    ['sysv', "0 0 f"],
  30    ['bsd', "00000     0 f"],
  31    ['crc', "4294967295 0 f"],
  32    ['md5', "1B2M2Y8AsgTpgAmY7PhCfg=="],
  33    ['sha1', "2jmj7l5rSw0yVb/vlWAYkK/YBwk="],
  34    ['sha224', "0UoCjCo6K8lHYQK7KII0xBWisB+CjqYqxbPkLw=="],
  35    ['sha256', "47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU="],
  36    ['sha384', "OLBgp1GsljhM2TJ+sbHjaiH9txEUvgdDTAzHv2P24donTt6/529l+9Ua0vFImLlb"],
  37    ['sha512', "z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg=="],
  38    ['blake2b', "eGoC90IBWQPGxv2FJVLScpEvR0DhWEdhiobiF/cfVBnSXhAxr+5YUxOJZESTTrBLkDpoWxRIt1XVb3Aa/pvizg=="],
  39    ['sm3', "GrIdg1XPoX+OYRlIMegajyK+yMco/vt0ftA161CCqis="],
  40   );
  41
  42 # Return the formatted output for a given hash name/value pair.
  43 # Use the hard-coded "f" as file name.
  44 sub fmt ($$) {
  45   my ($h, $v) = @_;
  46   $h !~ m{^(sysv|bsd|crc)$} and $v = uc($h). " (f) = $v";
  47   # BLAKE2b is inconsistent:
  48   $v =~ s{BLAKE2B}{BLAKE2b};
  49   return "$v"
  50 }
  51
  52 my @Tests =
  53   (
  54    # Ensure that each of the above works with --base64:
  55    (map {my ($h,$v)= @$_; my $o=fmt $h,$v;
  56          [$h, "--base64 -a $h", {IN=>{f=>''}}, {OUT=>"$o\n"}]} @pairs),
  57
  58    # For each that accepts --check, ensure that works with base64 digests:
  59    (map {my ($h,$v)= @$_; my $o=fmt $h,$v;
  60          ["chk-".$h, "--check --strict", {IN=>$o},
  61           {AUX=>{f=>''}}, {OUT=>"f: OK\n"}]}
  62       grep { $_->[0] !~ m{^(sysv|bsd|crc)$} } @pairs),
  63
  64    # For digests ending in "=", ensure --check fails if any "=" is removed.
  65    (map {my ($h,$v)= @$_; my $o=fmt $h,$v;
  66          ["chk-eq1-".$h, "--check", {IN=>$o}, {AUX=>{f=>''}},
  67           {ERR_SUBST=>"s/.*: //"}, {OUT=>''}, {EXIT=>1},
  68           {ERR=>"no properly formatted checksum lines found\n"}]}
  69       ( map {my ($h,$v)=@$_; $v =~ s/=$//; [$h,$v] }
  70         grep { $_->[1] =~ m{=$} } @pairs)),
  71
  72    # Same as above, but for those ending in "==":
  73    (map {my ($h,$v)= @$_; my $o=fmt $h,$v;
  74          ["chk-eq2-".$h, "--check", {IN=>$o}, {AUX=>{f=>''}},
  75           {ERR_SUBST=>"s/.*: //"}, {OUT=>''}, {EXIT=>1},
  76           {ERR=>"no properly formatted checksum lines found\n"}]}
  77       ( map {my ($h,$v)=@$_; $v =~ s/==$//; [$h,$v] }
  78         grep { $_->[1] =~ m{==$} } @pairs)),
  79
  80    # Trigger a read-buffer-overrun error in an early (not committed)
  81    # version of the --base64-adding patch.
  82    ['nul', '-a sha1 --check', {IN=>'\0\0\0'},
  83     {ERR=>"no properly formatted checksum lines found\n"},
  84     {ERR_SUBST=>"s/.*: //"}, {OUT=>''}, {EXIT=>1}],
  85   );
  86
  87 my $save_temps = $ENV{DEBUG};
  88 my $verbose = $ENV{VERBOSE};
  89
  90 my $prog = 'cksum';
  91 my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
  92
  93 # Ensure hash names from cksum --help match those in @pairs above.
  94 my $help_algs = join ' ', map { m{^  ([[:alpha:]]\S+)} }
  95   grep { m{^  ([[:alpha:]]\S+)} } split ('\n', `cksum --help`);
  96 my $test_algs = join ' ', map {$_->[0]} @pairs;
  97 $help_algs eq $test_algs or die "$help_algs not equal to\n$test_algs";
  98
  99 exit $fail;