@rem = '--*-Perl-*-- @set "ErrorLevel=" @if "%OS%" == "Windows_NT" @goto WinNT @perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9 @set ErrorLevel=%ErrorLevel% @goto endofperl :WinNT @perl -x -S %0 %* @set ErrorLevel=%ErrorLevel% @if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" @goto endofperl @if %ErrorLevel% == 9009 @echo You do not have Perl in your PATH. @goto endofperl @rem '; #!/usr/bin/env perl #line 30 use v5.8; use strict; use warnings; use Digest (); use Pod::Usage (); use Getopt::Long (); my $name = 'whirlpoolsum'; my $VERSION = '1.00'; =head1 NAME whirlpoolsum - Print or check WHIRLPOOL checksums =head1 DESCRIPTION Print or check WHIRLPOOL (512-bit) checksums. With no FILE, or when FILE is -, read standard input. =head1 SYNOPSIS whirlpoolsum [OPTION] [FILE]... =head1 OPTIONS =over =item -b, --binary read files in binary mode =item -c, --check read WHIRLPOOL sums from FILEs and check them =item -t, --text read files in text mode (default) =item -s, --status don't output anything, status code shows success =item -h, --help Print a usage message listing all available options =item -v, --version Print the version number, then exit successfully. =back =head1 AUTHOR Evar ArnfjErE Bjarmason =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # # Get command line options # Getopt::Long::Parser->new( config => [ qw< bundling no_ignore_case no_require_order > ], )->getoptions( 'h|help' => \my $help, 'v|version' => \my $version, 'b|binary' => \my $binary, 't|text' => \my $text, 'c|check' => \my $check, 'w|warn' => \my $warn, 's|status' => \my $status, ) or help(); # # Deal with --help, --version and incorrect usage # help( verbose => 1, exitval => 0 ) if $help; help( verbose => 0, exitval => 1 ) if $binary and $text; # Display version if requested version( exitval => 0 ) if $version; # # Set up various stuff # # Determine mode to read in my $modesym = $binary ? '*' : ' '; # read from stdin if no files are given @ARGV = "-" unless @ARGV; # rx: A line in a sum file my $sumfmt = qr/ ^ # WHIRLPOOL sum ([0-9a-f]{128}) # sp [ ] # What mode it was checked in ([* ]) # Filename (.*) $ /x; # # Main loop # unless ( $check ) { my $err = 0; for my $file (@ARGV) { if (my $digest = sumfile($file)) { printf qq<%s %s%s\n>, $digest, $modesym, $file; } else { $err ||= 1; } } exit $err; } else { my $err = 0; my ($num_files, $num_checksums) = (0, 0); # some of this is ripped from shasum(1) for my $sumfile (@ARGV) { my ($read_errs, $match_errs); my ($fh, $rsp); unless ( open my $fh, '<', $sumfile ) { die sprintf qq<%s: %s: %s\n>, $name, $sumfile, $!; } else { while (my $line = <$fh>) { # Just ignore invalid lines next unless $line =~ /$sumfmt/; my ($sum, $modesym, $file) = ($1, $2, $3); ($binary, $text) = map { $_ eq $modesym } ('*', ' '); $rsp = "$file: "; $num_files++; unless (my $digest = sumfile( $file )) { $rsp .= "FAILED open or read\n"; $err ||= 1; $read_errs++; } else { $num_checksums++; if (lc $sum eq $digest) { $rsp .= "OK\n"; } else { $rsp .= "FAILED\n"; $err = 1; $match_errs++; } } print $rsp unless $status; } close $fh; } unless ($status) { warn sprintf qq<%s: WARNING: %d of %d listed files could not be read\n>, $name, $read_errs, $num_files if $read_errs; warn sprintf qq<%s: WARNING: %d of %d computed checksums did NOT match\n>, $name, $match_errs, $num_checksums if $match_errs; } } exit $err; } sub sumfile { my ( $file ) = @_; my $digest; if ( $file eq '-' ) { $digest = Digest->new( 'Whirlpool' )->addfile( *STDIN ); } else { eval { open my $fh, '<', $file; binmode $fh if $binary; $digest = Digest->new( 'Whirlpool' )->addfile( $fh ); }; if ($@) { warn sprintf qq, $file, $!; return; } } $digest->hexdigest; } sub help { my %arg = @_; Pod::Usage::pod2usage( -verbose => $arg{ verbose }, -exitval => $arg{ exitval } || 0, ); } sub version { my %arg = @_; # Spit out the same crap GNU utilities do, for the lack of something better.. printf qq, $VERSION; print "This program is free software; you can redistribute it and/or\n"; print "modify it under the same terms as Perl itself.\n"; print "\n"; print "Written by Ævar Arnfjörð Bjarmason \n"; exit $arg{ exitval } || 0; } __END__ :endofperl @set "ErrorLevel=" & @goto _undefined_label_ 2>NUL || @"%COMSPEC%" /d/c @exit %ErrorLevel%