#!/usr/bin/perl

use strict;
use Getopt::Long;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Text::ParseWords;
use IO::File;
use IO::Dir;

my $vers='$Id: fwextract.pl 2560 2012-02-02 14:41:12Z isely $';
my ($parsedVers) = $vers =~ /\$Id:\s(.+)\s.+\s\$/;

# TODO:
#
#  * New metadata flag to indicate if firmware size might only be 8KB
#    (hack for FX2 firmware images).  Better idea: When doing a fuzzy
#    search, try to detect the actual length of the firmware image as
#    part of the search process.
#
#  * Isolate keyword "container" from same namespace as firmware
#    types...
#

#
#  Copyright (C) 2005-2009 Mike Isely <isely@pobox.com>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

# This script automates the extraction of firmware from other files
# (e.g. contained within Windows driver files).  This script can also
# be used to assist in locating additional firmware images.

# To extract firmware, just run the script, ensuring that the Windows
# driver files have been expanded into a "win_driver" subdirectory.
# (Alternatively, just name the relevant directory on the command.)
# The script will locate the firmware and extract it into which will
# be ready to use for upload into the hardware.  This script uses a
# table to recognize firmware files; it is able to seek and recognize
# multiple driver versions (depending on what's in the table).

# To teach the script about newer driver versions, you must first find
# an alternate way to manually extract the firmware files.  The way to
# accomplish that is going to depend heavily on the firmware in
# question and is outside the scope of this script.  But once you have
# the two firmware files manually extracted (and named appropriately),
# just run this script with the --search option.  This will cause it
# to use those firmware files as search keys into the Windows drivers.
# It will search through the driver files and find correct offsets and
# sizes for where the firmware has been "hidden".  It will then print
# out a configuration snippet that you can simply append to the
# fwextract.pl program.  Send that snippet back to me (Mike Isely
# <isely@pobox.com>) and I'll append it into the master copy of this
# script.  Then others will be able to easily extract the newer
# firmware without having to go through the manual pain you will have
# just completed :-)


# -------------------------------------------------------------------------

# This is all utility code that I've ripped from other code that I've
# written...

