#!/usr/bin/perl
#
# Samba Printing Packages - Construction Utility
#
# Copyright (C) 2000 VA Linux Systems, Inc. All rights reserved.
#
# This utility takes a vendor's printer driver and turns it into a nice form
# for installation into a Samba server.

use strict;

use FindBin;
use lib "$FindBin::RealBin/../lib/perl5";

use Carp;
use Getopt::Long;
use File::Basename;
use File::Copy;
use File::Path;
use POSIX qw(tmpnam);

use INF qw(read_inf inf_get_key inf_get_keys inf_has_key);
use inf_nt qw(parse_inf_nt get_models);
use MSExpand;

sub usage
{
    print "usage: $0 <options> SPEC ...\n";
    print "       --name=NAME         Name of the package\n";
    print "       --version=VERSION   Version of the package\n";
    print "       --display-name=DN   Pretty name for GUI tools, etc.\n";
    print "       SPEC                Either a work directory or archive.\n";
    print "       --arch=ARCH         Override architecture: win95, win98, nt, W32X86,\n";
    print "                           nt-mips, mips, W32mips, nt-alpha, alpha, W32alpha,\n";
    print "                           nt-ppc, ppc, W32ppc\n";
    print "       --inf=INF_FILENAME  Override name of INF file\n";
    print "       -m MANUFACTURER     Override manufacturer name in INF\n";
    print "       --model=MODEL       Override model name in devices section\n";
    print "       --debug             Display debugging messages.\n";
    print "\n";
    print "hypothetical example:\n";
    print "$0 --name=\"hp4050\" --version=0.01\n";
    print "  --display-name=\"HP LaserJet 4050\" /tmp/pkg-work-dir\n";
    exit(1);
}

# Convert an architecture name to a subdirectory name.
sub arch2subdir
{
    croak("arch2subdir(ARCH)") if @_ != 1;
    my($arch) = @_;
    $arch =~ tr/A-Z/a-z/;

    if ($arch eq 'nt' or $arch eq 'w32x86') {
	return "W32X86";
    } elsif ($arch eq 'win95' or $arch eq 'win98'or $arch eq 'win40') {
	return "WIN40";
    } elsif ($arch eq 'nt-mips' or $arch eq 'mips' or $arch eq 'w32mips') {
	return "W32mips";
    } elsif ($arch eq 'nt-alpha' or $arch eq 'alpha' or $arch eq 'w32alpha') {
	return "W32alpha";
    } elsif ($arch eq 'nt-ppc' or $arch eq 'ppc' or $arch eq 'w32ppc') {
	return "W32ppc";
    } else {
	return undef;
    }
}

# Convert a short architecture name to a long name.
sub arch2longname
{
    croak("arch2longname(ARCH)") if @_ != 1;
    my($arch) = @_;
    $arch =~ tr/A-Z/a-z/;

    if ($arch eq 'w32x86') {
	return "Windows NT X86";
    } elsif ($arch eq 'win40') {
	return "Windows 95/98";
    } elsif ($arch eq 'w32alpha') {
	return "Windows NT Alpha";
    } elsif ($arch eq 'w32mips') {
	return "Windows NT MIPS";
    } elsif ($arch eq 'w32ppc') {
	return "Windows NT PowerPC";
    } else {
	return undef;
    }
}

# Return the contents of a directory as an array.
sub get_files_in_dir
{
    croak("get_files_in_dir(DIR)") if @_ != 1;
    my($dir) = @_;
    my @files = ();
    local(*DIR);

    if (opendir(DIR, $dir)) {
	my $fname;

	while (defined($fname = readdir(DIR))) {
	    next if $fname eq '.' or $fname eq '..';
	    push(@files, $fname);
	}
	closedir(DIR);
    }

    return @files;
}

