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

#use strict;
#use diagnostics;

use Net::FTP;
use File::Path;
use File::Basename;
use File::Find;

# 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/ftp/vars" or die "Could not find state file (re-run Access method)";
mkpath(["$vardir/methods/ftp/debian"], 0, 0755);
my @dists = split(/ +/, $::distribs);
chdir "$vardir/methods/ftp";

# 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'};
	    }
	}
    }
    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;

sub procpkgfile {
    my $fn = shift @_;
    my(%flds, $fld);
    open(PKGFILE, "$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( $ver, "lt", $flds{'version'} ) )) {
	    $pkgs{$pkg} = [ $flds{'version'}, @files ];
	    $curpkgs{$pkg} = $flds{'version'};
	}
	$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 $dist;
foreach $dist (@dists) {
    $dist =~ tr/\//_/;
    my $fn = "Packages.$dist";
    if (-f $fn) {
	print " $dist...\n";
	procpkgfile($fn);
    } else {
	print "Could nt find packages file for $dist distribution (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";
  }
}

# rename partial files back
sub renamepartial {
    if ( /^(.+).partial$/ ) {
	rename $_, $1;
    }
}
if (-d $::dldir) {
    find(\&renamepartial, $::dldir);
}

# 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 $dir = dirname($fn);
	if(!-d "$dir") {
	    mkpath(["$::dldir/$dir"], 0, 0755);
	}
	my @info = @{$pkgfiles{$fn}};
	my $csize = int($info[1]/1024)+1;
	if(-f "$::dldir/$fn") {
	    my $size = -s "$::dldir/$fn";
	    if($info[1] > $size) {
		# partial download
		if(yesno("y", "continue file: $fn ($size/$info[1])")) {
		    $downloads{$fn} = $size;
		    $totsize += $csize - int($size/1024);
		} else {
		    $downloads{$fn} = 0;
		    $totsize += $csize;
		}
	    } else {
		# check md5sum
		if(md5sum("$::dldir/$fn") eq $info[0]) {
		    print "already got: $fn\n";
		} else {
		    print "corrupted: $fn\n";
		    $downloads{$fn} = 0;
		}
	    }
	} else {
	    print "want: $fn (${csize}k)\n";
	    $downloads{$fn} = 0;
	    $totsize += $csize;
	}
    }
}

my $avsp = `df -k $::dldir| awk '/\\// { print \$4}'`;
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";
    }
# 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() {
    print "Connecting to $::ftpsite...\n";
    my $ftp = Net::FTP->new($::ftpsite, Passive => $::passive);
    if(!defined($ftp)) { print "Failed to connect\n"; return 1; }
    print "Login as $::username...\n";
    my $pass = $::password;
    if($pass eq "?") {
	print "Enter password for ftp: ";
	system("stty", "-echo");
	$pass = <STDIN>;
	chomp $pass;
	print "\n";
	system("stty", "echo");
    }
    if(!$ftp->login($::username, $pass)) { print $ftp->message() . "\n"; die "error"; }
    print "Setting transfer mode to binary...\n";
    if(!$ftp->binary()) { print $ftp->message . "\n"; return 1; }
    print "Cd to $::ftpdir...\n";
    if(!$ftp->cwd($::ftpdir)) { print $ftp->message . "\n"; return 1; }
    my $fn;
    foreach $fn (keys(%downloads)) {
	print "getting: $fn (${$pkgfiles{$fn}}[1])\n";
	if(!$ftp->get($fn, "$::dldir/$fn", $downloads{$fn})) {
	    my $r = $ftp->code();
	    print $ftp->message . "\n";
	    if (!($r == 550 || $r == 450)) {
		return 1;
	    }
	}
    }
    $ftp->quit();
}

# download stuff (protect from ^C)
if($totsize != 0) {
    if(yesno("y", "\nDo you want to download the required files")) {
	print "Downloading files... use ^C to stop\n";
	eval {
	    local $SIG{INT} = sub {
		die "Interrupted!\n";
	    };
	    download();
	};
	if($@) {
	    print "FTP 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 && dpkg-deb --contents $fn &> /dev/null")) {
	return 1;
    } elsif(!system("dpkg-split --info $fn &> /dev/null")) {
	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/ftp/$::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";
		rename $fn, "$fn.partial";
	    } 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;
	    }
	} 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;
		} 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;
