#!/usr/bin/perl -w
my $cksum = "a83196b844c251398e18045356e4ae7e";
### DO NOT MODIFY BELOW THIS LINE ###

# fingerprint.pl
# Written by Josh Larios <jdlarios@cac.washington.edu>
# Version 1.1 (2001.03.27)
#
# Use --help to get usage information.
#
#
# PGP Words:
# Wordlist and description taken from pages 201-202 of the PGP Freeware for
# MacOS User's Guide Version 7.0, copyright 1990-2001 Network Associates, Inc
#
#
# Bubble Babble:
# Ported from the C source in OpenSSH's key.c
# Copyright (c) 2000 Markus Friedl.  All rights reserved.
#
#   Markus says:
#   As far as I am concerned, the code I have written for this software
#   can be used freely for any purpose.  Any derived versions of this
#   software must be clearly marked as such, and if the derived work is
#   incompatible with the protocol description in the RFC file, it must be
#   called by a name other than "ssh" or "Secure Shell".

use Digest::MD5;
use Digest::SHA1;
use Getopt::Mixed;

# Comment this line out if you don't want a checksum warning.
self_check();

local ($opt_v, $opt_s, $opt_m, $opt_h, $opt_p, $opt_b, $opt_help) = (0, -1, -1, -1, -1, -1, -1);


Getopt::Mixed::getOptions("v s m h p b verbose>v sha1>s md5>m hex>h pgp>p babble>b help");

if ($opt_help == 1) {
    usage();
}

if ($opt_m + $opt_s == 2) {
    my_error("Please choose only one hashing method.");
}

if ($opt_p + $opt_h + $opt_b == -3) {
    $opt_p = 1; $opt_h = 1; $opt_b = 1;
}

my $input = $ARGV[0];

if ($input) {
    if (-e $input) {
        if ($opt_s == 1) {
            if ($opt_v) { print "Using file $input "; }
            $stream = sha1_file($input);
        } elsif ($opt_m == 1) {
            if ($opt_v) { print "Using file $input "; }
            $stream = md5_file($input);
        } else {
            my_error("You must pick one (and only one) of --md5 and --sha1.");
        }
    } else {
        if (length($input) < 40) {
            if ($opt_v) { print "Using \"$input\" "; }
        } else {
            if ($opt_v) { print "Using command-line argument "; }
        }
        $stream = $input;
    }
} else {
    if ($opt_v) { print "Using standard input "; }
    while (<>) {
        $stream .= $_;
    }
}

if ($stream eq "") {
    my_error("You don't really want to checksum _nothing_, do you?");
}

if ($stream =~ m/[^0-9a-f\s\:\-\.]/i) {
    if ($opt_s == 1) {
        $stream = Digest::SHA1->new->add($stream)->hexdigest;
    } elsif ($opt_m == 1) {
        $stream = Digest::MD5->new->add($stream)->hexdigest;
    } else {
        my_error("Please choose a hashing method.");
    }
}

if ($opt_s == 1) {
    if ($opt_v) { print "and SHA1 hashing.\n"; }
} elsif ($opt_m == 1) {
    if ($opt_v) { print "and MD5 hashing.\n"; }
}

$stream =~ s/[\s\:\-\.]//g;
$stream =~ tr/A-F/a-f/;

if ($stream =~ m/[^a-f0-9]/) {
    my_error("Valid characters are 0-9, a-f, :, -, ., and whitespace.");
}

my @tmp = split //, $stream;