# Scan an array of filenames for a filename matching the passed filename
# while ignoring case. (Solves problem with case-sensitivity on UNIX.)
sub get_real_filename
{
    croak("get_real_filename(FILENAME,FILE1,FILE2,...)") if @_ <= 1;
    my $lookup_fname = shift @_;

    # Make the filename we are searching for be in lower-case.
    $lookup_fname =~ tr/A-Z/a-z/;

    foreach my $fname (@_) {
	my $lc_fname = $fname;
	$lc_fname =~ tr/A-Z/a-z/;

	return $fname if $lookup_fname eq $lc_fname;
    }

    return undef;
}

# Create a temporary directory and extract all files in the provided ZIP
# file into the directory. The subdirectory structure of the ZIP file is
# not replicated. Return the temporary directory.
sub unpack_zip
{
    croak("unpack_zip(ZIP_FILENAME)") if @_ != 1;
    my($zip_fname) = @_;

    # Create the temporary directory.
    my $tempdir = tmpnam();
    if (! mkdir($tempdir, 0700)) {
	print STDERR "$0: unable to make temporary subdirectory: $!\n";
	return undef;
    }

    # Use the unzip utility to do all the hard work. Hope it's in the PATH ...
    system("unzip -qq -o -j $zip_fname -d $tempdir");

    return $tempdir;
}

# Return the passed filename with any extension replaced with a underscore.
sub add_trailing_underscore
{
    croak("add_trailing_underscore(FILENAME)") if @_ != 1;
    my($fname) = @_;

    my($name, $path, $suffix) = fileparse($fname, '\..*');
    substr($suffix, length($suffix) - 1, 1) = "_";
    return $name . $suffix;
}

my($pkg_name, $pkg_version, $display_name, $default_arch, $default_inf_fname,
   $default_manufacturer, $default_model, @SPECS, $debug);

# All command line arguments that did not fit into 
# getopt (that is normally the driver.exe, driver.zip or 
# the driver directory are the args of this function
sub process
{
    my($arg) = @_;
    my $hash = {
	'location' => $arg,
    };

	push(@SPECS, $hash);
}

Getopt::Long::Configure("bundling");
Getopt::Long::Configure("permute");
GetOptions("name|n=s" => \$pkg_name,
	   "version|v=s" => \$pkg_version,
	   "display-name|N=s" => \$display_name,
	   "inf-fname|inf|i=s" => \$default_inf_fname,
	   "architecture|arch|a=s" => \$default_arch,
	   "manufacturer|m=s" => \$default_manufacturer,
	   "model|d=s" => \$default_model,
	   "debug" => \$debug,
	   "<>" => \&process);

usage() unless $pkg_name ne '' and $pkg_version ne '' and $display_name ne '';

# Some debugging
print "With the command line options you have configured this:\n";
print "pkg_name               = \"$pkg_name\"\n";
print "pkg_version            = \"$pkg_version\"\n";
print "display_name           = \"$display_name\"\n";
print "default_inf_fname      = \"$default_inf_fname\"\n";
print "default_arch           = \"$default_arch\"\n";
print "default_manufacturer   = \"$default_manufacturer\"\n";
print "default_model          = \"$default_model\"\n";
print "debug                  = \"$debug\"\n\n";


# Complain if no driver spec arguments were given.
if (scalar(@SPECS) == 0) {
    print STDERR "$0: no driver specifications found\n";
    usage();
}

# insert the default parameter here
foreach my $hash (@SPECS) {
if ($default_inf_fname ne '') {
	$hash->{'inf_fname'} = $default_inf_fname;
	$default_inf_fname = "";
    }
  
if ($default_arch ne '') {
	$hash->{'arch'} = $default_arch;
	$default_arch = "";
    }

if ($default_manufacturer ne '') {
	$hash->{'manufacturer'} = $default_manufacturer;
	$default_manufacturer = "";
    }

if ($default_model ne '') {
	$hash->{'model'} = $default_model;
	$default_model = "";
    }
}

# Some Debugging 
foreach my $schluessel (@SPECS) {
  print "$schluessel  =  \%SPECS{$schluessel}\n";
}

