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

use LWP::UserAgent;

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

$| = 1;

if ($option eq "manual") {
    print "Manual package installation.\n";
    exit 0;
}
#print "vardir: $vardir, method: $method, option: $option\n";

# @site="";
# %::distribs=();
my $arch=`dpkg --print-installation-architecture`;
$arch='i386' if $?;
chomp $arch;
$dldir="debian";
$use_authorization_basic = 0;
$use_proxy_authorization = 0;
$auth_user = "";
$auth_passwd = "";
my $pass;

# get info from control file
if (-f "$vardir/methods/http/vars") {
    do "$vardir/methods/http/vars";
} elsif (-f "$vardir/methods/ftp/vars") {
    do "$vardir/methods/ftp/vars" or die "Unable to load ftp defaults";
    @site = ( "ftp://${ftpsite}${ftpdir}/" );
    $distribs{$site[0]}="dists/hamm/main/binary-$arch dists/hamm/contrib/binary-$arch dists/hamm/non-free/binary-$arch";
    if ($username =~ /anonymous|ftp/) {
	$use_authorization_basic = 0;
	$use_proxy_authorization = 0;
	$auth_user = "";
	$auth_passwd = "";
    } else {
	$use_authorization_basic = 0;
	$use_proxy_authorization = 1;
	$auth_user = $username;
	$auth_passwd = $password;
    }
  } else {

    @site = ( 'http://llug.sep.bnl.gov/debian/',
	    'http://nonus.debian.org/debian-non-US/');
    $distribs{'http://llug.sep.bnl.gov/debian/'}="dists/hamm/main/binary-$arch dists/hamm/contrib/binary-$arch dists/hamm/non-free/binary-$arch";
    $distribs{'http://nonus.debian.org/debian-non-US/'}="hamm/binary-$arch";
    $use_authorization_basic = 0;
    $use_proxy_authorization = 0;
    $auth_user = "";
    $auth_passwd = "";
}

chdir "$vardir/methods/http";
if (! -d $dldir) {
    mkdir "$dldir", 0755;
}


print <<EOM;

    The following questions are used to create the config file
    /var/lib/dpkg/methods/http/vars.  If you want greater flexibility,
    just edit that file directly.

    dpkg-http can use web proxies to reduce charges and increase
    download speeds.  Examples:

      ftp_proxy:    http://wwwcache.anu.edu.au/ [or "none"]
      http_proxy:   http://wwwcache.anu.edu.au/ [or "none"]
      no_proxy:     anu.edu.au [space separated list of domains]

EOM

my $proxy;
print "ftp_proxy [$ENV{ftp_proxy}]: ";
$proxy=<STDIN>;
chomp $proxy;
$ENV{ftp_proxy} = $proxy if ($proxy ne "");
delete $ENV{ftp_proxy} if ($proxy eq "none");
if (defined($ENV{ftp_proxy})) {
	if ($proxy_ftp) {
		print "Use ftp_proxy for Packages file (Y/n): ";
	} else {
		print "Use ftp_proxy for Packages file (y/N): ";
	}
	$proxy=<STDIN>;
	if ($proxy =~ /[nN]/) {
		$proxy_ftp = 0;
	} elsif ($proxy =~ /[yY]/) {
		$proxy_ftp = 1;
	}
}

print "http_proxy [$ENV{http_proxy}]: ";
$proxy=<STDIN>;
chomp $proxy;
$ENV{http_proxy} = $proxy if ($proxy ne "");
delete $ENV{http_proxy} if ($proxy eq "none");

if (defined($ENV{http_proxy}) or defined($ENV{ftp_proxy})) {
	if ($use_authorization_basic) {
		print "Use Authorization: Basic for proxy? (Y/n): ";
	} else {
		print "Use Authorization: Basic for proxy? (y/N): ";
	}
	$proxy=<STDIN>;
	if ($proxy =~ /[nN]/) {
		$use_authorization_basic = 0;
	} elsif ($proxy =~ /[yY]/) {
		$use_authorization_basic = 1;
	}
	if (! $use_authorization_basic) {
		if ($use_proxy_authorization) {
			print "Use Proxy-Authorization for proxy? (Y/n): ";
		} else {
			print "Use Proxy-Authorization for proxy? (y/N): ";
		}
		$proxy=<STDIN>;
		if ($proxy =~ /[nN]/) {
			$use_proxy_authorization = 0;
		} elsif ($proxy =~ /[yY]/) {
			$use_proxy_authorization = 1;
		}
	}
	if ($use_authorization_basic or $use_proxy_authorization) {
		print "Enter username for proxy [$auth_user]: ";
		$proxy=<STDIN>;
		chomp $proxy;
		$auth_user = $proxy if $proxy ne "";
		print <<EOM;

You may enter '?' to be prompted for your password each time dpkg-http is
executed, or enter your password to have it stored for future use.
EOM
		print "Enter password for proxy [$auth_passwd]: ";
		$proxy=<STDIN>;
		chomp $proxy;
		$auth_passwd = $proxy if $proxy ne "";

		if ($auth_passwd eq "?") {
			print <<EOM;
Your password will not be stored.  Please enter your proxy password for use
during this session only.
EOM
			print "Password: ";
			system ("stty", "-echo");
			$pass=<STDIN>;
			chomp $pass;
			print "\n";
			system ("stty", "echo");
		} else {
			$pass = $auth_passwd;
		}
	}
}

