#!/usr/bin/perl 
# -*-perl-*-

#use strict;
#use diagnostics;

use LWP::UserAgent;
use File::Path;
use File::Find;
use File::Basename;

$| = 1;

# exit value
my $exit = 0;

# deal with arguments
my $vardir = $ARGV[0];
my $method = $ARGV[1];
my $option = $ARGV[2];

if ($option eq "manual" ) {
  print "manual mode not supported yet\n";
  exit 1;
}
#print "vardir: $vardir, method: $method, option: $option\n";

# get info from control file
$dldir="debian";


do "$vardir/methods/http/vars" or die "Could not find state file (re-run Access method)";
chdir "$vardir/methods/http";
mkpath(["$dldir"], 0, 0755);

# get a block
# returns a ref to a hash containing flds->fld contents
# white space from the ends of lines is removed and newlines added
# (no trailing newline).
# die's if something unexpected happens
sub getblk {
    my $fh = shift;
    my %flds;
    my $fld;
    while (<$fh>) {
	if ( ! /^$/ ) {
	    FLDLOOP: while (1) {
		if ( /^([^ \t]+):[ \t]*(.*)[ \t]*$/ ) {
		    $fld = lc($1);
		    $flds{$fld} = $2;
		    while (<$fh>) {
			if ( /^$/ ) {
			    return %flds;
			} elsif ( /^([ \t].*)$/ ) {
			    $flds{$fld} = $flds{$fld} . "\n" . $1;
			} else {
			    next FLDLOOP;
			}
		    }
		    return %flds;
		} else {
		    die "Expected a start of field line, but got:\n$_";
		}
	    }
	}
    }
    return %flds;
}

# process status file
# create curpkgs hash with version (no version implies not currently installed)
# of packages we want
print "Processing status file...\n";
my %curpkgs;
sub procstatus {
    my (%flds, $fld);
    open (STATUS, "$vardir/status") or die "Could not open status file";
    while (%flds = getblk(\*STATUS), %flds) {
	if($flds{'status'} =~ /^install ok/) {
	    my $cs = (split(/ /, $flds{'status'}))[2];
	    if(($cs eq "not-installed") || 
	       ($cs eq "half-installed") ||
	       ($cs eq "config-files")) {
		$curpkgs{$flds{'package'}} = "";
	    } else {
		$curpkgs{$flds{'package'}} = $flds{'version'};
	    }
	}
	if($flds{'status'} =~ /^install reinstreq/) {
	  $curpkgs{$flds{'package'}} = "";
	}
    }
    close(STATUS);
}
procstatus();

sub dcmpvers {
    my($a, $p, $b) = @_;
    my ($r);
    $r = system("/usr/bin/dpkg", "--compare-versions", "$a", "$p", "$b");
    $r = $r/256;
    if( $r == 0) {
	return 1;
    } if( $r == 1) {
	return 0;
    }
    die "dpkg --compare-versions $a $p $b - failed with $r"
}

# process package files, looking for packages to install
# create a hash of these packages pkgname => version, filenames...
# filename => md5sum, size
# for all packages
my %pkgs;
my %pkgfiles;
my %site;    # site to download each package from

sub procpkgfile {
    my $fn = shift @_;
    my $site = shift @_;
    my(%flds, $fld);
    open(PKGFILE, "gunzip <$fn |") or die "Could not open package file $fn";
    while(%flds = getblk(\*PKGFILE), %flds) {
	my $pkg = $flds{'package'};
	my $ver = $curpkgs{$pkg};
	my @files = split(/[ \t\n]+/, $flds{'filename'});
	my @sizes = split(/[ \t\n]+/, $flds{'size'});
	my @md5sums = split(/[ \t\n]+/, $flds{'md5sum'});
	my ($fl,$nfs);
	if ( defined($ver) && ( ($ver eq "") ||
				dcmpvers($flds{'version'},"ge",$ver))) {
	  if ($flds{'version'} ne $ver) {
	    $pkgs{$pkg} = [ $flds{'version'}, @files ];
	    $site{$pkg} = $site;
	  } else {
	    delete $pkgs{$pkg};
	    delete $site{$pkg};
	  }
	}
	$nfs = scalar(@files);
	if(($nfs != scalar(@sizes)) || ($nfs != scalar(@md5sums)) ) {
	    print "Different number of filenames, sizes and md5sums for $flds{'package'}\n";
	} else {
	    my $i = 0;
	    foreach $fl (@files) {
		$pkgfiles{$fl} = [ $md5sums[$i], $sizes[$i] ];
		$i++;
	    }
	}
    }
}

