#!/usr/bin/perl -w

#
# apt-file - APT package searching utility -- command-line interface
#
# (c) 2001 Sebastien J. Gross <seb@sjgross.org>
# $Id: apt-file,v 1.21 2002/02/23 16:30:50 sjg Exp $
#
#
# This package is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 dated June, 1991.
#
# This package is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this package; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
#

use strict;
use LWP::UserAgent;
use HTTP::Response;
use URI;
use File::Basename;
use File::Path;
use Net::FTP;
use AppConfig;

my %Conf = ();
my $Exit_Code=1;
my $VERSION = "0.2.3";
my $CONF_FILE="/etc/apt/apt-file.conf";

# Parses the sources.list file and returns an array containing all URI
# declared in the sources.lit file.
# This file accepts 2 kinds of notation:
# deb ftp://non-us.debian.org/debian-non-US sid/non-US main 
# deb ftp://non-us.debian.org/debian-non-US sid non-US/main
sub read_source_list {
    my @res=();
    open(SOURCE, "< $Conf{'sources-list'}") 
	|| die "Can't open `$Conf{'sources-list'}': $!\n";
    while(<SOURCE>) {
	if (/^deb[^-]/) {
	    chomp;
	    my $line = $_;
	    if (m/^([^\[]*)\[([^\]]*)\](.*)$/) {
		my ($tmp1, $tmp2, $tmp3) = ($1, $2, $3);
		$tmp2 =~ s/ /_/g;
		$line = $tmp1.'['.$tmp2.']'.$tmp3;
	    }
	    $line =~ s/\s+/ /g;
	    my @path = split / /, $line;
	    print "path @path\n" if $Conf{'verbose'};
	    # remove deb
	    shift @path;
	    # build first part of the uri
	    my $entry = (shift @path) . "/dists/" . (shift @path);
	    print "entry = $entry\n" if $Conf{"verbose"};
	    # Add specific notation for components
	    my @list = grep /\//, @path;
	    if (@list) {
		my @components;
		# Keep only first part of a block like non-US/main
		foreach (map { /(.*)\/(.*)/; $1} @list ) {
		    push @components, $_ if (! grep $_, @components);
		}
		foreach (@components) {
		    push @res, "$entry/$_";
		}
	    } else {
		push @res, $entry; # if (! grep $entry, @res);
	    }
	}
    }
    close (SOURCE);
    return @res;
}

sub fetch_contents_file() {
    print "fetch_contents_file\nNot yet implemented";
}
sub fetch_contents_cdrom() {
    print "fetch_contents_cdrom\nNot yet implemented";
}
sub fetch_contents_http() {
    my ($args) = @_;
    my $url = "$args->{HOST}$args->{PATH}/$args->{FILE}";

    # Prepare the agent
    my $User_Agent = LWP::UserAgent->new;
    if (defined $ENV{"http_proxy"}) {
	$User_Agent->env_proxy();
	print "Using $ENV{'http_proxy'} as http proxy\n" if $Conf{'verbose'};
    }
    $User_Agent->agent('apt-file');
    print "Fetching `http://$url'\n" if $Conf{'verbose'};
    my $request = HTTP::Request->new(GET =>
				     "http://$url");

    # Fetch the file
    my $response = $User_Agent->request ($request);
    if ($response->is_success) {
	my $lfile = $Conf{'cache'} . "/"
	    . &uri_escape("$args->{HOST}$args->{PATH}/$args->{FILE}");
	open (FILE, "> $lfile") || die "Can't open `$lfile': $!\n";
	print FILE $response->{_content};
	close FILE;
	print "Done\n" if $Conf{'verbose'};
	$Exit_Code = 0;
    } else {
	print "Error: http://$url not found\n";
    }
}

sub uri_escape {
    my ($uri) = @_;
    $uri =~ s/\/\//\//g;
    $uri =~ s/\//_/g;
    return $uri;
}