print "no_proxy [$ENV{no_proxy}]: ";
$proxy=<STDIN>;
chomp $proxy;
$ENV{no_proxy} = $proxy if ($proxy ne "");
delete $ENV{no_proxy} if ($proxy eq "none");

print "Download directory [$dldir]: ";
$proxy=<STDIN>;
chomp $proxy;
$dldir=$proxy if ($proxy ne "");

# get info from user 
print <<EOM;

   The URL of each Packages.gz file is constructed by concatenating
   the site, distribution, and /Packages.gz.  The URL's of the package
   files (*.deb) are constructed by concatenating the site with the
   filenames listed in the Packages.gz files.

   Examples:
      http://llug.sep.bnl.gov/debian/
         dists/hamm/main/binary-i386
         dists/hamm/contrib/binary-i386
         dists/hamm/non-free/binary-i386

      ftp://ftp.monash.edu.au/pub/linux/distributions/debian-non-US/
         hamm/binary-i386

      file:/cdrom/
         dists/hamm/main/binary-i386         
         dists/hamm/contrib/binary-i386
         dists/hamm/non-free/binary-i386

EOM


my $i=0;
my @sites = @site;
if (@sites) {
    foreach $site (@sites) {
	print "\nDelete $site (y/N): ";
	my $ans=<STDIN>;
	chomp $ans;
	if ($ans eq "y" || $ans eq "Y") {
	    delete $distribs{$site};
	    splice @site,$i,1;
	} else {
	    print "Distributions [$distribs{$site}]: ";
	    my $ans=<STDIN>;
	chomp $ans;
	    if ($ans ne "") {
		$distribs{$site} = $ans;
	    }
	    $i++;
	}
    }
} else {
    print "No sites currently defined\n";
}


my $exit=0;

do {
    print "\nNew site: ";
    my $site=<STDIN>;
    chomp $site;
    if ($site ne "") {
	push(@site,$site);
	print "Distributions for $site: ";
	my $ans=<STDIN>;
	chomp $ans;
	if ($ans ne "") {
	    $distribs{$site} = $ans;
	}
    } else {
	$exit=1;
    }
} while (!$exit);


my $problem=0;
$exit=0;

sub download() {
    my $site;
    my $old_ftp_proxy = $ENV{ftp_proxy};
    delete $ENV{ftp_proxy} unless $proxy_ftp;

    my $ua = new LWP::UserAgent;
    $ua->env_proxy;
    my $req;
    my $res;

    foreach $site (@site) {
	my @dists = split(/ +/, $distribs{$site});
	my $dist;

	foreach $dist (@dists) {
	    print "Checking $site$dist/Packages.gz\n";
	    $req = new HTTP::Request 'HEAD', "$site$dist/Packages.gz";
	    if ($use_authorization_basic) {
		$req->authorization_basic ($auth_user, $pass);
	    } elsif ($use_proxy_authorization) {
		$req->proxy_authorization_basic ($auth_user, $pass);
	    }
	    $res = $ua->request($req);
	    if ($res->is_error) {
		print "Warning: " . $res->status_line . "\n";
		print "Could not find $site$dist/Packages.gz\n";
		$problem=1;
	    }
	}
    }

    $ENV{ftp_proxy} = $old_ftp_proxy;
}

# download stuff (protect from ^C)
print "\nUsing HTTP to check directories...(stop with ^C)\n\n";
eval {
    local $SIG{INT} = sub {
	die "Interrupted!\n";
    };
    download();
};


# output new vars file
umask 077;
open(VARS, ">$vardir/methods/http/vars") or 
die "Could not open file $vardir/methods/http/vars: $!, stopped";
print VARS "\$ENV{ftp_proxy} = '$ENV{ftp_proxy}';\n" if defined $ENV{ftp_proxy};
print VARS "\$proxy_ftp = $proxy_ftp;\n" if (defined($proxy_ftp));
print VARS "\$ENV{http_proxy} = '$ENV{http_proxy}';\n" if defined $ENV{http_proxy};
print VARS "\$ENV{no_proxy} = '$ENV{no_proxy}';\n" if defined $ENV{no_proxy};
print VARS "\@site = ( '";
$, = "', '";
print VARS @site;
print VARS "' );\n";
foreach $site (@site) {
    print VARS "\$distribs{'$site'}=\"$distribs{$site}\";\n";
}
print VARS "\$use_authorization_basic = $use_authorization_basic;\n"
	 if defined($use_authorization_basic);
print VARS "\$use_proxy_authorization = $use_proxy_authorization;\n"
	 if defined($use_proxy_authorization);
print VARS "\$auth_user = \"$auth_user\";\n" if defined($auth_user);
print VARS "\$auth_passwd = \"$auth_passwd\";\n" if defined($auth_passwd);
print VARS "\$dldir = \"$dldir\";\n" if defined($dldir);
print VARS "1;\n";
close VARS;

if($problem) {
    print "\nftp_proxy failures should be ignored.\n";
    print "Press RETURN to continue.\n";
    my $ans=<STDIN>;
    $exit = 0;
}
exit $exit;
