#!/usr/bin/perl -w

use strict;
use Digest::MD5;
use Digest::SHA1;
use Digest::SHA2;
use Digest::Haval256;
use Digest::Whirlpool;
use Digest::BubbleBabble qw(bubblebabble);

use IO::File;

use Getopt::Std;

our ($opt_a, $opt_b, $opt_h, $opt_l, $opt_m, $opt_q, $opt_w, %g_hnd, $g_sbs, $ver, $max_algonum);

getopts('a:bhilm:qw');

$ver = "0.4";

$max_algonum = 7;

# Adding a new hash function
# 1) add a use statement
# 2) create a handler
# 3) update the list_algorithms subroutine
# 4) increment $max_algonum
# 5) update SWITCH block in process_args
# 6) update ALGORITHMS section of pod documention

# md5 hash function handler
$g_hnd{"md5"} = sub ()
{

    my $fh = $_[0];
    my $dgst = () ;
    $dgst = Digest::MD5->new;

    return(&hcore($fh, $dgst));
};

# sha1 hash function handler
$g_hnd{"sha1"} = sub ()
{

    my $fh = $_[0];
    my $dgst = () ;
    $dgst = Digest::SHA1->new;

    return(&hcore($fh, $dgst));
};

# sha256...512 hash function handler
$g_hnd{"shaXXX"} = sub ()
{

    my $fh = $_[0];
    my $dgst = () ;
    $dgst = new Digest::SHA2 $g_sbs;

    return(&hcore($fh, $dgst));

};

# haval256 hash function handler
$g_hnd{"haval256"} = sub ()
{

    my $fh = $_[0];
    my $dgst = () ;
    $dgst = new Digest::Haval256;

    return(&hcore($fh, $dgst));

};

# whirlpool hash function handler
$g_hnd{"whirlpool"} = sub ()
{

    my $fh = $_[0];
    my $dgst = () ;
    $dgst = new Digest::Whirlpool;

    return(&hcore($fh, $dgst));

};

sub hcore()
{
    my $val = ();

    my ($fh, $dgst) = @_;

    $dgst->addfile($fh);

    # m -> h(m) -- assurance level low, least conservative
    $val = $dgst->hexdigest;

    # m -> h(h(m)) -- assurance level medium, semi conservative
    if ($opt_m == 2)
    {
	$val = pack("H*", $val);
	$dgst->reset;
	$dgst->add($val);
    }
    # m -> h(h(m)||m) -- assurance level high, most conservative
    elsif ($opt_m == 3)
    {
	$val = pack("H*", $val);
	seek($fh,0,0);
	$dgst->reset;
	$dgst->add($val);
	$dgst->addfile($fh);
    }

    ($opt_m == 1) ? return($val) : return ($dgst->hexdigest);
}