if (($#tmp % 2 == 0) || ($stream !~ m/^[a-f0-9]+$/)) {
    my_error("I'm confused. Either you gave me a string of hex numbers with an odd\nnumber of characters, or you gave me a string to hash which consisted only\nof 0-9, a-f, and \":\", \"-\" or \".\". If you want to do that, I'm afraid\nyou'll have to put the string in a file and check the file itself.");
}

for ($i = 0; $i <= $#tmp / 2; $i++) {
    $n = 2 * $i;
    $work[$i] = $tmp[$n] . $tmp[$n + 1];
}

if ($opt_v) {
    if ($opt_h == 1) { print "\nHEX: \n" . hex_print(@work) . "\n"; }
    if ($opt_b == 1) { print "\nBubble Babble:\n" . babble(@work) . "\n"; }
    if ($opt_p == 1) { print "\nPGP Words:\n" . pgp(@work) . "\n"; }
    print "\n";
} else {
    if ($opt_h == 1) { print hex_print(@work) . "\n"; }
    if ($opt_b == 1) { print babble(@work) . "\n"; }
    if ($opt_p == 1) { print pgp(@work) . "\n"; }
}

exit;

sub about {
    print <<EOF;

+ What's this good for?
Let's say you and a friend want to make sure you both have the same file.
Run this program against the file to get a checksum that's easier to read
over the phone than a string of numbers and letters. It's harder to make
mistakes when you're reading pseudo-words (in the case of BubbleBabble) or
actual words (PGP).

I like the PGP wordlist, myself. BubbleBabble is harder to pronounce, and
is more likely to have ambiguous sounds which require retransmission. The
PGP set has a built-in checksum, too: the lengths of the words alternates
between two and three syllables. If you hear two three-syllable words in a
row, you've missed one.

I've been told that the military uses something like BubbleBabble, but that's
neither here nor there.

+ How does it work?
I use the Digest::MD5 and Digest::SHA1 modules to do the actual hashing,
because I didn't want to reinvent the wheel. Likewise, I took the code for
bubblebabble from OpenSSH, and the PGP's description and wordlist from the
back of the PGP freeware manual.

EOF
}

sub usage {
    print <<EOF;

$0 usage:
        Hashing options:
        --md5           Generates an MD5 digest
        --sha1          Generates a SHA1 digest

        Display options:
        --babble        Prints the digest in BubbleBabble format
        --words         Prints the digest using the PGP word list
        --hex           Prints the digest in hexadecimal form

        --verbose       Be verbose
        --help          This command summary
        --about         Some background

If running $0 on a file, a hashing option is required. If running
on standard input or with an argument which is the string to be hashed,
a hashing option is required if the input can't be interpreted as a hex
string. If it can be interpreted as a hex string, it will be converted to
the display option(s) of your choice.

EOF
    exit;
}



sub setup_pgp {
    my @wlst;
    @{$wlst[0]} = ("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"
                   );

    @{$wlst[1]} = ("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"
                   );
    return @wlst;
}



sub pgp {
    my @ary = @_;

    my ($i, $word, $count, $retval) = (0, 0, 0, "");

    my @list = setup_pgp();

    for ($i = 0; $i <= $#ary; $i++) {
        if (($count > 0) && ($count % 4 == 0)) { $retval .= "\n"; }

        $word = $list[$i % 2][hex($ary[$i])];
        $len = length($word);

        $retval .= $word;
        $retval .= ' ' x (15-$len);
        $count++;
    }
    return $retval;
}


###
# Taken straight from OpenSSH's key.c
###
sub babble {
    my @dgst_raw = @_;

    my $dgst_raw_len = $#dgst_raw;

    my @vowels = ( 'a', 'e', 'i', 'o', 'u', 'y' );
    my @consonants = ( 'b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm',
                       'n', 'p', 'r', 's', 't', 'v', 'z', 'x' );
    my ($i, $j) = (0,0);
    my ($rounds, $seed) = (1,1);

    my $retval = "";

    $rounds = int($dgst_raw_len / 2) + 1;

    for ($i = 0; $i <= $dgst_raw_len; $i++) {
        $dgst_raw[$i] = hex($dgst_raw[$i]);
    }


    $retval .= 'x';
    for ($i = 0; $i < $rounds; $i++) {
        my ($idx0, $idx1, $idx2, $idx3, $idx4) = (0,0,0,0,0);
        if (($i + 1 < $rounds) || ($dgst_raw_len % 2 != 0)) {
            $idx0 = int((($dgst_raw[2 * $i] >> 6) & 3) + $seed) % 6;
            $idx1 = int($dgst_raw[2 * $i] >> 2) & 15;
            $idx2 = int(($dgst_raw[2 * $i] & 3) + ($seed / 6)) % 6;
            1;
            $retval .= $vowels[$idx0];
            $retval .= $consonants[$idx1];
            $retval .= $vowels[$idx2];
            if (($i + 1) < $rounds) {
                $idx3 = int(($dgst_raw[(2 * $i) + 1]) >> 4) & 15;
                $idx4 = int($dgst_raw[(2 * $i) + 1]) & 15;
                $retval .= $consonants[$idx3];
                $retval .= '-';
                $retval .= $consonants[$idx4];
                $seed = (($seed * 5) +
                         ((($dgst_raw[2 * $i]) * 7) +
                          ($dgst_raw[(2 * $i) + 1]))) % 36;
            }
        } else {
            $idx0 = $seed % 6;
            $idx1 = 16;
            $idx2 = int($seed / 6);
            $retval .= $vowels[$idx0];
            $retval .= $consonants[$idx1];
            $retval .= $vowels[$idx2];
        }
    }

    $retval .= 'x';
    return $retval;
}


sub hex_print {
    my @ary = @_;
    my ($retval, $i);
    for ($i = 0; $i <= $#ary; $i++) {
        $retval .= $ary[$i];
        if (defined($ary[$i+1])) { $retval .= ":"; }
    }
    return $retval;
}




###
# These should probably be one function that takes the hash type as an arg.
###

sub md5_file {
    my $file = shift || my_error("md5_file called without a file argument.\n");
    open(FILE, $file) or my_error("Can't open '$file': $!");
    binmode(FILE);

    return Digest::MD5->new->addfile(*FILE)->hexdigest;
}

sub sha1_file {
    my $file = shift || my_error("sha1_file called without a file argument.\n");
    open(FILE, $file) or my_error("Can't open '$file': $!");
    binmode(FILE);

    return Digest::SHA1->new->addfile(*FILE)->hexdigest;
}

sub my_error {
    my $msg = shift;
    print "\nERR: $msg\n\n";
    print "See $0 --help for usage information.\n";
    exit -1;
}

sub self_check {
    my $i = 0;
    my ($tmp, $data) = ("","");
    open(SELF, $0) || my_error("Unable to check myself for consistency. That's odd.");
    $tmp = <SELF>;
    $tmp = <SELF>;
    while (<SELF>) {
        $data .= $_;
    }
    close SELF;
    if ($cksum eq "") {
        my_error("Checksum is " . Digest::MD5->new->add($data)->hexdigest . "\nPlease see the note at the bottom of the source for information.");
    }
    if ($cksum ne Digest::MD5->new->add($data)->hexdigest) {
        my_error("Failed internal consistency check. See note at bottom of source.");
    }
}

###
# NOTE:
#
# The built-in checksum is easy to defeat; it's meant to ensure that you
# downloaded this file correctly, not that it hasn't been tampered with.
# To disable it, comment out the line which calls self_check(). It should be
# around line 33.
#
# To verify that you have an unmodified version of this program, ensure that
# the checksum defined in the second line of the program matches the checksum
# for the version you're using published at
# http://staff.washington.edu/~jdlarios/fingerprint.txt
#
##