# Create and move into a subdirectory to use to build the package.
my $pkgdir = "/tmp/printpkg-$$-${pkg_name}-$pkg_version";
if (! mkdir($pkgdir, 0755)) {
    print STDERR "$0: unable to make temporary subdirectory: $!\n";
    exit(1);
}

# Install an exit handler to remove the package directory when done.
my @byebye_dirs = ($pkgdir);
END { foreach my $path (@byebye_dirs) { rmtree($path, 0, 0); } }

# Build the first part of control file as just text in a variable for now.
my $control_text = "[common]\n";
$control_text .= "name=${pkg_name}\n";
$control_text .= "version=${pkg_version}\n";
$control_text .= "display_name=\"${display_name}\"\n";

# Build the list of files for the package.
my @pkg_files = ("control");

# Announce the package that is being built.
print "Package: ${pkg_name}-${pkg_version}.tar.gz\n";
print "Display Name: ${display_name}\n";

# Loop for each driver spec provided by the user.
foreach my $spec (@SPECS) {
    my($workdir, $section, $inf_fname, $real_inf_fname, $manufacturer, $model);

    # Print a blank line to seperate from header and other archs.
    print "\n";

    # The first argument for a driver should either be a work directory
    # with all of the files unpacked or an archive file that we should
    # unpack.
    if (-d $spec->{location}) {
	# User has given us a directory. Use the value as is.
	$workdir = $spec->{location};
	print "Location: $workdir\n";
    } elsif (-f $spec->{location}) {
	# User has given us a file. Check to see what type of archive it is.
	if ($spec->{location} =~ /\.zip$/i or $spec->{location} =~ /\.exe$/i) {
	    $workdir = unpack_zip($spec->{location});
	    if (not defined $workdir) {
		print "ERROR: Unable to unpack archive, skipping ...\n";
		next;
	    }

	    # Add this directory to list of directories to be removed.
	    push(@byebye_dirs, $workdir);

	    print "Using archive $spec->{location} for files.\n";
	} else {
	    print "ERROR: Unsupported extension for archive, skipping...\n";
	    next;
	}
    } else {
	print "ERROR: You must specify a work directory or archive.\n";
	exit(1);
    }

    # Scan the work directory for a list of all the files.
    my @workdir_files = get_files_in_dir($workdir);

    # Now attempt to infer the name of the .INF file.
    if ($spec->{inf_fname} ne '') {
	  $inf_fname = $spec->{inf_fname};
	  $real_inf_fname = get_real_filename($inf_fname, @workdir_files);
    } else {
	my @inf_files = grep { /\.inf/i } @workdir_files;
	if (scalar(@inf_files) == 1) {
	    $inf_fname = $inf_files[0];
	    $real_inf_fname = $inf_files[0];
	    print "Using file $real_inf_fname for INF information.\n";
	} elsif (scalar(@inf_files) == 0) {
	    print "ERROR: No INF file found in the provided files.\n";
	    exit(1);
	} else {
	    print "ERROR: Unable to infer which INF file to use.\n";
	    print "ERROR: Use the -i option with one of the following files:\n";
	    foreach my $x (@inf_files) {
		print "  $x\n";
	    }
	    exit(1);
	}
    }

    # Parse the .INF file provided.
    my $inf = read_inf("$workdir/$real_inf_fname");
    if (not defined $inf) {
	print "ERROR: Unable to read INF file `$real_inf_fname', skipping ...\n";
	next;
    }

    # Infer the target architecture from the INF signature or use the
    # one provided on the command-line.
    if ($spec->{arch} ne '') {
	$section = arch2subdir($spec->{arch});
	if (not defined $section) {
	    print "ERROR: Unknown architecture name `$spec->{arch}'.\n\n";
	    usage();
	}
    } elsif (inf_get_keys($inf, "Version", "Signature") =~ /^\$Windows NT\$$/i) {
	$section = 'W32X86';
    } elsif (inf_get_keys($inf, "Version", "Signature") =~ /^\$CHICAGO\$$/i)  {
	$section = 'WIN40';
    } else {
	print "ERROR: Unable to infer target architecture, use --arch option to specify one.\n";
	exit(1);
    }

    # Announce the architecture being used.
    print "Architecture: ", arch2longname($section);
    print " (detected from INF)" if $spec->{arch} eq '';
    print "\n";

    # Check to see if the INF file's signature matches the architecture.
    if ($section eq 'W32X86' or $section eq 'W32alpha'
	or $section eq 'W32mips' or $section eq 'W32ppc') {
	if (inf_get_keys($inf, "Version", "Signature") !~ /^\$Windows NT\$$/i) {
	    print "WARNING: INF signature is not a Windows NT signature.\n";
	}
    } elsif ($section eq 'WIN40') {
	if (inf_get_keys($inf, "Version", "Signature") !~ /^\$CHICAGO\$$/i) {
	    print "WARNING: INF signature is not a Windows 95/98 signature.\n";
	}
    }

    # Determine the manufacturer string to use.
    if ($spec->{manufacturer} ne '') {
	$manufacturer = $spec->{manufacturer};
    } else {
	if (inf_has_key($inf, "Manufacturer")) {
	    my @keys = keys %{inf_get_key($inf, "Manufacturer")};
	    if (scalar(@keys) == 1) {
		$manufacturer = $keys[0];
	    } elsif (scalar(@keys) == 0) {
		print "ERROR: INF file had no manufacturers listed.\n";
		exit(1);
	    } else {
		print "ERROR: Unable to infer which manufacturer to use.\n";
		print "ERROR: Use the -m option to specify one of the following:\n";
		foreach my $x (@keys) {
		    print "  \"$x\"\n";
		}
		exit(1);
	    }
	} else {
	    print "ERROR: INF file does not have a [Manufacturer] section.\n";
	    exit(1);
	}
    }

    # Announce the manufacturer being used.
    print "Manufacturer: $manufacturer";
    print " (detected from INF)" if $spec->{manufacturer} eq '';
    print "\n";

    # Determine the model string to use.
    if ($spec->{model} ne '') {
	$model = $spec->{model};
    } else {
	my @models = get_models($inf, $manufacturer);
	if (scalar(@models) == 1) {
	    $model = $models[0];
	} elsif (scalar(@models) == 0) {
	    print "ERROR: INF file had no models listed.\n";
	    exit(1);
	} else {
	    print "ERROR: Unable to infer which model to use.\n";
	    print "ERROR: Use the -d option to specify one of the following:.\n";
	    foreach my $x (@models) {
		print "  \"$x\"\n";
	    }
	    exit(1);
	}
    }

    # Announce the model being used.
    print "Model: $model";
    print " (detected from INF)" if $spec->{model} eq '';
    print "\n";

    # Parse the driver .INF file into magical Perl data structure.
    my %info = parse_inf_nt($inf, $manufacturer, $model, $section);
    exit(1) unless defined %info;

    # Create a subdirectory in the package toplevel for this architecture.
    if (! mkdir("$pkgdir/$section", 0755)) {
	print "ERROR: Unable to create subdirectory in package ($!).\n";
	exit(1);
    }

    # Copy the .INF file to the architecture subdirectory.
    if (! copy("$workdir/$real_inf_fname", "$pkgdir/$section/")) {
	print "ERROR: Unable to copy $workdir/$real_inf_fname to package ($!)\n";
	exit(1);
    }

    # Copy each of the destination files to the architecture subdirectory.
    foreach my $filehash (@{$info{CopyFiles}}) {
	my $dst_fname = $filehash->{DstFilename};
	my $src_fname = $filehash->{SrcFilename};
	my $real_dst_fname = get_real_filename($dst_fname, @workdir_files);
	my $real_src_fname = get_real_filename($src_fname, @workdir_files);
	my $file_action = 0; # 0 - copy, 1 - expand
	my $action_src = ""; # source file to expand or copy from
	my $action_dst = ""; # destination directory for copy or expanded file

	# Output a status message for the user.
	print ">>> file - `$src_fname' -> `$dst_fname'\n" if $debug;

	# Test for the existence of the destination filename in
	# the work directory.
	if (-f "$workdir/$real_dst_fname") {
	    # Copy the destination file to the architecture subdirectory.
	    $file_action = 0;
	    $action_src = "$workdir/$real_dst_fname";
	    $action_dst = "$pkgdir/$section/";
	} elsif (-f "$workdir/$real_src_fname") {
	    # Check to see if the source file is compressed.
	    if ($real_src_fname =~ /_$/) {
		$file_action = 1;
		$action_src = "$workdir/$real_src_fname";
		$action_dst = "$pkgdir/$section/$dst_fname";
	    } else {
		$file_action = 0;
		$action_src = "$workdir/$real_src_fname";
		$action_dst = "$pkgdir/$section/$dst_fname";
		print "WARNING: Copying source file `$src_fname' to `$dst_fname'.\n";
	    }
	} else {
	    # Check to see if there is a source filename with a trailing _
	    # which signifes compression. Some INF files have the source
	    # filename specified without the _ in it. Icky spoo-tang.
	    my $u_src_name = get_real_filename(add_trailing_underscore($src_fname), @workdir_files);
	    my $u_dst_name = get_real_filename(add_trailing_underscore($dst_fname), @workdir_files);
	    if (-f "$workdir/$u_dst_name") {
		$file_action = 1;
		$action_src = "$workdir/$u_dst_name";
		$action_dst = "$pkgdir/$section/$dst_fname";
	    } elsif (-f "$workdir/$u_src_name") {
		$file_action = 1;
		$action_src = "$workdir/$u_src_name";
		$action_dst = "$pkgdir/$section/$dst_fname";
	    } else {
		print "ERROR: Unable to determine what to do with this file:\n";
		print "ERROR: Source filename is `$src_fname'.\n";
		print "ERROR: Destination filename is `$dst_fname'.\n";
		exit(1);
	    }
	}

	# Implement whatever action identified above.
	if ($file_action == 0) {
	    # Copy file to package.
	    print ">>> Copying `$action_src' to `$action_dst'.\n" if $debug;
	    if (! copy($action_src, $action_dst)) {
		print "ERROR: Unable to copy `$action_src' to package.\n";
		exit(1);
	    }
	} elsif ($file_action == 1) {
	    # Expand the source file into the package.
	    print ">>> Expanding `$action_src' to `$action_dst'.\n" if $debug;
	    if (! ms_expand($action_src, $action_dst)) {
		print "ERROR: Unable to expand `$action_src' to package.\n";
		exit(1);
	    }
	} else {
	    print "INTERNAL ERROR: Unknown file action given.\n";
	    exit(1);
	}
    }

    # Add a section to the control file for this architecture.
    $control_text .= "\n";
    $control_text .= "[$section]\n";
    $control_text .= "inf_fname=${inf_fname}\n";
    $control_text .= "manufacturer=\"$manufacturer\"\n";
    $control_text .= "model=\"$model\"\n";

    # Add list of files for package.
    push(@pkg_files, "$section/*");
}

# Write the package's control file.
if (! open(CONTROL, ">$pkgdir/control")) {
    print "ERROR: Unable to create control file in package ($!).\n";
    exit(1);
}
print CONTROL $control_text;
close(CONTROL);

# Create the the package file.
system("( cd $pkgdir/ ; tar cf - " . join(' ', @pkg_files) . " ) | gzip -9 > ${pkg_name}-${pkg_version}.tar.gz");

print "\nPackage created successfully as ${pkg_name}-${pkg_version}.tar.gz\n";