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

#use strict;
#use diagnostics;

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

use Debian::DpkgFtp;

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

# 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| 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| paste -s | awk '{ print \$11}'`;
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;
	    my $rsize = int(($info[1] - $downloads{$fn}) / 1024) + 1;
	    if ($rsize + $totsize > $avsp) {
		print "no room for: $fn\n";
		delete $downloads{$fn};
	    } else {
		if(yesno($def, $downloads{$fn}
			 ? "download: $fn ${rsize}k/${csize}k (total = ${totsize}k)"
			 : "download: $fn ${rsize}k (total = ${totsize}k)")) {
		    $def = "y";
		    $totsize += $rsize;
		} else {
		    $def = "n";
		    delete $downloads{$fn};
		}
	    }
	}
    }
}

sub download() {
    $ftp = do_connect ($::ftpsite,$::username,$::password,$::ftpdir,$::passive,
		       $::useproxy,$::proxyhost,$::proxylogname,$::proxypassword);

    my $fn;
    foreach $fn (keys(%downloads)) {
	if ($downloads{$fn}) {
	    my $rsize = ${pkgfiles{$fn}}[1] - $downloads{$fn};
	    print "getting: $fn ($rsize/${$pkgfiles{$fn}}[1])\n";
	} else {
	    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;
	    }
	}
	# fully got, remove it from list in case we have to re-download
	delete $downloads{$fn};
    }
    $ftp->quit();
    return 0;
}

# download stuff (protect from ^C)
if($totsize != 0) {
    if(yesno("y", "\nDo you want to download the required files")) {
      DOWNLOAD_TRY: while (1) {
	  print "Downloading files... use ^C to stop\n";
	  eval {
	      local $SIG{INT} = sub {
		  die "Interrupted!\n";
	      };
	      if ((download() == 1) && yesno("y", "\nDo you want to retry downloading at once")) {
		  next DOWNLOAD_TRY;
	      }
	  };
	  if($@) {
	      print "FTP ERROR\n";
 	      if (yesno("y", "\nDo you want to retry downloading at once")) {
		  # get the first $fn that foreach would give:
		  # this is the one that got interrupted.
		MY_ITER: foreach $ffn (keys(%downloads)) {
		    $fn = $ffn;
		    last MY_ITER;
		}
		  my $size = -s "$::dldir/$fn";
		  # partial download
		  if(yesno("y", "continue file: $fn (at $size)")) {
		      $downloads{$fn} = $size;
		  } else {
		      $downloads{$fn} = 0;
		  }
		  next DOWNLOAD_TRY;
	      } else {
		  $exit = 1;
		  last DOWNLOAD_TRY;
	      }
	  } else {
	      last DOWNLOAD_TRY;
	  }
      }
    }
}

# 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 2>&1 >/dev/null && dpkg-deb --contents $fn 2>&1 >/dev/null")) {
	return 1;
    } elsif(!system("dpkg-split --info $fn 2>&1 >/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;