sub fetch_contents_ftp {
    my ($args) = @_;
    
    print "args->{HOST} -> $args->{HOST}\n" if $Conf{'verbose'};
    print "Conf{'ftp-passive'} -> $Conf{'ftp-passive'}\n"
	if $Conf{'verbose'};
    
    my %options = (Passive => $Conf{'ftp-passive'});

#    print "use $ENV{'ftp_proxy'} as ftp proxy\n" if $Conf{'verbose'};
    if (defined $ENV{"ftp_proxy"}) {
	$options{'Firewall'} = $ENV{'ftp_proxy'};
	print "Using $ENV{'ftp_proxy'} as ftp proxy\n" if $Conf{'verbose'};
    }


#    $options{'Firewall'} = $ENV{'ftp_proxy'} if defined $ENV{'ftp_proxy'};
    $options{'Debug'} = 1 if $Conf{'verbose'};

    my $ftp = Net::FTP->new($args->{HOST}, %options) ||
	die "Can't create FTP object: $!\n";

    # Login and go to the directory
    $ftp->login() || die "Can't login to `$args->{HOST}': $!\n";
    $ftp->cwd($args->{PATH})
	|| die "can't change to `$args->{PATH}':$!\n";
    $ftp->binary();

    # Prepare local part
    my $local_file = $Conf{'cache'}."/".
    &uri_escape("$args->{HOST}$args->{PATH}/$args->{FILE}");
    print "Fetching `$args->{FILE}' to `",$local_file, "'(",
    $ftp->size($args->{FILE})," bytes)\n" if $Conf{'verbose'};

    $ftp->hash("\*STDERR", int ($ftp->size($args->{FILE}) || 50)/50);
    
    # fetch the file
    print "Fetching ftp://$args->{HOST}$args->{PATH}/$args->{FILE}\n";
    $ftp->get($args->{FILE}, $local_file) ? $Exit_Code = 0 :
	print "Can't fetch `ftp://$args->{HOST}$args->{PATH}/$args->{FILE}': $!\n";
    $ftp->quit();
}

sub fetch_contents_copy {
    print "fetch_contents_copy\nNot yet implemented";
}

	    
sub fetch_contents {
    my ($urls) = @_;
    my %fonc = (
		file => \&fetch_contents_file,
		cdrom => \&fetch_contents_cdrom,
		http => \&fetch_contents_http,
		ftp => \&fetch_contents_ftp,
		copy => \&fetch_contents_copy
		);
		
    foreach (@$urls) {
	my $uri = URI->new ("$_/Contents-$Conf{'arch'}.gz");
	my %opt = (
		   HOST => $uri->host(),
		   PATH => dirname($uri->path()),
		   FILE => basename($uri->path()),
		   );
  	$fonc{$uri->scheme()}->(\%opt);
    }
}

sub shell_pattern {
 my ($pattern) = @_;
 my %charmap = (
	    '*' => '\\([^ ]*\\)',
	    '?' => '.',
	    '[' => '[',
	    ']' => ']'
	    );
 $pattern =~ s{(.)} { $charmap{$1} || "$1" }ge;
 $pattern =~ s/^\/+//;
 return "$pattern";
}

sub grep_file {
    my ($uris) = @_;
    my $options = "";
    $options .= " -i " if $Conf{'case-sensitive'};
    my $pattern = shell_pattern($Conf{'pattern'});
#    $pattern .= $Conf{'recursive'} ? "\\([^/]*\\)[[:space:]]" : "[[:space:]]";
    $pattern .= "[[:space:]]";
    $options .= "\"^[^ ]*$pattern\" ";
    my @packages=();

    print "options: $options\n" if $Conf{'verbose'};

    foreach (@$uris) {
	my $uri = URI->new ("$_/Contents-$Conf{'arch'}.gz");
	my $file = $Conf{'cache'} . "/" . &uri_escape($uri->host()
			       . dirname($uri->path()). "/"
			       .basename($uri->path()));
	if (-f $file) {
	    print "Searching in `$file'\n" if $Conf{'verbose'};
	    open(GREP, "zgrep $options $file |")
		|| die "Can't search in `$file': $!\n";
	    while (<GREP>) {
		/^([^ \t]+)[ \t]+(.*)$/;
		foreach (split /,/, $2) {
		    my $pack = basename($_);
		    push @packages, $pack;
		}
	    }
	    close GREP;
	}
    }
    $Exit_Code = 0 if $#packages > 0;
    map { print "$_\n" } &unique(\@packages);
}

sub grep_package {
    my ($uris) = @_;
    my $options = "";
    $options .= " -i " if $Conf{'case-sensitive'};
    $options .= '"^[^ ]\+.*[:space:]\+\(.*\)/' . shell_pattern($Conf{'pattern'}) . '$"';
    my @packages = ();
    
    print "options: $options\n" if $Conf{'verbose'};

    foreach (@$uris) {
	my $uri = URI->new ("$_/Contents-$Conf{'arch'}.gz");
	my $file = $Conf{'cache'} . "/" . &uri_escape($uri->host()
			       . dirname($uri->path()). "/"
			       .basename($uri->path()));
	if (-f $file) {
	    print "Searching in `$file'\n" if $Conf{'verbose'};
	    open(GREP, "zgrep $options $file |")
		|| die "Can't search in `$file': $!\n";
	    while (<GREP>) {
		/^([^ \t]+)[ \t]+(.*)$/;
		push @packages, basename($2)."\t\t$1";
	    }
	    close GREP;
	}
    }
    $Exit_Code = 0 if $#packages > 0;
    map { print "$_\n" } sort @packages;
}
	  
sub unique {
    my ($arr) = @_;
    my %seen = ();
    %seen = ();
    return grep { ! $seen{$_} ++ } @$arr;
}