sub dgst_to_words()
{
    my $dgst = $_[0];

    my ($wdgst, $t, @d, $achr, $w, $pad, $dl) = ();

    my @syl2_words = qw(
	aardvark absurd accrue acme adrift adult afflict ahead
	aimless Algol allow alone ammo ancient apple artist
	assume Athens atlas Aztec baboon backfield backward banjo
	beaming bedlamp beehive beeswax befriend Belfast berserk billiard
	bison blackjack blockade blowtorch bluebird bombast bookshelf brackish
	breadline breakup brickyard briefcase Burbank button buzzard cement
	chairlift chatter checkup chisel choking chopper Christmas clamshell classic
	classroom cleanup clockwork cobra commence concert cowbell crackdown
	cranky crowfoot crucial crumpled crusade cubic dashboard deadbolt
	deckhand dogsled dragnet drainage dreadful drifter dropper drumbeat
	drunken Dupont dwelling eating edict egghead eightball endorse
	endow enlist erase escape exceed eyeglass eyetooth facial
	fallout flagpole flatfoot flytrap fracture framework freedom frighten
	gazelle Geiger glitter glucose goggles goldfish gremlin guidance
	hamlet highchair hockey indoors indulge inverse involve island
	jawbone keyboard kickoff kiwi klaxon locale lockup merit
	minnow miser Mohawk mural music necklace Neptune newborn
	nightbird Oakland obtuse offload optic orca payday peachy
	pheasant physique playhouse Pluto preclude prefer preshrunk printer
	prowler pupil puppy python quadrant quiver quota ragtime
	ratchet rebirth reform regain reindeer rematch repay retouch
	revenge reward rhythm ribcage ringbolt robust rocker ruffled
	sailboat sawdust scallion scenic scorecard Scotland seabird select
	sentence shadow shamrock showgirl skullcap skydive slingshot slowdown
	snapline snapshot snowcap snowslide solo southward soybean spaniel
	spearhead spellbind spheroid spigot spindle spyglass stagehand stagnate
	stairway standard stapler steamship sterling stockman stopwatch stormy
	sugar surmount suspense sweatband swelter tactics talon tapeworm
	tempest tiger tissue tonic topmost tracker transit trauma
	treadmill Trojan trouble tumor tunnel tycoon uncut unearth
	unwind uproot upset upshot vapor village virus Vulcan
	waffle wallet watchword wayside willow woodlark Zulu
	);

    my @syl3_words = qw(
	adroitness adviser aftermath aggregate alkali almighty amulet amusement
	antenna applicant Apollo armistice article asteroid Atlantic atmosphere
	autopsy Babylon backwater barbecue belowground bifocals bodyguard bookseller
	borderline bottomless Bradbury bravado Brazilian breakaway Burlington businessman
	butterfat Camelot candidate cannonball Capricorn caravan caretaker celebrate
	cellulose certify chambermaid Cherokee Chicago clergyman coherence combustion
	commando company component concurrent confidence conformist congregate consensus
	consulting corporate corrosion councilman crossover crucifix cumbersome customer
	Dakota decadence December decimal designing detector detergent determine
	dictator dinosaur direction disable disbelief disruptive distortion document
	embezzle enchanting enrollment enterprise equation equipment escapade Eskimo
	everyday examine existence exodus fascinate filament finicky forever
	fortitude frequency gadgetry Galveston getaway glossary gossamer graduate
	gravity guitarist hamburger Hamilton handiwork hazardous headwaters hemisphere
	hesitate hideaway holiness hurricane hydraulic impartial impetus inception
	indigo inertia infancy inferno informant insincere insurgent integrate
	intention inventive Istanbul Jamaica Jupiter leprosy letterhead liberty
	maritime matchmaker maverick Medusa megaton microscope microwave midsummer
	millionaire miracle misnomer molasses molecule Montana monument mosquito
	narrative nebula newsletter Norwegian October Ohio onlooker opulent
	Orlando outfielder Pacific pandemic Pandora paperweight paragon paragraph
	paramount passenger pedigree Pegasus penetrate perceptive performance pharmacy
	phonetic photograph pioneer pocketful politeness positive potato processor
	provincial proximate puberty publisher pyramid quantity racketeer rebellion
	recipe recover repellent replica reproduce resistor responsive retraction
	retrieval retrospect revenue revival revolver sandalwood sardonic Saturday
	savagery scavenger sensation sociable souvenir specialist speculate stethoscope
	stupendous supportive surrender suspicious sympathy tambourine telephone therapist
	tobacco tolerance tomorrow torpedo tradition travesty trombonist truncated
	typewriter ultimate undaunted underfoot unicorn unify universe unravel
	upcoming vacancy vagabond vertigo Virginia visitor vocalist voyager
	warranty Waterloo whimsical Wichita Wilmington Wyoming yesteryear Yucatan
	);

    $dgst =~ s/(\w{2})+?/$1 /g;
    $dgst =~ s/\s$//g;

    @d = split(/\s/, $dgst);

    while ($#d >= 0)
    {
	$dl = $#d;
	if ($dl % 2 == 0)
	{
	    # get the first element of @d and use its
	    # decimal representation to look up the correct
	    # word in the 3 syl array
	    $w = $syl3_words[hex(shift(@d))];

	    if ($dl % 4 == 0)
	    {
		$achr = "\n";
	    }
	    else
	    {
		# set the pad value so that spacing comes out correctly
		$pad = 12 - length($w);
		$achr = " " x $pad;
	    }
	    $wdgst .= $w . $achr;
	}
	else
	{
	    # get the first element of @d and use its
	    # decimal representation to look up the correct
	    # word in the 3 syl array
	    $w = $syl2_words[hex(shift(@d))];

	    # set the pad value so that spacing comes out correctly
	    $pad = 12 - length($w);
	    $wdgst .= $w . " " x $pad;
	}
    }

    return $wdgst;
}

sub usage()
{
    print "\n";
    print "usage for psum $ver:\n";
    print "\n";
    print "\t-h\tthis help\n";
    print "\t-a n\trequest algorithm n (default: 3 - sha256)\n";
    print "\t-b\trequest digest output in bubble-babble form\n";
    print "\t-l\tshow supported algorithm list\n";
    print "\t-m n\tassurance level. One of 3 (high), 2 (medium, default) or 1 (low)\n";
    print "\t-q\tdon't output unnecessary messages\n";
    print "\t-w\tprint word digest\n";
    print "\n";
}

sub list_algorithms()
{
    print "\n";
    print "supported algorithms for psum $ver:\n";
    print "\n";
    print "1 - md5\n";
    print "2 - sha1\n";
    print "3 - sha256\n";
    print "4 - sha384\n";
    print "5 - sha512\n";
    print "6 - haval256\n";
    print "7 - whirlpool\n";
    print "\n";
}

sub process_args()
{
    my $ex_ops = 0;

    usage(), return 1 if defined($opt_h);
    list_algorithms(), return 1 if defined($opt_l);

    # if an algorithm isn't requested set it to sha256
    if (!defined($opt_a) || ())
    {
	$opt_a = 3;
    }
    # if an unsupported algorithm is requested, set it to sha256
    elsif ($opt_a < 1 || $opt_a > $max_algonum)
    {
	print "# unsupported algorithm $opt_a requested, setting to the default: 3 - sha256.\n" if (!defined($opt_q));
	$opt_a = 3;
    }

    # if an assurance level isn't specified set to the default 3
    if (!defined($opt_m))
    {
	$opt_m = 2;
    }
    # reject unreasonable assurance levels and set to the default
    elsif($opt_m < 1 || $opt_m > 3)
    {
	print "# unsupported assurance level $opt_m requested. setting to the default: 3 - high.\n" if (!defined($opt_q));
	$opt_m = 2;
    }

    # only print one type of digest at a time
    # default (no switches) is hexdigest
    if ($opt_w && $opt_b)
    {
	print "# -w and -b requested. only printing bubble babble digest.\n";
	$opt_w = 0;
    }

    # change hash ordinals to text equivalents so the correct handler will
    #  be called
    SWITCH:
    {
	$opt_a = "md5", last SWITCH if ($opt_a == 1);
	$opt_a = "sha1", last SWITCH if ($opt_a == 2);
	$opt_a = "shaXXX", $g_sbs = 256, last SWITCH if ($opt_a == 3);
	$opt_a = "shaXXX", $g_sbs = 384, last SWITCH if ($opt_a == 4);
	$opt_a = "shaXXX", $g_sbs = 512, last SWITCH if ($opt_a == 5);
	$opt_a = "haval256", last SWITCH if ($opt_a == 6);
	$opt_a = "whirlpool", last SWITCH if ($opt_a == 7);
	my $nada = 1;
    }

    return 0;
}

# begin "main"
{

    my ($fh, $file, $ret) = ();

    my $rval = 0;

    # usage or level requested if true is returned. exit.
    $rval = 0 if(process_args());

    if (defined($ARGV[0]))
    {
	$file = $ARGV[0];
	$fh = IO::File->new;

	if ($fh->open("<$file"))
	{
	    $ret = $g_hnd{"$opt_a"}($fh);
	    if (defined($ret))
	    {
		
		$opt_a =~ s/XXX$/$g_sbs/ if ($opt_a eq "shaXXX");
		$ret = bubblebabble(Digest => $ret) if ($opt_b);
		if ($opt_w)
		{
		    $ret = &dgst_to_words($ret);
		    print "# $opt_a\n$ret\n\n$file\n";
		}
		else
		{
		    print "# $opt_a\n$ret\t$file\n";
		}
	    }
	    else
	    {
		print "Unknown error, handler $opt_a didn't return a value.\n";
		$rval = 1;
	    }
	}
	else
	{
	    print "Unable to open requested file: $file. Error: $!. Exiting.\n";
	    $rval = 1;
	}
    }
    else
    {
	print "File to open not specified. Exiting.\n";
	$rval = 1;
    }

    exit $rval;

}
# end "main"

__END__;

=head1 NAME

    sechash - secure hash generator

=head1 SYNOPSIS

    sechash [OPTIONS] filename

=head1 DESCRIPTION

    sechash computes the hash of a file. sechash supports several
    hash algorithms and has implemented three assurance levels.
    The lowest level hashes hashing the file once: m->h(m). This
    is the same computation that tools such as md5sum and shash make.
    The middle level hashes the hash of the file: m->h(h(m)). The high
    level hashes the file once and then hashes the concatenation of
    the file onto the hash of the file: m->(h(m)||m).

    Why go to all this trouble when tools such as md5sum and
    shash already compute hash functions?

    In chapter 6 of Ferguson's and Schneier's book, Practical
    Cryptography (ISBN: 0-471-22357-3), it is posited that hash
    functions, as they are currently used, are not robust against
    partial message collision attacks and length extension attacks.
    Ferguson and Schneier suggest that the most conservative
    mitigation to such attacks is to use the function m->(h(m)||m).
    They suggest that the most reasonable compromise between speed
    and security is to used the function m->(h(h(m)) with SHA256.
    sechash chooses to follow this advice and sets its defaults to
    SHA256 and a medium assurance level.

    The following options are available:

    -h		help

    -a		request algorithm n (default: 3 - sha256)

    -b		print bubble babble digest instead of hex digest

    -l		show supported algorithm list

    -m n	assurance level. One of 3 (high), 2 (medium, default)
                or 1 (low)

    -q		output as little as possible

    -w		print word digest

    The following hash function algorithms are supported:

    MD5		- 1
    SHA1	- 2
    SHA256	- 3
    SHA384	- 4
    SHA512	- 5
    HAVAL256	- 6
    Whirlpool	- 7

=head1 AUTHOR

    sechash was written by Holt Sorenson, hso at nosneros dot net

=head1 BUGS

    send me email and they'll be squashed. I prefer diff -u format.

=head1 DEPENDENCIES

    sechash requires the following modules, easily fetchable from
    CPAN (http://www.cpan.org/):

    Digest::MD5
    Digest::SHA1
    Digest::SHA2
    Digest::Haval256
    Digest::Whirlpool
    Digest::BubbleBabble

    For more information on CPAN, type 'perldoc CPAN' from a
    shell prompt.

=head1 SEE ALSO

    Linux (http://www.linux.org/):
    md5sum(1)

    OpenBSD (http://www.openbsd.org/):
    md5(1), rmd160(1), sha1(1)

    *nix:
    md5sum, shash(1), openssl(1)

    MD5:
    http://www.ietf.org/rfc/rfc1321.txt

    SHA1:
    http://www.itl.nist.gov/fipspubs/fip180-1.htm

    SHA256...512:
    http://csrc.nist.gov/encryption/shs/sha256-384-512.pdf

    HAVAL256:
    http://citeseer.nj.nec.com/zheng93haval.html

    Whirlpool:
    http://planeta.terra.com.br/informatica/paulobarreto/WhirlpoolPage.html

    Practical Cryptography:
    http://www.amazon.com/exec/obidos/ASIN/0471223573/nosnerosweb-20
    http://www.macfergus.com/pc/
    http://www.schneier.com/book-practical.html

    md5sum:
    http://www.gnu.org/directory/GNU/textutils.html

    shash:
    http://mcrypt.hellug.gr/shash/

    libmhash (shash links against this library):
    http://mhash.sourceforge.net/

    pgpfone "biometric" word lists:
    http://web.mit.edu/network/pgpfone/manual/#PGP000062
    http://www.mathcs.duq.edu/~juola/papers.d/pgpfonenemlap.ps
    http://www.mathcs.duq.edu/~juola/papers.d/icslp96.pdf

=head1 CHANGES

    0.4
	- added support for HAVAL256, Whirlpool and Tiger
	- $opt_b (-b) becomes bubble babble digest (used to be shaxxx bitsize)
	- added (-w) for word digest based on pgp word digest
	- bitsize can no longer be specified for sha1
	- bitsize for shaxxx is now set based on algorithm requested
	- documentation updates

    0.3
	- documentation and comments added

    0.2
	- rewrite

    0.1
	- proof-of-concept

=head1 TODO

    - Add support for RIPEMD160
      (http://www.esat.kuleuven.ac.be/~bosselae/ripemd160.html)
    - Add support for TIGER
      (http://www.cs.technion.ac.il/~biham/Reports/Tiger/)

=head1 COPYRIGHT

    Copyright 2003, Holt Sorenson, hso at nosneros dot net,

    All Rights Reserved.

    This program is licensed under the provisions of the
    Artistic license available at:

    http://www.opensource.org/licenses/artistic-license.php