print "\nProcessing Package files...\n";
my $site;
foreach $site (@site) {
    my $method = $1 if ($site =~ /^([^:]*):/);
    my $dir = $1 if ($site =~ m%://(.*)%);
    $directory{$site} = "$method/$dir";

    my @dists = split(/ +/, $distribs{$site});
    my $dist;
    foreach $dist (@dists) {
	my $fn = "$dldir/$directory{$site}$dist/Packages.gz";
	if (-f $fn) {
	    print " $site$dist...\n";
	    procpkgfile($fn,$site);
	} else {
	    print "Could not find $fn (re-run Update)\n";
	}
    }
}

# md5sum
sub md5sum($) {
    my $fn = shift;
    my $m = `md5sum $fn`;
    $m = (split(" ", $m))[0];
    return $m;
}

sub yesno($$) {
  my ($d, $msg) = @_;
  my ($res, $r);
  $r = -1;
  $r = 0 if $d eq "n";
  $r = 1 if $d eq "y";
  die "Incorrect usage of yesno, stopped" if $r == -1;
  while (1) {
    print $msg, " [$d]: ";
    $res = <STDIN>;
    $res =~ /^[Yy]/ and return 1;
    $res =~ /^[Nn]/ and return 0;
    $res =~ /^[ \t]*$/ and return $r;
    print "Please enter y/n\n";
  }
}


# construct list of files to get
# hash of filenames => size of downloaded part
# query user for each paritial file
print "\nConstructing list of files to get...\n";
my %downloads;
my ($pkg, $fn);
my $totsize = 0;
foreach $pkg (keys(%pkgs)) {
    my @files = pop(@{$pkgs{$pkg}});
    foreach $fn (@files) {
	my @info = @{$pkgfiles{$fn}};
	my $csize = int($info[1]/1024)+1;
	if(-f "$dldir/$directory{$site{$pkg}}/$fn") {
	    my $size = -s "$dldir/$directory{$site{$pkg}}/$fn";
	    if($info[1] > $size) {
		    $downloads{$fn} = 0;
		    $totsize += $csize;
	    } else {
		# check md5sum
		if(md5sum("$dldir/$directory{$site{$pkg}}/$fn") eq $info[0]) {
		    print "already got: $fn\n";
		} else {
		    print "corrupted: $fn\n";
		    $downloads{$fn} = 0;
		}
	    }
	} else {
	    print "want: $site{$fn}$fn (${csize}k)\n";
	    $downloads{$fn} = 0;
	    $totsize += $csize;
	}
	if (defined($downloads{$fn})) {
	    $site{$fn} = $site{$pkg} if defined $downloads{$fn};
	    my $dir = "$dldir/$directory{$site{$fn}}" . dirname($fn);

	    if(!-d "$dir") {
		mkpath(["$dir"], 1, 0755);
	    }
	}
    }
}

my $avsp = `df -k $::dldir| paste -s | awk '{ print \$11}'`;
chomp $avsp;

print "\nApproximate total space required: ${totsize}k\n";
print "Available space in $dldir: ${avsp}k\n";

$avsp = `df -k $dldir| awk '/\\// { print \$4}'`;
chomp $avsp;

if($totsize == 0) {
    print "Nothing to get.";
} else {
    if($totsize > $avsp) {
	print "Space required is greater than available space,\n";
	print "you will need to select which items to get.\n";
    }

#   print out predependency list, so user is warned
print "Checking predependencies...\n";
print "dpkg --predep-package\n";
my $predep = `dpkg --predep-package`;
if ($predep) {
	print $predep;
	print <<EOM;
The package above is listed as a predependency.  You should
download and install (dpkg -i pkg.deb) manually.
EOM
print "Abort automatic installation (Y/n)? ";
	my $ans = <STDIN>;
	exit 21 unless $ans =~ /^[nN]/;
}

# ask user which files to get
    if(($totsize > $avsp) || yesno("n", "Do you want to select the files to get")) {
	$totsize = 0;
	my @files = sort(keys(%downloads));
	my $fn;
	my $def = "y";
	foreach $fn (@files) {
	    my @info = @{$pkgfiles{$fn}};
	    my $csize = int($info[1]/1024)+1;
	    if ($csize + $totsize > $avsp) {
		print "no room for: $fn\n";
		delete $downloads{$fn};
	    } else {
		if(yesno($def, "download: $fn ${csize}k (total = ${totsize}k)")) {
		    $def = "y";
		    $totsize += $csize;
		} else {
		    $def = "n";
		    delete $downloads{$fn};
		}
	    }
	}
    }
}

sub download() {
    my $fn,$file;
    my $ua = new LWP::UserAgent;
    $ua->env_proxy;
    my $req;
    my $res;
    DL: foreach $fn (keys(%downloads)) {
	print "getting: $site{$fn}$fn (${$pkgfiles{$fn}}[1]) ...";
	$req = new HTTP::Request 'GET', "$site{$fn}$fn";
	if ($use_authorization_basic) {
	    $req->authorization_basic ($auth_user, $pass);
	} elsif ($use_proxy_authorization) {
	    $req->proxy_authorization_basic ($auth_user, $pass);
	}
	$req->header('Cache-Control','max-stale=31536000');
	$file="$dldir/$directory{$site{$fn}}$fn";
	$res = $ua->request ($req,"$file");
	if ($res->is_success) {
	    print "done\n";
	} else {
	    print "\nUnable to download $site{$fn}$fn - deleting $file\n";
	    unlink "$file";
	}
    }
}

# download stuff (protect from ^C)
if($totsize != 0) {
    if(yesno("y", "\nDo you want to download the required files")) {
	if (($use_authorization_basic or $use_proxy_authorization)
	    and $auth_passwd eq "?") {
		print "Enter proxy password: ";
		system ("stty", "-echo");
		$pass=<STDIN>;
		chomp $pass;
		print "\n";
		system ("stty", "echo");
	} elsif ($use_authorization_basic or $use_proxy_authorization) {
		$pass = $auth_passwd;
	}

	print "Downloading files... use ^C to stop\n";
	eval {
	    local $SIG{INT} = sub {
		die "Interrupted!\n";
	    };
	    download();
	};
	if($@) {
	    print "HTTP ERROR\n";
#	    $exit = 1;
	}
    }
}

# remove duplicate packages (keep latest versions)
# move half downloaded files out of the way
# delete corrupted files
print "\nProcessing downloaded files...(for corrupt/old/partial)\n";
my %vers; # package => version
my %files; # package-version => files...

# check a deb or split deb file
# return 1 if it a deb file, 2 if it is a split deb file
# else 0
sub chkdeb($) {
    my ($fn) = @_;
    # check to see if it is a .deb file
    if(!system("dpkg-deb --info $fn > /dev/null 2>&1 && dpkg-deb --contents $fn &> /dev/null")) {
	return 1;
    } elsif(!system("dpkg-split --info $fn > /dev/null 2>&1")) {
	return 2;
    } 
    return 0;
}
sub getdebinfo($) {
    my ($fn) = @_;
    my $type = chkdeb($fn);
    my ($pkg, $ver);
    if($type == 1) {
	open(PKGFILE, "dpkg-deb --field $fn |");
	my %fields = getblk(\*PKGFILE);
	close(PKGFILE);
	$pkg = $fields{'package'};
	$ver = $fields{'version'};
	if($fields{'package_revision'}) { $ver .= '-' . $fields{'package_revision'}; }
	return $pkg, $ver;
    } elsif ( $type == 2) {
	open(PKGFILE, "dpkg-split --info $fn|");
	while(<PKGFILE>) {
	    /Part of package:[ \t]*([^ \t]+)/ and $pkg = $+;
	    /\.\.\. version:[ \t]*([^ \t]+)/ and $ver = $+;
	}
	close(PKGFILE);
	return $pkg, $ver;
    }
    print "could not figure out type of $fn\n";
    return $pkg, $ver;
}

# process deb file to make sure we only keep latest versions
sub prcdeb($$) {
    my ($dir, $fn) = @_;
    my ($pkg, $ver) = getdebinfo($fn);
    if(!defined($pkg) || !defined($ver)) {
	print "could not get package info from file\n";
	return 0;
    }
    if($vers{$pkg}) {
	if(dcmpvers($vers{$pkg}, "eq", $ver)) {
	    $files{$pkg . $ver} = [ $files{$pkg . $ver }, "$dir/$fn" ];
	} elsif (dcmpvers($vers{$pkg}, "gt", $ver)) {
	    print "old version\n";
	    unlink $fn;
	} else { # else $ver is gt current version
	    my ($c);
	    foreach $c (@{$files{$pkg . $vers{$pkg}}}) {
		print "replaces: $c\n";
		unlink "$vardir/methods/http/$dldir/$c";
	    }
	    $vers{$pkg} = $ver;
	    $files{$pkg . $ver} = [ "$dir/$fn" ];
	}
    } else {
	$vers{$pkg} = $ver;
	$files{$pkg . $ver} = [ "$dir/$fn" ];
    }
}

sub prcfile() {
    my ($fn) = $_;
    if (-f $fn) {
	my $dir = substr($File::Find::dir, index($File::Find::dir, "::dldir")+length($dldir)+2);
	print "$dir/$fn\n";
	if(defined($pkgfiles{"$dir/$fn"})) {
	    my @info = @{$pkgfiles{"$dir/$fn"}};
	    my $size = -s $fn;
	    if($size == 0) {
		print "zero length file\n";
		unlink $fn;
	    } elsif($size < $info[1]) {
		print "partial file\n";
		unlink $fn;
	    } elsif(md5sum($fn) ne $info[0]) {
		print "corrupt file\n";
		unlink $fn;
	    } else {
		prcdeb($dir, $fn);
	    }
	} elsif($fn =~ /.deb$/) {
	    if(chkdeb($fn)) {
		prcdeb($dir, $fn);
	    } else {
		print "corrupt file\n";
		unlink $fn;
	    }
	} elsif($fn =~ /Packages.gz$/) {
	    # ignore Packages.gz files
	} else {
	    print "non-debian file\n";
	}
    }
}
find(\&prcfile, "$dldir");


# install .debs
if(yesno("y", "\nDo you want to install the files fetched")) {

    print "Installing files...\n";
    my $r = system("dpkg", "-iGREOB", "$dldir");
    if($r) {
	print "DPKG ERROR\n";
	$exit = 1;
    }
}

sub removeinstalled {
    my $fn = $_;
    if (-f $fn) {
	my $dir = substr($File::Find::dir, index($File::Find::dir, "::dldir")+length($dldir)+2);
	if($fn =~ /.deb$/) {
	    my($pkg, $ver) = getdebinfo($fn);
	    if(!defined($pkg) || !defined($ver)) {
		print "Could not get info for: $dir/$fn\n";
	    } else {
		if($curpkgs{$pkg} and dcmpvers($ver, "le", $curpkgs{$pkg})) {
		    print "deleting: $dir/$fn\n";
		    unlink $fn || warn "unlink failed";
		} else {
		    print "leaving: $dir/$fn\n";
		}
	    }
	} else {
	    print "non-debian: $dir/$fn\n";
	}
    }
}

# remove .debs that have been installed (query user)
# first need to reprocess status file
if(yesno("y", "\nDo you wish to delete the installed package (.deb) files?")) {
    print "Removing installed files...\n";
    %curpkgs = ();
    procstatus();
    find(\&removeinstalled, "$dldir");
}

# remove whole ./debian directory if user wants to
if(yesno("n", "\nDo you want to remove $dldir directory?")) {
    rmtree("$dldir");
}
exit $exit;