# This transforms the string such that it can be safely printed
# between double-quotes and then eval'ed back in at a later time to
# produce the original string value:
#  - Escape double quotes
#  - Escape dollar sign
#  - Escape '@' sign
#  - Escape newline
#  - Escape backslash
#  - Hexify any non-printing character
sub perlQuoteStr {
    my $str = shift;

    $str =~ s/([\$\@"\\])/\\$1/g;
    $str =~ s/([\n])/\\n/g;
    $str =~ s{([\x00-\x1f\x80-\xff])}{sprintf('\\x%02x',ord($1))}ge;

    return $str;
}

# Return string quoted or bare if it's safe to represent the string as
# a bareword.
sub perlSafeEmitBareStr {
    my $str = shift;
    # Two tests here: First only strings composed entirely of letters,
    # digits and the underscore - with the first character being a
    # letter - passes.  Then fail any string which might be mistaken
    # for a "v-string" (yuck).  If we fail, we quote the whole thing.
    # Otherwise we'll just return the bareword.
    if (($str =~ /^[a-zA-Z]\w+$/) && !($str =~ /^v\d+$/)) {
	return $str;
    }
    return '"' . perlQuoteStr($str) . '"';
}

# Return string quoted or bare if it is just a single digit.
sub perlSafeEmitStr {
    my $str = shift;
    if ($str =~ /^\d$/) {
	# Single-digit case - easily handled
	return $str;
    }
    return '"' . perlQuoteStr($str) . '"';
}

sub strToHex {
    my $str = shift;
    my $idx;
    my $cnt = length $str;
    my $vs = '';
    for ($idx = 0; $idx < $cnt; $idx++) {
	$vs .= sprintf "%02x",ord(substr($str,$idx,1));
    }
    return $vs;
}

sub hexToStr {
    my $vs = shift;
    my $str = '';
    my $cnt = (length $vs) / 2;
    my $idx;
    for ($idx = 0; $idx < $cnt; $idx++) {
	$str .= chr(hex(substr($vs,$idx << 1,2)));
    }
    return $str;
}

sub structureWriteToHandle2 {
    my $fh = shift;
    my $var = shift;
    my $prefix = shift;
    my ($v1,$v2);

    if (! defined $var) {
	print $fh 'undef';
	return;
    }
    $v2 = ref $var;
    if ($v2 eq "") {
	print $fh perlSafeEmitStr($var);
	return;
    }
    if ($v2 eq 'ARRAY') {
	my $oldPrefix = $prefix;
	$prefix = $prefix . "  ";
	if (scalar(@$var) == 0) {
	    print $fh "[ ]";
	    return;
	}
	print $fh "[\n";
	for ($v1 = 0; $v1 < scalar(@$var); $v1++) {
	    if ($v1) {
		print $fh ",";
		if (ref $var->[$v1] eq '') {
		    print $fh "\n";
		    print $fh $prefix;
		}
	    } else {
		print $fh $prefix;
	    }
	    structureWriteToHandle2($fh,$var->[$v1],$prefix);
	}
	print $fh "\n";
	print $fh $oldPrefix;
	print $fh "]";
	return;
    }
    if ($v2 eq 'HASH') {
	my $key;
	my $oldPrefix = $prefix;
	$prefix = $prefix . "  ";
	if (scalar(keys %$var) == 0) {
	    print $fh "{ }";
	    return;
	}
	print $fh "{\n";
	$v1 = 0;
	foreach $key (sort keys %$var) {
	    if ($v1) {
		print $fh ",\n";
	    }
	    print $fh $prefix;
	    print $fh perlSafeEmitBareStr($key) . ' => ';
	    structureWriteToHandle2($fh,$var->{$key},$prefix);
	    $v1++;
	}
	print $fh "\n";
	print $fh $oldPrefix;
	print $fh "}";
	return;
    }

    return;
}

sub structureWriteToHandle {
    my $fh = shift;
    my $var = shift;
    my $prefix = shift;

    structureWriteToHandle2($fh,$var,$prefix);
    print $fh "\n";
}

sub safeEvalStr {
    my $str = shift;
    my $argv = shift;
    my $warnText = undef;
    my $evalResult;
    my $result = { };
    {
	local $SIG{__WARN__} = sub {$warnText = shift};
	local @ARGV;
	if ($argv) {
	    @ARGV = @$argv;
	}
	$evalResult = eval($str);
    }
    if ($@) {
	$result->{exception} = $@;
    }
    if (defined $warnText) {
	$result->{warning} = $warnText;
    }
    if (defined $evalResult) {
	$result->{result} = $evalResult;
    }
    return $result;
}

sub safeEvalHandle {
    my $fh = shift;
    my $argv = shift;
    my $v1;
    my $result;

    # Suck in the entire file
    while ($fh->read($v1,16384,length $v1)) { }

    $result = safeEvalStr($v1,$argv);

    return $result;
}

sub safeEvalFile {
    my $fileName = shift;
    my $argv = shift;
    my $result;
    my $fh;

    $fh = new IO::File;
    if (! $fh->open($fileName)) {
	return {fileResult => $!};
    }

    return safeEvalHandle($fh,$argv);
}


# -------------------------------------------------------------------------
# Other fairly generic utility functions

# Verify that passed-in argument is a non-empty normal scalar value
sub isUsableScalar {
    my $e = shift;
    return undef if (! defined $e);
    return undef if (ref $e ne '');
    return undef if ($e eq '');
    return 1;
}

# Quick and dirty function to grab the contents of a directory.
sub getDirEntries {
    my $dirName = shift;
    my $dirh;
    my @entries;

    $dirh = new IO::Dir $dirName;

    return undef if (! defined $dirh);

    @entries = sort $dirh->read();

    return \@entries;
}

# Generate a full list of files, including all nested subdirectories.
# Pass in a starting point or a reference to an array of places to
# check.
sub getRecursiveDirEntries {
    my $dirName= shift;
    my @entries;
    my @searchList;
    my $subList;
    my $subKey;
    my $key;
    if (ref $dirName eq 'ARRAY') {
	push @searchList,@$dirName;
    } else {
	push @searchList,$dirName;
    }

    for (;;) {
	$key = shift @searchList;
	last if (!defined $key);
	if (-d $key) {
	    $subList = getDirEntries($key);
	    foreach $subKey (@$subList) {
		next if ($subKey eq '..');
		next if ($subKey eq '.');
		if ($key ne '.') {
		    push @searchList,"$key/$subKey";
		} else {
		    push @searchList,"$subKey";
		}
	    }
	    next;
	}
	if (-f $key) {
	    push @entries,$key;
	}
    }
    return \@entries;
}

sub getRecursiveDirEntriesOrFail {
    my $searchList = shift;
    my $files = getRecursiveDirEntries($searchList);

    if (scalar(@$files) < 1) {
	die "Failed to locate any files to scan anywhere starting with @$searchList.\n";
    }

    return $files;
}

# Suck a file into a data structure so that we can manipulate it.
sub fetchFileData {
    my $fname = shift;
    my $dontDieFl = shift;
    my $fh = new IO::File;
    my $cnt;

    my $info = {
	name => $fname,
	data => '',
    };

    if (! $fh->open("<$fname")) {
	return undef if ($dontDieFl);
	die "Failed to open $fname for reading";
    }

    $fh->binmode();
    while ($fh->read($info->{data},16384,length $info->{data})) { }

    $info->{size} = length $info->{data};
    $info->{md5_hex} = md5_hex($info->{data});
    $info->{tag} = substr($info->{data},0,4);
    return $info;
};


# -------------------------------------------------------------------------

# Everything here and below is more specific to the exact nature of
# this program (as opposed to be utility code)

# -------------------------------------------------------------------------

# Shortcut hash defining firmware metadata attributes that exist (used
# during import / output process).
my @fwMetaAttr = ('file_name',
		  'hardware_info',
		  'comment',
		  'dependencies',
		  'fuzzy_search');

# Construct exportable database from internal data and return it.
# There is no checking needed here since we already assume that the
# internal database is actually internally consistent.
sub databaseInternalToExportable {
    my $idb = shift;
    my $aImages = $idb->{images};
    my $aFwMetaData = $idb->{fwMetaData};
    my @dba;
    my ($id,$item,$itemType,$ip);
    my $key;
    if (defined $aFwMetaData) {
	foreach $itemType (sort keys %$aFwMetaData) {
	    $item = $aFwMetaData->{$itemType};
	    $ip = {
		aa_obj_type => 'fw_metadata',
		fw_type => $itemType,
	    };
	    foreach $key (@fwMetaAttr) {
		next if (!defined $item->{$key});
		$ip->{$key} = $item->{$key};
	    }
	    push @dba,$ip;
	}
    }
    foreach $id (sort keys %$aImages) {
	$item = $aImages->{$id};
	next if ($item->{item_type} eq 'container');
	$ip = {
	    aa_obj_type => 'fw_version',
	    id => $id,
	    fw_type => $item->{item_type},
	    fw_size => $item->{size},
	};
	$ip->{comment} = $item->{comment} if (defined $item->{comment});
	$ip->{fw_tag} = $item->{tag} if (defined $item->{tag});
	push @dba,$ip;
    }
    foreach $id (sort keys %$aImages) {
	$item = $aImages->{$id};
	next if ($item->{item_type} ne 'container');
	$ip = {
	    aa_obj_type => 'container',
	    id => $id,
	    elements => $item->{elements},
	};
	$ip->{comment} = $item->{comment} if (defined $item->{comment});
	push @dba,$ip;
    }
    return \@dba;
}


# Convert passed in database, which is in exportable format, to the
# internal format.  Ensure that incoming database structure is correct
# and return a scalar integer if it isn't.  Otherwise return a hash
# containing the internal database.
sub databaseExportableToInternal {
    my $dba = shift;
    my ($id,$item,$itemType,$ip);
    my $objType;
    my $key;
    my ($elem,$ekey,$elements);
    my $newFwMetaData = { };
    my $newImages = { };
    return "Database is missing" if (! defined $dba);
    return "Database is not an array" if (ref $dba ne 'ARRAY');
    foreach $ip (@$dba) {
	$objType = $ip->{aa_obj_type};
	return "Invalid object type field" if (! isUsableScalar($objType));
	if ($objType eq 'fw_metadata') {
	    $itemType = $ip->{fw_type};
	    return "Invalid fw_metadata name" if (! isUsableScalar($itemType));
	    $item = { };
	    foreach $key (@fwMetaAttr) {
		next if (!defined $ip->{$key});
		if ($key eq 'dependencies') {
		    if (ref $ip->{$key} ne 'ARRAY') {
			return "fw_metadata dependency field is not an array";
		    }
		    $elements = [ ];
		    $item->{$key} = $elements;
		    foreach $elem (@{$ip->{$key}}) {
			if (! isUsableScalar($elem)) {
			    return "Invalid fw_metadata dependency";
			}
			push @$elements,$elem;
		    }
		} else {
		    if (! isUsableScalar($ip->{$key})) {
			return "Invalid fw_metadata attribute";
		    }
		    $item->{$key} = $ip->{$key};
		}
	    }
	    $newFwMetaData->{$itemType} = $item;
	    next;
	}
	if ($objType eq 'fw_version') {
	    $id = $ip->{id};
	    return "Invalid fw_version ID" if (! isUsableScalar($id));
	    return "Invalid fw_version type" if (! isUsableScalar($ip->{fw_type}));
	    return "Invalid fw_version size" if (! isUsableScalar($ip->{fw_size}));
	    $item = {
		id => $id,
		item_type => $ip->{fw_type},
		size => $ip->{fw_size},
	    };
	    if (defined $ip->{comment}) {
		return "Invalid fw_version comment" if (! isUsableScalar($ip->{comment}));
		$item->{comment} = $ip->{comment}
	    }
	    if (defined $ip->{fw_tag}) {
		return "Invalid fw_version tag" if (! isUsableScalar($ip->{fw_tag}));
		$item->{tag} = $ip->{fw_tag}
	    }
	    $newImages->{$id} = $item;
	    next;
	}
	if ($objType eq 'container') {
	    $id = $ip->{id};
	    return "Invalid container ID" if (! isUsableScalar($id));
	    $elements = [ ];
	    $item = {
		id => $id,
		item_type => 'container',
		elements => $elements,
	    };
	    return "Invalid container element list" if (! defined $ip->{elements});
	    if (ref $ip->{elements} ne 'ARRAY') {
		return "Container element attribute must be an array";
	    }
	    foreach $elem (@{$ip->{elements}}) {
		return "Invalid container element" if (! defined $elem);
		return "Container element item must be a hash" if (ref $elem ne 'HASH');
		if (! isUsableScalar($elem->{id})) {
		    return "Invalid container element item ID";
		}
		if (! isUsableScalar($elem->{offset})) {
		    return "Invalid container element item offset";
		}
		push @$elements,{
		    id => $elem->{id},
		    offset => $elem->{offset},
		};
	    }
	    if (defined $ip->{comment}) {
		return "Invalid container comment" if (! isUsableScalar($ip->{comment}));
		$item->{comment} = $ip->{comment}
	    }
	    $newImages->{$id} = $item;
	    next;
	}
    }
    return {
	images => $newImages,
	fwMetaData => $newFwMetaData,
    };
}


# Walk through exportable database structure and produce a
# line-oriented ASCII definition
sub databaseExportableToText {
    my $fh = shift;
    my $dba = shift;
    my $i;
    my $objType;
    my ($fw_type,$fname,$comment,$hw_info,$dep);
    my $elem;
    my $d;
    my %flags;

    foreach $i (@$dba) {
	$objType = $i->{aa_obj_type};
	if ($objType eq 'fw_metadata') {
	    $fw_type = perlSafeEmitBareStr($i->{fw_type});
	    $fname = perlSafeEmitBareStr($i->{file_name});
	    print $fh "fw_metadata $fw_type $fname\n";
	    %flags = ( );
	    $flags{fuzzy_search} = 1 if ($i->{fuzzy_search});
	    if (scalar(keys %flags)) {
		print $fh "  flags";
		foreach $d (sort keys %flags) {
		    print $fh " $d";
		}
		print $fh "\n";
	    }
	    if (defined $i->{comment}) {
		$comment = perlSafeEmitBareStr($i->{comment});
		print $fh "  comment $comment\n";
	    }
	    if (defined $i->{hardware_info}) {
		$hw_info = perlSafeEmitBareStr($i->{hardware_info});
		print $fh "  hardware_info $hw_info\n";
	    }
	    if (defined $i->{dependencies}) {
		foreach $dep (@{$i->{dependencies}}) {
		    $d = perlSafeEmitBareStr($dep);
		    print $fh "  dep $d\n";
		}
	    }
	    next;
	}
	if ($objType eq 'fw_version') {
	    $fw_type = perlSafeEmitBareStr($i->{fw_type});
	    $d = $i->{id};
	    if (defined $i->{fw_tag}) {
		$d .= '.' . strToHex($i->{fw_tag});
	    }
	    print $fh "fw_version $d $fw_type $i->{fw_size}\n";
	    if (defined $i->{comment}) {
		$comment = perlSafeEmitBareStr($i->{comment});
		print $fh "  comment $comment\n";
	    }
	    next;
	}
	if ($objType eq 'container') {
	    print $fh "container $i->{id}\n";
	    if (defined $i->{comment}) {
		$comment = perlSafeEmitBareStr($i->{comment});
		print $fh "  comment $comment\n";
	    }
	    foreach $elem (@{$i->{elements}}) {
		print $fh "  image $elem->{id} $elem->{offset}\n";
	    }
	    next;
	}
    }
}


# Read a block of text, parsing the contents into an exportable
# database format.  Return undef if the parse fails for any reason.
sub databaseTextToExportable {
    my $fh = shift;
    my @dba;
    my $line;
    my @words;
    my $cmd;
    my ($i,$d);
    my ($k,$t);
    my ($idx,$cnt);
    my %fw_metadata_flag_defs = (
	fuzzy_search => 'fuzzy_search',
	);
    while ($line = <$fh>) {
	chomp $line;
	$line =~ s/^\s+//g;
	@words = parse_line('\s+',0,$line);
#	print "Parsed \"$line\" as";
#	foreach $i (@words) {
#	    print " \"$i\"";
#	}
#	print "\n";
	$cnt = scalar(@words);
	next if ($cnt == 0);
	$cmd = $words[0];
	next if ($cmd eq '#');
	if ($cmd eq 'fw_metadata') {
	    return "fw_metadata has too few arguments" if ($cnt < 2);
	    return "fw_metadata has too many arguments" if ($cnt > 3);
	    $i = {
		aa_obj_type => $cmd,
		fw_type => $words[1],
	    };
	    push @dba,$i;
	    if ($cnt > 2) {
		$i->{file_name} = $words[2];
	    }
	    next;
	}
	if ($cmd eq 'fw_version') {
	    return "fw_version requires 4 arguments" if ($cnt != 4);
	    $d = $words[1];
	    $t = undef;
	    if (($k,$t) = $d =~ /^(.+)\.(.+)$/) {
		$d = $k;
		$t = hexToStr($t);
	    }
	    $i = {
		aa_obj_type => $cmd,
		id => $d,
		fw_type => $words[2],
		fw_size => $words[3],
	    };
	    $i->{fw_tag} = $t if (defined $t);
	    push @dba,$i;
	    next;
	}
	if ($cmd eq 'container') {
	    return "container requires 1 argument" if ($cnt != 2);
	    $i = {
		aa_obj_type => $cmd,
		id => $words[1],
		elements => [ ],
	    };
	    push @dba,$i;
	    next;
	}
	return "Need a command to start a block" if (! defined $i);
	if ($cmd eq 'comment') {
	    return "comment requires 1 argument" if ($cnt != 2);
	    $i->{comment} = $words[1];
	    next;
	}
	if ($cmd eq 'image') {
	    return "image not in a container" if ($i->{aa_obj_type} != 'container');
	    return "image requires 2 arguments" if ($cnt > 3);
	    push @{$i->{elements}}, {
		id => $words[1],
		offset => $words[2],
	    };
	    next;
	}
	if ($cmd eq 'hardware_info') {
	    return "hardware_info not in fw_metadata block" if ($i->{aa_obj_type} != 'fw_metadata');
	    return "hardware_info requires 1 arguments" if ($cnt != 2);
	    $i->{hardware_info} = $words[1];
	    next;
	}
	if ($cmd eq 'dep') {
	    return "dep not in fw_metadata block" if ($i->{aa_obj_type} != 'fw_metadata');
	    return "dep requires 1 argument" if ($cnt > 2);
	    $i->{dependencies} = [ ] if (! defined $i->{dependencies});
	    push @{$i->{dependencies}}, $words[1];
	    next;
	}
	if ($cmd eq 'flags') {
	    return "flags not in a fw_metadata block" if ($i->{aa_obj_type} != 'fw_metadata');
	    for ($idx = 1; $idx < $cnt; $idx++) {
		$d = $words[$idx];
		if (! exists $fw_metadata_flag_defs{$d}) {
		    return "flag $d unknown for fw_metadata block";
		}
		$i->{$fw_metadata_flag_defs{$d}} = 1;
	    }
	    next;
	}
	return "Unrecognized command \"$cmd\"";
    }
    return \@dba;
}


# Analyze the passed in database, in internal format, to ensure
# self-consistency.  The idea here is to verify that all referenced
# hashes and firmware types are actually defined.  If there is a
# problem, a report of the unknown items is printed to stdout and
# false is returned.  Otherwise true is returned.
sub databaseVerifyInternal {
    my $dbi = shift;
    my $aImages = $dbi->{images};
    my $aFwMetaData = $dbi->{fwMetaData};
    my %ids;
    my %fwTypes;
    my @badFwTypes;
    my @badIds;
    my ($key,$item,$val,$elem);

    foreach $key (keys %$aFwMetaData) {
	$item = $aFwMetaData->{$key};
	next if (! exists $item->{dependencies});
	foreach $val (@{$item->{dependencies}}) {
	    $fwTypes{$val} = 1;
	}
    }
    foreach $key (keys %$aImages) {
	$item = $aImages->{$key};
	$val = $item->{item_type};
	if ($val ne 'container') {
	    $fwTypes{$val} = 1;
	    next;
	}
	foreach $elem (@{$item->{elements}}) {
	    $ids{$elem->{id}} = 1;
	}
    }
    foreach $key (sort keys %fwTypes) {
	next if (exists $aFwMetaData->{$key});
	push @badFwTypes,$key;
    }
    foreach $key (sort keys %ids) {
	next if (exists $aImages->{$key});
	push @badIds,$key;
    }

    return 1 if (!(scalar(@badIds) || scalar(@badFwTypes)));

    print "Firmware database integrity problem!\n";
    if (scalar(@badFwTypes)) {
	print "  These firmware type(s) are referenced but never defined:\n";
	foreach $val (@badFwTypes) {
	    print "    $val\n";
	}
    }
    if (scalar(@badIds)) {
	print "  These firmware versions are referenced in a container but never defined:\n";
	foreach $val (@badIds) {
	    print "    $val\n";
	}
    }
    return 0;
}


sub databaseExportToFile {
    my $dbi = shift;
    my $fname = shift;
    my $fh = new IO::File(">$fname")
	or die "Unable to open \"$fname\" for output";
    my $dba = databaseInternalToExportable($dbi);
    my $dbFormatFl = ($fname =~ /^.*\.db$/);
    print $fh "# fwextract configuration database\n";
    print $fh "# Written using \"$parsedVers\"\n";
    if ($dbFormatFl) {
	print $fh "# Format: Perl data structure\n\n";
	structureWriteToHandle($fh,$dba);
    } else {
	print $fh "# Format: Text description\n\n";
	databaseExportableToText($fh,$dba);
    }
    return 1;
}


sub databaseImportFromFile {
    my $fname = shift;
    my $dbFormatFl = ($fname =~ /^.*\.db$/);
    my $dba;
    if ($dbFormatFl) {
	my $evResult = safeEvalFile($fname);
	if (defined $evResult->{exception}) {
	    print "Unable to read database: $evResult->{exception}\n";
	    return undef;
	}
	if (defined $evResult->{warning}) {
	    print "Database import: $evResult->{warning}\n";
	}
	$dba = $evResult->{result};
	if (! defined $dba) {
	    print "Unable to import database: not a legal Perl data structure.\n";
	    return undef;
	}
    } else {
	my $fh = new IO::File("<$fname");
	if (!$fh) {
	    print "Unable to open configuration file $fname\n";
	    return undef;
	}
	$dba = databaseTextToExportable($fh);
	if (! defined $dba) {
	    print "Unable to import database: Undefined parsing problem.\n";
	    return undef;
	}
	if (ref $dba eq '') {
	    print "Unable to import database: $dba\n";
	    return undef;
	}
    }
    my $dbi = databaseExportableToInternal($dba);
    if (ref $dbi eq '') {
	print "Database conversion error: $dbi\n";
	return undef;
    }
    if (! databaseVerifyInternal($dbi)) {
	print "Unable to import database: internally inconsistent.\n";
	return undef;
    }
    return $dbi;
}


sub databaseImportFromInternal {
    my $dba = databaseTextToExportable(\*DATA);
    if (! defined $dba) {
	print "No internally defined configuration database.\n";
	return undef;
    }
    if (ref $dba eq '') {
	print "Error reading internal configuration database: $dba\n";
	return undef;
    }
    my $dbi = databaseExportableToInternal($dba);
    if (ref $dbi eq '') {
	print "Database internal importation error: $dbi\n";
	return undef;
    }
    if (! databaseVerifyInternal($dbi)) {
	print "Unable to import internal database: internally inconsistent.\n";
	return undef;
    }
    return $dbi;
}


# Print out an inventory of everything we know about firmware images
# we've been trained to find.
sub inventoryImagesToHandle {
    my $dbi = shift;
    my $fh = shift;
    my $aImages = $dbi->{images};
    my $aFwMetaData = $dbi->{fwMetaData};
    my %item_types_hash;
    my $key;
    my $item;
    my $item_type;
    my $k;
    my $s;
    my $t;
    my $elem;
    my $id;
    my $im;
    my $imageMetaData;
    my %metaFlags = (
	fuzzy_search => 'fuzzy_search',
	);
    my @flagSet;
    print $fh <<EOF;

Inventory of known firmware data - this is a human readable
representation of the configuration database that fwextract uses
internally to find firmware images:


EOF

    for $key (keys %$aImages) {
	$item = $aImages->{$key};
	$item_type = $item->{item_type};
	if (! exists $item_types_hash{$item_type}) {
	    $item_types_hash{$item_type} = 0;
	}
	($item_types_hash{$item_type})++;
    }
    for $item_type (sort keys %item_types_hash) {
	next if ($item_type eq 'container');
	$imageMetaData = $aFwMetaData->{$item_type};
	print $fh "image $item_type:\n";
	@flagSet = ( );
	foreach $k (keys %metaFlags) {
	    next if (! $imageMetaData->{$k});
	    push @flagSet,$metaFlags{$k};
	}
	if (scalar(@flagSet)) {
	    print $fh "    flags:";
	    foreach $k (sort @flagSet) {
		print $fh " $k";
	    }
	    print $fh "\n";
	}
	if (exists $imageMetaData->{hardware_info}) {
	    $k = $imageMetaData->{hardware_info};
	    print $fh "    device: $k\n";
	}
	if (exists $imageMetaData->{comment}) {
	    $k = $imageMetaData->{comment};
	    print $fh "    comment: $k\n";
	}
	if (exists $imageMetaData->{file_name}) {
	    $k = $imageMetaData->{file_name};
	    print $fh "    output file: \"$k\"\n";
	}
	if (exists $imageMetaData->{dependencies}) {
	    $k = $imageMetaData->{dependencies};
	    print $fh "    depends upon:";
	    foreach $s (@$k) {
		print $fh " $s";
	    }
	    print $fh "\n";
	}

	for $key (keys %$aImages) {
	    $item = $aImages->{$key};
	    next if ($item->{item_type} ne $item_type);
	    $s = $item->{size};
	    print $fh "    version: $key (size $s";
	    if (defined $item->{tag}) {
		$t = strToHex($item->{tag});
		print " tag $t";
	    }
	    print $fh ")";
	    if (defined $item->{comment}) {
		$k = $item->{comment};
		print $fh " (\"$k\")";
	    }
	    if ($item->{id} ne $key) {
		print $fh " - id inconsistent: $item->{id}";
	    }
	    print $fh "\n";
	}
	print $fh "\n";
    }
    for $key (keys %$aImages) {
	$item = $aImages->{$key};
	next if ($item->{item_type} ne 'container');
	print $fh "container $key:\n";
	if ($item->{id} ne $key) {
	    print $fh "    id inconsistent: $item->{id}\n";
	}
	if (defined $item->{comment}) {
	    $k = $item->{comment};
	    print $fh "    comment: \"$k\"\n";
	}
	$im = { };
	for $elem (@{$item->{elements}}) {
	    $id = $elem->{id};
	    $item_type = $aImages->{$id}->{item_type};
	    if (! exists $im->{$item_type}) {
		$im->{$item_type} = [ ];
	    }
	    push @{$im->{$item_type}}, $elem;
	}
	for $item_type (sort keys %$im) {
	    for $elem (@{$im->{$item_type}}) {
		$id = $elem->{id};
		$s = $elem->{offset};
		print $fh "    image $item_type $id (offset $s)\n";
	    }
	}
	print $fh "\n";
    }
}

# -------------------------------------------------------------------------

# The next two global variables contain the internal "configuration
# database" that fwextract uses to figure out how to operate.

# Database of firmware types that we can know about.  This is
# populated at run-time via importation of a configuration database.
# This hash key is the type name; this key is used in the image
# database everywhere.  The associated fields are:
#
#  file_name - Target file name that firmware type should extract to
#  dependencies - Other firmware types expected to be present with this type
#  hardware_info - Optional phrase that describes associated whole device
#  comment - Optional single that describes associated chip
#  fuzzy_search - If present & true, then enable fuzzy search on this item
#
# The existence of the hardware_info field tags the corresponding
# firmware as being specified to a particular model.  The extractor
# uses this information to help infer what the device the user is
# trying to target.
my $fwMetaData;

# This hash is built at run-time via importation of a configuration
# database.  The idea here is to rework the data into a form more
# amenable for other uses.  Each hash element is keyed by an MD5 sum.
# That sum corresponds to a physical container file or a firmware
# image (or both if the firmware image happens to be its own file).
# Each element is a hash with the following fields:
#
#  item_type - one of 'container' or a $fwMetaData key
#  id - MD5 key of item
#  size - size of firmware image if item_type != 'container'
#  elements - array of contained elements if item_type == 'container'
#  comment - optional comment about this item
#
# The elements item is an array where each element is another hash,
# and describes an extent within the container that holds firmware we
# want.  The fields for each field within each element are:
#
#  id - MD5 key of contained firmware item (look this up in images)
#  offset - Offset within container where item begins
my $images;

# -------------------------------------------------------------------------
# Stuff below here implements training algorithms.

# Print a <value> / <value> string to the terminal.  We do this so
# that the user doesn't think that the script is hung.   This is a
# helper for searchForFuzzySequence.
sub printProgress {
    my $ctxt = shift;
    my $idx = shift;
    my $str;

    print "\r" if (defined $ctxt->{dirty});
    $ctxt->{dirty} = !0;
    $str = sprintf "%7d / %7d",$idx,$ctxt->{cnt};
    print "$str";
}

# Clean up after printing a <value> / <value> string to the terminal.
# We do this so that the user doesn't think that the script is hung.
# This is a helper for searchForFuzzySequence.
sub clearProgress {
    my $ctxt = shift;
    my $idx = shift;
    return if (! defined $ctxt->{dirty});
    printProgress($ctxt,$idx);
    print "\n";
}

# Search for a needle in a haystack.  Pass in the haystack and the
# needle and try to find where in the haystack it is a residing.
# Return value is the offset within the haystack where it's been found
# or undef.  This implementation is a slow "fuzzy" search.  We
# tolerate up to 1% of the data bytes being incorrect, which allows us
# to use slightly changed firmware data sucked from the hardware as a
# search key (the 8051 firmware in fact seems to always come back with
# a single modified byte).
sub searchForFuzzySequence {
    my $needleInfo = shift;
    my $haystackInfo = shift;
    my ($idx1,$idx2);
    my $errCnt;
    my $errMaxCnt;
    my $needleCheckSize;
    my $needleRef = \$needleInfo->{data};
    my $haystackRef = \$haystackInfo->{data};
    my $needleSize = length $$needleRef;
    my $haystackSize = length $$haystackRef;
    my $pctxt = { };

    return undef if ($haystackSize < $needleSize);

    my $range = $haystackSize - $needleSize;

    $errMaxCnt = int($needleSize * 0.002);
    $needleCheckSize = int($needleSize * 0.75);

#    print "Fuzzy check info:\n";
#    print "Checking $needleCheckSize out of $needleSize bytes\n";
#    print "Will tolerate up to $errMaxCnt errors\n";

    $pctxt->{cnt} = $range;
    for ($idx1 = 0; $idx1 < $range; $idx1++) {
	if ($idx1 && !($idx1 % 3000)) {
	    printProgress($pctxt,$idx1);
	}
	$errCnt = 0;
	for ($idx2 = 0; $idx2 < $needleCheckSize; $idx2++) {
	    next if (substr($$haystackRef,$idx1+$idx2,1) eq
		     substr($$needleRef,$idx2,1));
	    $errCnt++;
	    last if ($errCnt > $errMaxCnt);
	}
	next if ($idx2 < $needleCheckSize);
	clearProgress($pctxt,$idx1);
	return $idx1;
    }
    clearProgress($pctxt,$idx1);
    return undef;
};

# Search for a needle in a haystack.  Pass in the haystack and the
# needle and try to find where in the haystack it is a residing.
# Return value is the offset within the haystack where it's been found
# or undef.  This is a fast, exact search.
sub searchForExactSequence {
    my $needleInfo = shift;
    my $haystackInfo = shift;
    my $idx;
    my $needleSize = length $needleInfo->{data};
    my $haystackSize = length $haystackInfo->{data};

    return undef if ($haystackSize < $needleSize);

    my $range = $haystackSize - $needleSize;
    my $ssize = 4;

    # Pure paranoia
    $ssize = $needleSize if ($ssize > $needleSize);

    for ($idx = 0; $idx <= $range; $idx++) {
	# Just check the first 4 bytes initially since this will be fast
	next if (substr($haystackInfo->{data},$idx,$ssize) ne
		 substr($needleInfo->{data},0,$ssize));
	# If we get here, then it's probably a match, but let's check
	# the entire data block now.
	next if (substr($haystackInfo->{data},$idx,$needleSize) ne
		 $needleInfo->{data});
	return $idx;
    }
    return undef;
};

# Search for a needle in a haystack.  Pass in the haystack and the
# needle and try to find where in the haystack it is a residing.
# Return value is the offset within the haystack where it's been found
# or undef.  This will execute either a fast exact search or a slow
# but fuzzy search.
sub searchForSequence {
    my $needleInfo = shift;
    my $haystackInfo = shift;
    my $fuzzyFl = shift;
    my $fp;
    my $offset;

    if ($fuzzyFl) {
	$fp = \&searchForFuzzySequence;
    } else {
	$fp = \&searchForExactSequence;
    }

    return &{$fp}($needleInfo,$haystackInfo);
}

sub createImageRecord {
    my $fw = shift;
    return {
	id => $fw->{md5_hex},
	size => $fw->{size},
	item_type => $fw->{item_type},
	tag => $fw->{tag},
    };
}

sub searchASingleFilePost {
    my $context = shift;
    my $fileInfo = shift;
    my $content = shift;
    my $newImages = $context->{images};
    my $foundContainers = $context->{foundContainers};
    my ($id,$container,$item);

    return 0 if (scalar(@$content) == 0);

    $id = $fileInfo->{md5_hex};
    $foundContainers->{$id} = 1;
    if (exists $newImages->{$id}) {
	$container = $newImages->{$id};
    } else {
	$container = {
	    id => $id,
	    item_type => 'container',
	    elements => [ ],
	};
	$newImages->{$id} = $container;
    }
    if (defined $context->{comment}) {
	$container->{comment} = $context->{comment};
    }
    foreach $item (@$content) {
	$id = $item->{id},
	print "--> Found $item->{item_type} contained in $fileInfo->{name}" .
	    " at offset $item->{offset}\n";
	push @{$container->{elements}}, {
	    id => $id,
	    offset => $item->{offset},
	};
	if (! exists $newImages->{$id}) {
	    $newImages->{$id} = createImageRecord($item);
	}
    }

    return 1;
}

sub searchASingleFileUsingTags {
    my $context = shift;
    my $fileInfo = shift;
    my ($offset,$size);
    my $item;
    my $content = [];
    my $id;
    my $fwInfo = $context->{fwInfo};
    my ($idx,$haystackSize,$needleSize,$range,$tag,$id2);
    my $tagTable = $context->{tagTable};

    print "Tag searching $fileInfo->{name} (size=$fileInfo->{size})\n";
    $haystackSize = length $fileInfo->{data};
    $needleSize = $context->{tagMinImageSize};
    return 0 if ($haystackSize < $needleSize);
    $range = $haystackSize - $needleSize;
    for ($offset = 0; $offset < $range; $offset++) {
	$tag = substr($fileInfo->{data},$offset,4);
	next if (! exists $tagTable->{$tag});
	foreach $id (keys %{$tagTable->{$tag}}) {
	    $item = $tagTable->{$tag}->{$id};
	    $size = $item->{size};
	    next if ($size + $offset > $haystackSize);
	    $id2 = md5_hex(substr($fileInfo->{data},$offset,$size));
	    next if ($id ne $id2);
	    push @$content,{
		offset => $offset,
		size => $size,
		item_type => $item->{item_type},
		tag => $item->{tag},
		id => $id,
	    };
	    if (exists $fwInfo->{$id}) {
		$fwInfo->{$id}->{got} = 1;
	    }
	}

    }

    return searchASingleFilePost($context,$fileInfo,$content);
}

# Helper function to search a single file for firmware.
sub searchASingleFile {
    my $context = shift;
    my $fileInfo = shift;
    my $fuzzyFl = shift;
    my ($offset,$size);
    my $itemType;
    my $item;
    my $content = [];
    my $str = "Searching";
    my $id;
    my $fwInfo = $context->{fwInfo};
    my $imageMetaData;

    $str = "Fuzzy searching" if ($fuzzyFl);
    print "$str $fileInfo->{name} (size=$fileInfo->{size})\n";
    foreach $id (sort keys %$fwInfo) {
	$item = $fwInfo->{$id};
	$itemType = $item->{item_type};
	$imageMetaData = $fwMetaData->{$itemType};
	if ($fuzzyFl) {
	    next if ($item->{got});
	    next if (! $imageMetaData->{fuzzy_search});
	}
	if ($fuzzyFl) {
	    print "--> Searching for $itemType ($imageMetaData->{file_name})\n";
	}
	$offset = searchForSequence($item,$fileInfo,$fuzzyFl);
	next if (!defined $offset);
	$size = $item->{size};
	push @$content,{
	    offset => $offset,
	    size => $size,
	    item_type => $itemType,
	    id => md5_hex(substr($fileInfo->{data},$offset,$size)),
	    tag => substr($fileInfo->{data},$offset,4),
	};
	$item->{got} = 1;
    }

    return searchASingleFilePost($context,$fileInfo,$content);
}

sub findExistingFirmwareFiles {
    my %img;
    my $fileItem;
    my $itemType;
    my $fileName;
    my $dirName;
    my $dirEntries;
    my $imageMetaData;
    foreach $itemType (sort keys %$fwMetaData) {
	$imageMetaData = $fwMetaData->{$itemType};
	$fileName = $imageMetaData->{file_name};
	$fileItem = fetchFileData($fileName,1);
	if (defined $fileItem) {
	    $fileItem->{item_type} = $itemType;
	    $img{$fileItem->{md5_hex}} = $fileItem;
	    next;
	}
	next if (!(($dirName) = $fileName =~ /^(.+)\.fw$/));
	$dirEntries = getDirEntries($dirName);
	for $fileName (@$dirEntries) {
	    next if ($fileName eq '..');
	    next if ($fileName eq '.');
	    $fileItem = fetchFileData($dirName. '/' . $fileName,1);
	    next if (! defined $fileItem);
	    $fileItem->{item_type} = $itemType;
	    $img{$fileItem->{md5_hex}} = $fileItem;
	}
    }
    return \%img;
}

sub reportFirmwareFiles {
    my $fwInfo = shift;
    my $id;
    my $group;
    my $item;
    my $itemType;
    my $itemName;
    my %byType;
    foreach $id (keys %$fwInfo) {
	$item = $fwInfo->{$id};
	$itemType = $item->{item_type};
	$itemName = $item->{name};
	$byType{$itemType}->{$itemName} = $item;
    }
    print "Searching for the following embedded file data:\n";
    foreach $itemType (sort keys %byType) {
	$group = $byType{$itemType};
	foreach $itemName (sort keys %$group) {
	    $item = $group->{$itemName};
	    $id = $item->{md5_hex};
	    print "  $itemType file $itemName ($id)\n";
	}
    }
}

sub foundAllFirmware {
    my $fwInfo = shift;
    my $item;
    my $id;
    foreach $id (keys %$fwInfo) {
	$item = $fwInfo->{$id};
	return 0 if (! defined $item->{got});
	return 0 if (! $item->{got});
    }
    return 1;
}

sub doSearchDriver {
    my $driverDirPath = shift;
    my $comment = shift;
    my $searchExactMode = shift;
    my $assumeExactSamples = shift;
    my $fileInfo;
    my ($v1,$v2,$v3);
    my $key;
    my $minCnt;
    my $item;
    my $id;
    my $fw;
    my $tagTable = { };
    my $doneFl;
    my %skipFiles;
    my $newImages = { };
    my $foundContainers = { };
    my $context = {
	images => $newImages,
	foundContainers => $foundContainers,
	comment => $comment,
    };

    # First read in the already expected firmware image files.
    my $fwInfo = findExistingFirmwareFiles();
    reportFirmwareFiles($fwInfo);

    $context->{fwInfo} = $fwInfo;

    foreach $id (keys %$fwInfo) {
	$fw = $fwInfo->{$id};
	$tagTable->{$fw->{tag}}->{$id} = createImageRecord($fw);
	if (defined $minCnt) {
	    $minCnt = $fw->{size} if ($minCnt > $fw->{size});
	} else {
	    $minCnt = $fw->{size};
	}
    }
    foreach $id (keys %$images) {
	$item = $images->{$id};
	next if ($item->{item_type} eq 'container');
	next if (! exists $item->{tag});
	$tagTable->{$item->{tag}}->{$id} = $item;
	if (defined $minCnt) {
	    $minCnt = $fw->{size} if ($minCnt > $fw->{size});
	} else {
	    $minCnt = $fw->{size};
	}
    }
    $context->{tagTable} = $tagTable;
    $context->{tagMinImageSize} = $minCnt;

    # Grab set of files we're going to scan
    my $files = getRecursiveDirEntriesOrFail($driverDirPath);

    print "Performing exact search in @$driverDirPath\n";

    # Look in each file for our expected firmware, using an exact
    # search.  This is fastest.
    foreach $v1 (@$files) {
 	$fileInfo = fetchFileData($v1);
	next if (! defined $fileInfo);
	$id = $fileInfo->{md5_hex};
	# skip files which are actually full images we know about
	$item = undef;
	if (defined $fwInfo->{$id}) {
	    $fw = $fwInfo->{$id};
	    $fw->{got} = 1;
	    $item = createImageRecord($fw);
	} elsif ((defined $images->{$id}) &&
		 ($images->{$id}->{item_type} ne 'container')) {
	    $fw = $images->{$id};
	    $item = createImageRecord($fw);
	    if (! defined $item->{tag}) {
		# We didn't previously know this image's tag.  So
		# figure it out now.
		$item->{tag} = substr($fileInfo->{data},0,4);
	    }
	}
	if (defined $item) {
	    $skipFiles{$id} = 1;
	    print "--> Found $item->{item_type} hiding in plain sight as $fileInfo->{name}\n";
	    $newImages->{$id} = $item;
	    next;
	}
#	searchASingleFile($context,$fileInfo,0);
	searchASingleFileUsingTags($context,$fileInfo,0);
	# (Always do an exact search on all files)
    }

    if ($assumeExactSamples) {
	foreach $id (keys %$fwInfo) {
	    next if (exists $newImages->{$id});
	    $fw = $fwInfo->{$id};
	    $item = createImageRecord($fw);
	    $newImages->{$id} = $item;
	}
    }

    if ($searchExactMode || $assumeExactSamples) {
	return $newImages;
    }
    return $newImages if (foundAllFirmware($fwInfo));
    return $newImages if (!scalar(keys %$fwInfo));

    print "Performing fuzzy search in @$driverDirPath\n";

    # First look in files where we had previously found something
    foreach $v1 (@$files) {
	$fileInfo = fetchFileData($v1);
	$id = $fileInfo->{md5_hex};
	next if (exists $skipFiles{$id});
	next if (! exists $foundContainers->{$id});
	next if (!searchASingleFile($context,$fileInfo,1));
	return $newImages if (foundAllFirmware($fwInfo));
    }

    # Now look in files where we had not previously found something
    foreach $v1 (@$files) {
	$fileInfo = fetchFileData($v1);
	$id = $fileInfo->{md5_hex};
	next if (exists $skipFiles{$id});
	next if (exists $foundContainers->{$id});
	next if (!searchASingleFile($context,$fileInfo,1));
	return $newImages if (foundAllFirmware($fwInfo));
    }

    return $newImages;
}

sub searchMergeResults {
    my $newImages = shift;
    my $id;
    my $item;
    my $curItem;
    my $fImages = { };
    my %ids;
    my $elem;
    my $newFl = 0;

    foreach $id (keys %$newImages) {
	$item = $newImages->{$id};
	if (! exists $images->{$id}) {
	    $fImages->{$id} = $item;
	    next;
	}
	$curItem = $images->{$id};
	if ($item->{item_type} ne 'container') {
	    # Pick up tags for images that didn't have a tag
	    next if ($curItem->{item_type} eq 'container'); # paranoia
	    next if (exists $curItem->{tag});
	    $fImages->{$id} = $item;
	    next;
	}
	next if ($curItem->{item_type} ne 'container'); # paranoia
	%ids = ( );
	foreach $elem (@{$curItem->{elements}}) {
	    $ids{$elem->{id}} = $elem;
	}
	$newFl = 0;
	foreach $elem (@{$item->{elements}}) {
	    if (exists $ids{$elem->{id}}) {
		delete $ids{$elem->{id}};
	    } else {
		$newFl = 1;
	    }
	}
	if ($newFl) {
	    foreach $elem (keys %ids) {
		push @{$item->{elements}},$elem;
	    }
	    $fImages->{$id} = $item;
	}
    }
    foreach $id (keys %$fImages) {
	$images->{$id} = $fImages->{$id};
    }
    return $fImages;
}


# This logic assumes that the firmware files already exist and
# attempts to locate where the data has been embedded within the
# windows driver files.  All files are searched, and if we find the
# embedded data, we'll print out a series of configuration directives
# that can be trivially appended to this script.  The resulting
# program then knows how to ecxtract firmware files from those same
# places.
sub searchDriver {
    my $driverDirPath = shift;
    my $comment = shift;
    my $searchExactMode = shift;
    my $assumeExactSamples = shift;
    my $result = doSearchDriver($driverDirPath,$comment,
				$searchExactMode,
				$assumeExactSamples);
    if (! scalar(%$result)) {
	print <<EOF;
Failed to find any firmware data.  Is it possible that you are
attempting to search compressed files?  (There is no means available
to reliably scan compressed files since unfortunately I do not know
how to uncompress any of it.)
EOF
	return 1;
    }
    my $mergedResult = searchMergeResults($result);
    if (! scalar(%$mergedResult)) {
	print <<EOF;
Firmware data was found, but none of it was anything that we did not
already know about in the configuration database.  So there is nothing
new to add.  This is probably OK.
EOF
	return 0;
    }

    # Print out results...
    my $dba = databaseInternalToExportable({images => $mergedResult});
    my $myname = __FILE__;
    print <<EOF;

Please append the following lines to the end of this program script
(really - just do echo >>$myname and mouse-paste the lines).
# ========CUT HERE========
EOF
    databaseExportableToText(\*STDOUT,$dba);
    print <<EOF;
# ========CUT HERE========

I also strongly encourage you to send me (Mike Isely <isely\@pobox.com>) the
above snippet so that I can update the master copy of this script and
others can benefit from your effort.

EOF
    return 0;
}

# -------------------------------------------------------------------------
# Stuff below here implements firmware extraction (the normal case)

sub recordFirmwareLocation {
    my $fwList = shift;
    my $ip = shift;
    my $fp = shift;
    my $offset = shift;
    my $item_type = $ip->{item_type};
    $fwList->{$item_type} = [ ] if (! exists $fwList->{$item_type});
    push @{$fwList->{$item_type}}, {
	image => $ip,
	hostFileInfo => $fp,
	hostFileOffset => $offset
    };
}

# Scan a set of directories and record information about every file we
# find which matches one of our stored file hashes.
sub findInterestingFiles {
    my $dirPath = shift;
    my $files = getRecursiveDirEntriesOrFail($dirPath);
    my $foundList = { names => {},
		      hashes => {},
		      fw => {}};
    my ($name,$hash,$fileInfo,$cp,$cp2);
    my $item_type;
    my $img;
    foreach $name (@$files) {
	$fileInfo = fetchFileData($name);
	$hash = $fileInfo->{md5_hex};
	$cp = $images->{$hash};
	next if (! defined $cp);
	print "Found firmware data in \"$name\":\n";
	$fileInfo->{metaInfo} = $cp;
	$foundList->{names}->{$name} = $fileInfo;
	$foundList->{hashes}->{$hash} = $fileInfo;
	$item_type = $cp->{item_type};
	if ($item_type eq 'container') {
	    print "  Container $hash:\n";
	    foreach $cp2 (@{$cp->{elements}}) {
		$img = $images->{$cp2->{id}};
		print "    image $img->{item_type} $cp2->{id}" .
		    " (offset $cp2->{offset} size $img->{size})\n";
		recordFirmwareLocation($foundList->{fw},
				       $img,
				       $fileInfo,
				       $cp2->{offset});
	    }
	} else {
	    print "  image $item_type $cp->{id}" .
		" (size $cp->{size})\n";
	    recordFirmwareLocation($foundList->{fw},
				   $cp,
				   $fileInfo,
				   0);
	}
    }
    return $foundList;
}

# Walk through all gathered data and extra one of each type of image
sub selectFirmware {
    my $fwList = shift;
    my $fwPriHash = shift;
    my $fwPriFl;
    my ($fwType,$fwa,$fwp,$iCnt,$fwPri,$key);
    my $fileInfo;
    my $result = { };
    my $i;

    foreach $fwType (keys %$fwList) {
	$fwa = $fwList->{$fwType};
	$iCnt = scalar(@$fwa);
	next if ($iCnt == 0);
	$fwPri = $fwPriHash->{$fwType};
	$fwPriFl = defined $fwPri;
	$fwPri = 0 if (!defined $fwPriFl);
	if ($fwPri >= $iCnt) {
	    $fwPriFl = undef;
	    print "Choice $fwPri for $fwType is too high (limit=$iCnt)\n";
	    $fwPri = 0;
	}
	$fwp = $fwa->[$fwPri];
	if ($iCnt > 1) {
	    $i = $fwPri + 1;
	    if ($i == 1) {
		print "$fwType: $iCnt instances found, designating first instance for extraction\n";
	    } else {
		print "$fwType: $iCnt instances found, designating instance #$i for extraction\n";
	    }
	}
	$result->{$fwType} = $fwp;
    }
    return $result;
}

# Calculate set of host files we need to pull firmware from
sub gatherHostFileUsedList {
    my $fwInfoList = shift;
    my $fwInfo;
    my $fwType;
    my $fwp;
    my $fileInfo;
    my $id;
    my %hlist;
    my @harr;
    foreach $fwType (keys %$fwInfoList) {
	$fwp = $fwInfoList->{$fwType};
	$fileInfo = $fwp->{hostFileInfo};
	$id = $fileInfo->{md5_hex};
	$hlist{$id} = $fileInfo;
    }
    foreach $id (keys %hlist) {
	push @harr, $hlist{$id};
    }
    return \@harr;
}

# Write firmware to a file and report about what we've written.
sub writeFirmwareImage {
    my $fwInfo = shift;
    my $fh = new IO::File;
    my $md5_info;
    my $retCode = undef;
    my $fwp = $fwInfo->{image};
    my $hostFileInfo = $fwInfo->{hostFileInfo};
    my $hostFileOffset = $fwInfo->{hostFileOffset};
    my $fwType = $fwp->{item_type};
    my $imageMetaData = $fwMetaData->{$fwType};
    my $fname = $imageMetaData->{file_name};
    my $hwId = $imageMetaData->{hardware_info};
    my $cmpId = $imageMetaData->{comment};
    my $hostFileName = $hostFileInfo->{name};
    my $comment = $hostFileInfo->{comment};

    my $data = substr($hostFileInfo->{data},
		      $hostFileOffset,
		      $fwp->{size});

    if (!defined $fname) {
	print STDERR "Error: No file name for firmware $fwType\n";
	return $retCode;
    }

    die "Failed to open $fname for writing" unless $fh->open(">$fname");
    $fh->binmode();

    print $fh $data;

    $fh->close();

    print "Wrote $fwType (file $fname):\n";
    print "  Driver package $comment\n" if (defined $comment);
    print "  Intended hardware: \"$hwId\"\n" if (defined $hwId);
    print "  Component: \"$cmpId\"\n" if (defined $cmpId);
    print "  Source $hostFileName\n";
    if (($hostFileOffset == 0) &&
	($fwp->{size} == length($hostFileInfo->{data}))) {
	print "  Size $fwp->{size} bytes (firmware is entire file)\n";
    } else {
	print "  Offset $hostFileOffset size $fwp->{size} bytes\n";
    }
    $md5_info = md5_hex($data);
    if ($md5_info ne $fwp->{id}) {
	print "  Warning: MD5 mismatch on extracted content for $fname\n";
	print "  MD5 Expected: $fwp->{id}\n";
	print "  MD5      Got: $md5_info\n";
    } else {
	print "  MD5 verified ($md5_info)\n";
	$retCode = 1;
    }

    return $retCode;
}

# This scans a directory of Windows driver files and attempts to
# recognize files which contain firmware.  For those it finds, it
# executes the extraction process.
sub doExtract {
    my $driverDirPath = shift;
    my $fwPriority = shift;
    my $foundList;
    my $fwList;
    my $result = { };
    my $okFl = 1;
    my $fwItem;
    my ($fwType,$fwt);
    my %devNotice;
    my $devCount;
    my @devs;
    my $fwInfoList;
    my $retCode = 0;
    my $eCnt = 0;
    my %missingTypes;
    my $hostFileList;
    my %comments;
    my $cmt;
    my $fileInfo;
    my $imageMetaData;

    # Figure out which files we are interested in extracting from, and
    # read & store data from each such interesting file.
    print "\n";
    $foundList = findInterestingFiles($driverDirPath);
    $fwInfoList = $foundList->{fw};
    if (scalar(keys %$fwInfoList) < 1) {
	print "ERROR: Failed to find any files with embedded firmware\n";
	$retCode = 1;
	return $retCode;
    }

    # Calculate list of firmware images to grab and from where they
    # will be grabbed.
    $fwList = selectFirmware($fwInfoList,$fwPriority);
    print "\n";

    $hostFileList = gatherHostFileUsedList($fwList);
    foreach $fileInfo (@$hostFileList) {
	$cmt = $fileInfo->{metaInfo}->{comment};
	next if (! defined $cmt);
	$comments{$cmt} = 1;
    }
    if (scalar keys %comments) {
	print "Driver package info:\n";
	foreach $cmt (sort keys %comments) {
	    print "  $cmt\n";
	}
	print "\n";
    }

    # Extract and write out each selected firmware image.
    foreach $fwType (sort keys %$fwList) {
	$fwItem = $fwList->{$fwType};
	if (!writeFirmwareImage($fwItem)) {
	    $okFl = 0;
	}
	$imageMetaData = $fwMetaData->{$fwType};
	if (exists $imageMetaData->{hardware_info}) {
	    $devNotice{$imageMetaData->{hardware_info}} = 1;
	}
	$eCnt++;
	if (exists $imageMetaData->{dependencies}) {
	    foreach $fwt (@{$imageMetaData->{dependencies}}) {
		next if (exists $missingTypes{$fwt});
		next if (exists $fwList->{$fwt});
		$missingTypes{$fwt} = 1;
	    }
	}
    }
    print "\n" if ($eCnt > 0);
    print "Extracted $eCnt firmware images.\n";

    @devs = keys %devNotice;
    $devCount = scalar @devs;
    if ($devCount > 0) {
	print <<EOF;

Important Note:
  One or more of the firmware files extracted is specific to a
  particular type and model of device.  Please double check that you
  in fact are using that named device (see below).  Some driver CDs
  can include firmware for multiple different hardware releases and we
  want to make sure that you haveve extracted the right one.

EOF
    }
    if ($devCount == 1) {
	print "  Device model is: $devs[0]\n";
    } elsif ($devCount > 1) {
	print "  Devices are:\n",
	my $foo;
	for ($foo = 0; $foo < $devCount; $foo++) {
	    print "    $devs[$foo]\n";
	}
    }
    print "\n";
    if (scalar(keys %missingTypes) > 0) {
	print "NOTE: Expected but did not see the following firmware images:\n";
	foreach $fwType (sort keys %missingTypes) {
	    $imageMetaData = $fwMetaData->{$fwType};
	    print "  $fwType ($imageMetaData->{file_name})\n";
	}
	$okFl = 0;
    }
    if (!$okFl) {
	print "NOTE: Firmware extraction was not entirely successful.\n";
	$retCode = 1;
    }
    return $retCode;
}

# -------------------------------------------------------------------------
# Main

# Our "main"
sub mainFunc {
    my $searchMode = 0;
    my $extractMode = 1;
    my $assumeExactSamples = 0;
    my $searchExactMode = 0;
    my $inventoryMode = 0;
    my $exportDatabase;
    my $importDatabase;
    my $retCode = 0;
    my $comment;
    my $key;
    my $val;
    my %f2Names;
    my %fPriority;
    my @driverDirPath;
    my $dbi;

    print "fwextract version: $parsedVers\n";

    exit 1 if (!GetOptions("fwFile=s" => \%f2Names,
			   "fwPriority=s" => \%fPriority,
			   "comment=s" => \$comment,
			   "driverDir=s" => \@driverDirPath,
			   "inventory!" => \$inventoryMode,
			   "exportDatabase=s" => \$exportDatabase,
			   "importDatabase=s" => \$importDatabase,
			   "search!" => \$searchMode,
			   "assumeExactSamples!" => \$assumeExactSamples,
			   "searchExact!" => \$searchExactMode));

    if (defined $importDatabase) {
	print "Importing configuration database from $importDatabase\n";
	$dbi = databaseImportFromFile($importDatabase);
	if (!defined $dbi) {
	    die "Failed to import configuration database $importDatabase\n";
	}
    } else {
	print "Reading internal configuration database\n";
	$dbi = databaseImportFromInternal();
	if (!defined $dbi) {
	    die "Failed to load internal configuration database.\n";
	}
    }
    $images = $dbi->{images};
    $fwMetaData = $dbi->{fwMetaData};

    if (scalar keys %f2Names) {
	foreach $key (keys %f2Names) {
	    $val = $f2Names{$key};
	    if (! defined $val) {
		print "Image $key has no associated name\n";
		next;
	    }
	    if (! exists $fwMetaData->{$key}) {
		print "Image $key not defined; can't set file name\n";
		next;
	    }
	    $fwMetaData->{$key}->{file_name} = $val;
	    print "Image $key file name set to $val\n";
	}
    }

    if ($inventoryMode) {
	inventoryImagesToHandle({images => $images,
				 fwMetaData => $fwMetaData},
				\*STDOUT);
	$extractMode = 0;
    }

    if (defined $exportDatabase) {
	$extractMode = 0;
    }

    push @driverDirPath,@ARGV;
    if (scalar(@driverDirPath) == 0) {
	push @driverDirPath,"win_driver";
    }

    $searchMode = 1 if ($searchExactMode);
    print "driverDirPath is @driverDirPath\n" if ($extractMode);
    if ($searchMode) {
	$extractMode = 0;
	print "Searching for firmware images in driver directory\n";
	$retCode = searchDriver(\@driverDirPath,$comment,
				$searchExactMode,$assumeExactSamples);
    }

    if ($extractMode) {
	print "Extracting firmware files from driver directory\n";
	$retCode = doExtract(\@driverDirPath,\%fPriority);
    }

    if (defined $exportDatabase) {
	print "Exporting configuration database to $exportDatabase\n";
	databaseExportToFile({images => $images,
			      fwMetaData => $fwMetaData},
			     $exportDatabase);
    }

    exit $retCode;
}

# Don't autoflush stdout so that progress printing works OK.
autoflush STDOUT !0;

mainFunc();

# Everything below this point is configuration data which is read by
# this program at start up, if --importDatabase is not used.  This
# data is parsed into an "exportable database" format which is
# compatible as a Perl data structure.  Then that "eportable" format
# is further processed into an internal database format which is in
# turn seeded into the $images and $fwMetaData global variables.
# Those are then used by the extraction process and the training
# process.

__DATA__

fw_metadata "fw1-24xxx-01" "v4l-pvrusb2-24xxx-01.fw"
  flags fuzzy_search
  comment "Cypress FX2 for Hauppauge PVR USB2 Model 24xxx"
  hardware_info "Hauppauge PVR USB2 Model 24xxx"
  dep fw2
  dep fw3
fw_metadata "fw1-29xxx-01" "v4l-pvrusb2-29xxx-01.fw"
  flags fuzzy_search
  comment "Cypress FX2 for Hauppauge PVR USB2 Model 29xxx"
  hardware_info "Hauppauge PVR USB2 Model 29xxx"
  dep fw2
fw_metadata "fw1-73xxx-01" "v4l-pvrusb2-73xxx-01.fw"
  flags fuzzy_search
  comment "Cypress FX2 for Hauppauge HVR-1950 / HVR-1900"
  hardware_info "Hauppauge HVR-1950 / HVR-1900"
  dep fw2
  dep fw3
fw_metadata fw2 "v4l-cx2341x-enc.fw"
  comment "Conexant cx23416 family mpeg encoder"
fw_metadata fw3 "v4l-cx25840.fw"
  comment "Conexant cx25840 family video / audio processor"
fw_version 1cb3c48a6684126f5e503a434f2d636b.a70d0000 fw2 376836
fw_version 2c97465a4528807709301899630ba0e1.a70d0000 fw2 262144
fw_version 34d213394328adf78e2fc9f1411691b0.0215dd00 "fw1-24xxx-01" 8192
fw_version 3a4803384f749d644ee1f1ca9dcb12fa.022db602 fw3 14264
fw_version 3b7288416144467369ed2b5b10cf931d.0216f130 "fw1-29xxx-01" 8192
fw_version 5c22fd758ea64a1b8df7e2eb59da0842.02272f22 fw3 12559
fw_version 62569003244398e652144fe792296c78 fw3 16382
fw_version 78329962316b6aefef455aa001cddfcc.0218dfef "fw1-73xxx-01" 8192
fw_version 79c5daf4cde87036c834a314b4929fb1.a70d0000 fw2 262144
fw_version 95bc688d3e7599fd5800161e9971cc55.022c5b22 fw3 16382
fw_version 9b39b3d3bba1ce2da40f82ef0c50ef48.a70d0000 fw2 376836
fw_version a9f8f5d901a7fb42f552e1ee6384f3bb.022c95ff fw3 16382
fw_version ab75947ef1b086e26f9b08e628baa02e.a70d0000 fw2 262144
fw_version ac95c4c24e4edca0f2af5e44867a7204.021cf702 "fw1-73xxx-01" 16384
fw_version b3704908fd058485f3ef136941b2e513.022c6222 fw3 16382
fw_version c5749da3eb141e87634ff1e2c1e6f390.022d1700 fw3 13837
fw_version c6b01cb318b909cc52d2cf643ca269a1.0218dfef "fw1-73xxx-01" 8192
fw_version ce5239749d5ab1c5aba7b1fe57ba081b.0217dc00 "fw1-24xxx-01" 8192
fw_version d85cb08382395390dc95ac6ebc2205f9.a70d0000 fw2 262144
fw_version dadb79e9904fc8af96e8111d9cb59320.022bf422 fw3 16382
fw_version ffed594f0edea15de8c19cfd13bc4adf.0215e400 "fw1-24xxx-01" 8192
container 02e4934b8525db1fee074f57a0c27304
  comment "Hauppauge CDROM 2.5.22329 (credit: Eliette Mathey <elmat52\@yahoo.fr>)"
  image 79c5daf4cde87036c834a314b4929fb1 279040
  image 3b7288416144467369ed2b5b10cf931d 1065472
container 0d635430e2d333c87a7fbd64c513e7fa
  comment "OnAir Sasem original CD"
  image 2c97465a4528807709301899630ba0e1 162048
container 108ea035f907c80c2c22435c2ec39b8a
  comment "Hauppauge cd_4.5a.zip"
  image c6b01cb318b909cc52d2cf643ca269a1 374504
container 1b570b23375b817498007ccf085c27c3
  comment "Hauppauge pvrusb2_2273_24023.zip (also on CDs included with 24xxx models in April 2006)"
  image 34d213394328adf78e2fc9f1411691b0 1415264
  image d85cb08382395390dc95ac6ebc2205f9 292960
  image 79c5daf4cde87036c834a314b4929fb1 555104
  image c5749da3eb141e87634ff1e2c1e6f390 1423456
  image 3b7288416144467369ed2b5b10cf931d 1079392
container 1cfca9ac70343dc596dd8d8c36b157c0
  comment "Hauppauge WinTV CD 3.4b"
  image ce5239749d5ab1c5aba7b1fe57ba081b 169456
container 2561b64830a76673a6d0b869ed7679b4
  comment "Hauppauge 73drv_27238.zip"
  image ac95c4c24e4edca0f2af5e44867a7204 437352
container 3dc49fe6a8eefa25c72573557c827624
  comment "Hauppauge pvrusb2_2273_23298"
  image 79c5daf4cde87036c834a314b4929fb1 289696
  image 3b7288416144467369ed2b5b10cf931d 1076128
container 5892ff339f828695bfd7852f4449b8f9
  comment "Hauppauge WinTV CD 3.4b"
  image ce5239749d5ab1c5aba7b1fe57ba081b 128104
container 5d42dc2d75dd59e2ac4ed02f1f1a7be3
  comment "OnAir Creator CR_Drv3000"
  image 2c97465a4528807709301899630ba0e1 176768
container 6576e6cc206a4b5469345e7ebe578abf
  comment "Hauppauge pvrusb2_inf (related to pvrusb2_26_23055)"
  image 79c5daf4cde87036c834a314b4929fb1 286560
  image 3b7288416144467369ed2b5b10cf931d 1072992
container 80f5fa3e47e512a7fc86ada0a9f8c08d
  comment "OnAir Creator CR_Drv3203"
  image 2c97465a4528807709301899630ba0e1 104576
container 99836e41ccb28c7b373e87686f93712a
  comment "WinTV CD 3.4b"
  image 5c22fd758ea64a1b8df7e2eb59da0842 0
container 9abbce9a039ff915b531485d314c82d3
  comment "OnAir Creator CR_Drv20061"
  image 2c97465a4528807709301899630ba0e1 170880
container 9c5fc27cd3a5c2307c911cad92c95689
  comment "Hauppauge pvrusb2_27_23178"
  image 79c5daf4cde87036c834a314b4929fb1 286784
  image 3b7288416144467369ed2b5b10cf931d 1073216
container 9cebcd0f6d47e0ae1676d667d7fb54b0
  comment "Hauppauge DriverVer=03/04/2005,2.2.73.23063 (credit: Fedor Bezrukov <Fedor.Bezrukov\@epfl.ch>)"
  image 79c5daf4cde87036c834a314b4929fb1 281888
  image 3b7288416144467369ed2b5b10cf931d 1068320
container 9dc72435a12a6fd365bbb64aabf729fb
  comment "GOTVIEW USB2.0 DVD2"
  image 79c5daf4cde87036c834a314b4929fb1 592544
  image 62569003244398e652144fe792296c78 1532504
container a86445d3763546b04e22110a31d3704f
  comment "Hauppauge Shipped with first 24xxx models (credit: Richard Vieira <rever75\@gmail.com>)"
  image 34d213394328adf78e2fc9f1411691b0 1414752
  image d85cb08382395390dc95ac6ebc2205f9 292448
  image c5749da3eb141e87634ff1e2c1e6f390 1422944
container b100615d9497d205b065a985bc9d73c3
  comment "Hauppauge pvrusb2_inf_26c (related to pvrusb2_26_23097)"
  image 79c5daf4cde87036c834a314b4929fb1 286496
  image 3b7288416144467369ed2b5b10cf931d 1072928
container b4cfe83f1aa235141a62cf4d715c354d
  comment "Hauppauge WinTV CD 3.4b"
  image d85cb08382395390dc95ac6ebc2205f9 300448
  image 79c5daf4cde87036c834a314b4929fb1 562592
  image 5c22fd758ea64a1b8df7e2eb59da0842 1430944
  image 3b7288416144467369ed2b5b10cf931d 1086880
container bf1cc4da051b1db04091562c86c691ff
  comment "Hauppauge pvrusb2_23_21351"
  image ab75947ef1b086e26f9b08e628baa02e 201152
  image 3b7288416144467369ed2b5b10cf931d 987584
container d1b38599f3678f536eb61406f4f0da6d
  comment "Hauppauge WinTV CD 3.4b"
  image d85cb08382395390dc95ac6ebc2205f9 31928
container dfd6c9b398e5155ad10569975795dae0
  comment "Hauppauge 73drv_27238.zip"
  image ac95c4c24e4edca0f2af5e44867a7204 697456
container e762ec8dee79f73567c9c9a15b6e384d
  comment "Hauppauge cd_4.5a.zip"
  image c6b01cb318b909cc52d2cf643ca269a1 603728
container ee16dd87b5180b45ad13249aa7922e7b
  comment "Hauppauge WinTV CD 3.4b"
  image d85cb08382395390dc95ac6ebc2205f9 537608
container eedb017a8cc2e8dc9825d1a1b3e4f034
  comment "Hauppauge pvrusb2_inf_24117.zip (for both 24xxx and 29xxx devices)"
  image ffed594f0edea15de8c19cfd13bc4adf 1417088
  image d85cb08382395390dc95ac6ebc2205f9 294784
  image 79c5daf4cde87036c834a314b4929fb1 556928
  image 5c22fd758ea64a1b8df7e2eb59da0842 1425280
  image 3b7288416144467369ed2b5b10cf931d 1081216
container fc7dcdef8f17d3c5decc880673ea5bd5
  comment "Hauppauge WinTV CD 3.4b"
  image d85cb08382395390dc95ac6ebc2205f9 537608
container b03080695738a3edcdc06a50712aaf8d
  comment "Hauppauge pvr-usb2-24xxx_25191.zip (credit: Gary Buhrmaster <gary.buhrmaster@gmail.com>)"
  image ce5239749d5ab1c5aba7b1fe57ba081b 169840
container b7c7577704834957dcda22ea27b268fc
  comment "Hauppauge pvr-usb2-24xxx_25191.zip (credit: Gary Buhrmaster <gary.buhrmaster@gmail.com>)"
  image ce5239749d5ab1c5aba7b1fe57ba081b 128232
container 58ccc7912760bd6c344152a2fdc41287
  comment "Hauppauge 73drv_29010.zip (credit: Michael Burr <michael.burr@precor.com>)"
  image ac95c4c24e4edca0f2af5e44867a7204 445672
container c8c50d67c2eba68227cadfdb76956045
  comment "Hauppauge 73drv_29010.zip (credit: Michael Burr <michael.burr@precor.com>)"
  image ac95c4c24e4edca0f2af5e44867a7204 708464