sub parse_commande {
    my $conf = AppConfig->new(CASE => 1);

    $conf->define("cache", {
	ARGS => "=s",
	ALIAS => "c",
	DEFAULT => "./",
	ARGCOUNT => AppConfig::ARGCOUNT_ONE
	});
    $conf->define("verbose", {
	ARGS => "!",
	ALIAS => "v",
	DEFAULT => 0,
	ARGCOUNT => AppConfig::ARGCOUNT_NONE
	});
    $conf->define("auto-apt", {
	ARGS => "!",
	ALIAS => "a",
	DEFAULT => 0,
	ARGCOUNT => AppConfig::ARGCOUNT_NONE
	});
    $conf->define("version", {
	ARGS => "!",
	DEFAULT => 0,
	ARGCOUNT => AppConfig::ARGCOUNT_NONE
	});
    $conf->define("arch", {
	ARGS => "=s",
	ARGCOUNT => AppConfig::ARGCOUNT_ONE
	});
    $conf->define("sources-list", {
	ARGS => "=s",
	ALIAS => "s",
	DEFAULT => "./sources-list",
	ARGCOUNT => AppConfig::ARGCOUNT_ONE
	});
    $conf->define("ftp-passive", {
	ARGS => "!",
	ALIAS => "p",
	DEFAULT => 1,
	ARGCOUNT => AppConfig::ARGCOUNT_ONE
	});
    $conf->define("case-sensitive", {
	ARGS => "!",
	ALIAS => "i",
	DEFAULT => 0,
	ARGCOUNT => AppConfig::ARGCOUNT_NONE
	});
    $conf->define("recursive", {
	ARGS => "!",
	ALIAS => "r",
	DEFAULT => 0,
	ARGCOUNT => AppConfig::ARGCOUNT_NONE
	});
    $conf->define("help", {
	ARGS => "!",
	ALIAS=> "h",
	DEFAULT => 0,
	ARGCOUNT => AppConfig::ARGCOUNT_NONE
	});
    $conf->file($CONF_FILE);
    $conf->getopt();

    %Conf = (
	     "cache" => $conf->get("cache"),
	     "verbose" => $conf->get("verbose"),
	     "version" => $conf->get("version"),
	     "auto-apt" => $conf->get("auto-apt"),
	     "arch" => $conf->get("arch"),
	     "sources-list" => $conf->get("sources-list"),
	     "ftp-passive" => $conf->get("ftp-passive"),
	     "case-sensitive" => $conf->get("case-sensitive"),
	     "recursive" => $conf->get("recursive"),
	     "action" => shift @ARGV,
	     "pattern" => shift @ARGV
	     );
    $Conf{"cache"} = "/var/cache/auto-apt" if $Conf{"auto-apt"};

    # Create cache directory
    if (! -d $Conf{"cache"}) {
	mkpath $Conf{"cache"} ||
	    die "Error creating	$Conf{'cache'}: $!\n";
    }

    if (! -w $Conf{'cache'} && $Conf{'action'} eq "update") {
	die "Can't write in $Conf{'cache'} (no write privilege).\n";
    }

    unless ( defined $Conf{'arch'} ) {
	my $arch= `dpkg --print-installation-architecture 2> /dev/null`;
	chomp $arch if defined $arch;
	$Conf{'arch'} = $arch || 'i386';
    }
}

sub help() {
    print_version();
    print <<EOF;

Syntax: $0 [options] [action] <pattern>

Action type:
    update - update cache files
    search - search <pattern> in file list
    list   - list content of <pattern> package

options:
    --help | -h                display this help page
    --cache | -c <dir>         use <dir> as cache directory
    --auto-apt | -a            use auto-apt(1) cache files
    --verbose | -v             run in verbose mode
    --version                  show version number
    --arch | -a <arch>         set <arch> as architecture type
    --source-list | -s <file>  set <file> as sources list
    --ftp-passive | -p         use passive FTP connection
    --recursive | -r           search package recursivelly (disabled)
    --case-sensitive | -i      run in case sensitive mode

See man page for more details.
EOF
    exit(0);
}

sub print_version {
    print <<EOF;
$0 version $VERSION
(c) 2001 sebastien J. Gross <seb\@sjgross.org>
EOF
}


sub main(){
    &parse_commande();
    &help() if $Conf{'help'};
    if ($Conf{'version'}) {
	&print_version();
	exit 0;
    }
    my @files = &read_source_list();
    my %action = (
		  update => \&fetch_contents,
		  search => \&grep_file,
		  list => \&grep_package
		  );

    &help() unless defined $Conf{'action'};
    if (defined $action{$Conf{'action'}}) {
	$action{$Conf{'action'}}->(\@files);
	exit $Exit_Code;
    } else {
	&help();
    }
}



&main();
