apt-file

#!/usr/bin/perl -w

#
# apt-file - APT package searching utility -- command-line interface
#
# (c) 2001 Sebastien J. Gross <seb@debian.org>
# $Id: apt-file,v 1.1 2004/03/22 02:09:01 klischat 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 ConfigFile "read_config_file";
use Getopt::Long qw/:config no_ignore_case/;
use Data::Dumper;
use File::Basename;
use AptPkg::Config '$_config';
use constant VERSION => "2.0.3";


my $Conf;
my $Version;

sub error($) {
    print STDERR "E: ", shift, $! ? ": $!" : "" ,"\n";
    undef $!;
    exit 1;
}

sub warning($) {
    print STDERR "W: ", shift, $! ? ": $!" : "" ,"\n";
    undef $!;
}

sub debug($) {
    return if ! defined $Conf->{verbose};
    print STDERR "D: ", shift, $! ? ": $!" : "" ,"\n";
    undef $!;
}

sub debug_line($){
    return if ! defined $Conf->{verbose};
    print STDERR shift;
}

sub unique($) {
    my $seen = ();
    return [ grep { ! $seen->{$_}++ } @{(shift)} ];
}

sub reverse_hash($) {
    my $hash = shift;
    my $ret = ();
    foreach my $key (keys %$hash) {
	foreach (@{$hash->{$key}}) {
	    push @{$ret->{$_}}, $key;
	}
    }
    return $ret;
}

sub parse_sources_list($) {
    my $file = shift;
    my $uri;
    my @uri_items;
    my @tmp;
    my $line;
    my $ret;

    my ($cmd, $dest);

    open(SOURCE, "< $file") || error "Can't open $file";
    while(<SOURCE>) {
	next if /^\s*(?:$|\#|(?:deb-|rpm-))/xo;
	chomp;
	my $line = $_;
	debug "got \'$line\'";
	$line =~ s/([^\/])\#.*$/$1/o;
	$line =~ s/^(\S+\s+)\[\S+\]/$1/o;
	$line =~ s/\s+/ /go;
	$line =~ s/^\s+//o;

	# CDROM entry
	if (@tmp = $line =~ m/^([^\[]*)\[([^\]]*)\](.*)$/o) {
	    $tmp[1] =~ s/ /_/g;
	    $line = $tmp[0].'['.$tmp[1].']'.$tmp[2];
	}

	# Handle $(ARCH) in sources.list
	$line =~ s/\$\(ARCH\)/$Conf->{arch}/g;
	debug "kept \'$line\'";

	my( $pkg, $uri, $dist, @extra) = split /\s+/, $line;
	my($scheme, $user, $passwd, $host, $port, $path, $query,
	   $fragment) =
	       $uri =~
	       m|^
	       (?:([^:/?\#]+):)?           # scheme
	       (?://
		(?:
		 ([^:@]*)                  #username
		 (?::([^@]*))?             #passwd
		 @)?
		([^:/?\#]*)                # host
		(?::(\d+))?                # port
		)?
		([^?\#]*)			# path
		(?:\?([^\#]*))?		# query
		(?:\#(.*))?			# fragment
		|ox;

#	print "$scheme, $user, $passwd, $host, $port, $path, $query, $fragment\n";

	my $fetch=[];

	foreach (@extra) {
	    push @$fetch,  m/(.*?)\/(?:.*)/o ? "$dist/$1" : "$dist";
	}

	foreach (@{(unique $fetch)}) {
	    if (!defined $Conf->{"${scheme}"}) {
		warning "Don't know how to handle $scheme";
		next;
	    }
	    $dist = $_;
	    $cmd = $Conf->{"${scheme}"};
	    $dest = $Conf->{destination};
	    my $cache = $Conf->{cache};
	    my $arch = $Conf->{arch};
	    my $cdrom = $Conf->{cdrom_mount};
	    foreach my $var (qw/host port user passwd path dist pkg
			     cache arch uri cdrom/) {
		map {
		    $_ =~ s{<$var(?:\|(.+?))?>}{
			defined eval "\$$var" ? eval "\$$var" :
			    defined $1 ? $1 : "";
		    }gsex;
		} ($cmd, $dest)
	    }
	    $dest =~ s/(\/|_)+/_/go;
	    $cmd =~ s/<dest>/$dest/g;
	    my $hash;
	    foreach (qw/host port user passwd path dist pkg uri line
		     dest cmd/) {
		$hash->{$_} = eval "\$$_";
	    }
	    push @$ret, $hash;
	};
    }
    close SOURCE;
    return $ret;
}

sub fetch_files ($) {
    mkdir $Conf->{cache} if ! -d $Conf->{cache};
    error "Can't write in $Conf->{cache}" if ! -w $Conf->{cache};
    foreach (@{(shift)}) {
	debug $_->{cmd};
	qx|$_->{cmd}| if ! defined $Conf->{dummy};
    }
}

sub do_grep($$) {
    my ($data, $pattern) = @_;
    my $ret;
    my ($pack, $file);
    debug "regexp: $pattern";
    $|=1;
    my $regexp = eval { $Conf->{ignore_case} ? qr/$pattern/i : qr/$pattern/ };
    error($@) if $@;
    foreach(@$data) {
	my $file = "$Conf->{cache}/$_->{dest}";
	next if (! -f $file);
	$file = quotemeta $file;
	debug "Search in $file";
	open (ZCAT, "zcat $file |") ||
	    warning "Can't zcat $file";
	while(<ZCAT>) {
	    next if ! (($pack, $file) = /$regexp/);
	    debug_line ".";
	    foreach (split /,/, $file) {
		push @{$ret->{$pack}}, basename $_;
	    }
	}
	close ZCAT;
	debug_line "\n";
    }
    $ret = reverse_hash($ret);
    if (!defined $Conf->{package_only}) {
	foreach my $key (sort keys %$ret) {
	    foreach (sort @{$ret->{$key}}) {
		print "$key: $_\n";
	    }
	}
    } else {
	print map {"$_\n"} (sort keys %$ret);
    }
    exit 0;
}

sub grep_file($) {
    my $data = shift;
    my $pattern = join "", (
			    '^(.*?',
			    $Conf->{pattern},
			    defined $Conf->{fixed_strings} ?
			    ")" : '[^\s]*)',
			    '\s+(\S+)\s*$',
			    );
    do_grep $data, $pattern;
}

sub grep_package($) {
    my $data = shift;
    my $pattern = join "", (
			    '^(\S+)\s+',
			    '(\S*/',
			    $Conf->{pattern},
			    defined $Conf->{fixed_strings} ?
			    "" : ".*",
			    ")",
			    '$',
			    );
    do_grep $data, $pattern;
}

sub purge_cache($) {
    my $data = shift;
    foreach (@$data) {
	debug "Purging $Conf->{cache}/$_->{dest}";
	next if defined $Conf->{dummy};
	unlink "$Conf->{cache}/$_->{dest}" ||
	    warning "Can't remove $Conf->{cache}/$_->{dest}";
    }
}

sub print_version {
    print <<EOF;
apt-file version $Version
(c) 2002 Sebastien J. Gross <sjg\@debian.org>

EOF
    ;
}

sub print_help {
    my $err_code = shift || 0;

    print_version;
    print <<"EOF";

apt-file [options] action [pattern]

Configuration options:
    --sources-list	-s  <file>	sources.list location
    --cache		-c  <dir>	Cache directory
    --architecture	-a  <arch>	Use specific architecture
    --cdrom-mount	-d  <cdrom>	Use specific cdrom mountpoint
    --package-only	-l		Only display packages name
    --fixed-string	-F		Do not expand pattern
    --ignore-case	-i		Ignore case distinctions
    --regexp		-x		pattern is a regular expression
    --verbose		-v		run in verbose mode
    --dummy		-y		run in dummy mode (no action)
    --help		-h		Show this help.
    --version		-V		Show version number

Action:
    update			Fetch Contents files from apt-sources.
    search	<pattern>	Search files in packages
    list	<pattern>	List files in packages
    purge			Remove cache files
EOF
;
    exit $err_code;
}

sub get_options() {
    my %options = (
		   "sources-list|s=s" => \$Conf->{sources_list},
		   "cache|c=s" => \$Conf->{cache},
		   "architecture|a=s" => \$Conf->{architecture},
		   "cdrom-mount|d=s" => \$Conf->{cdrom_mount},
		   "verbose|v" => \$Conf->{verbose},
		   "ignore-case|i" => \$Conf->{ignore_case},
		   "regexp|x" => \$Conf->{is_regexp},
		   "dummy|y" => \$Conf->{dummy},
		   "package-only|l" => \$Conf->{package_only},
		   "fixed-string|F" => \$Conf->{fixed_strings},
		   "help|h" => \$Conf->{help},
		   "version|V" => \$Conf->{version},
		   );
    GetOptions(%options) || print_help 1;
}

sub main {
    my $conf_file;
    map { $conf_file = $_ if -f $_ } ("/etc/apt/apt-file.conf",
				      "apt-file.conf",
				      "$ENV{HOME}/.apt-file.conf");

    error "No config file found\n" if ! defined $conf_file;
    debug "Using $conf_file";

    $Conf=read_config_file $conf_file;
    get_options();
    if (defined $Conf->{version}) {
	print_version;
	exit 0;
    }

    $_config->init;
    $Conf->{arch} ||= $_config->{'APT::Architecture'};
    $Conf->{sources_list} ||=  $_config->{'Dir'} .
	$_config->{'Dir::Etc'} . $_config->{'Dir::Etc::sourcelist'};
    $Conf->{cache} ||= $_config->{'Dir'} . $_config->{'Dir::Cache'};
    $Conf->{cache} =~ s/\/\s*$//;
    $Conf->{cdrom_mount} ||= $_config->{'Acquire::cdrom::Mount'} ||
	"/cdrom";

    $Conf->{action} = shift @ARGV || "none";
    $Conf->{pattern} = shift @ARGV;
    if(defined $Conf->{pattern}) {
	$Conf->{pattern} =~ s/^\///;
	$Conf->{pattern} = quotemeta($Conf->{pattern}) unless $Conf->{is_regexp};
    }
    undef $!;

    my $actions = {
	update => \&fetch_files,
	search => \&grep_file,
	list => \&grep_package,
	purge => \&purge_cache,
    };

    $Conf->{help}=2 if $Conf->{action} =~ m/search|list/ &&
    	! defined $Conf->{pattern};
    $Conf->{help}=2 if ! defined $actions->{$Conf->{action}} &&
	! defined $Conf->{help};
    print_help($Conf->{help}-1) if defined $Conf->{help};

    my $sources = parse_sources_list $Conf->{sources_list};
    error "No valid sources in $Conf->{sources_list}" if ! defined
	$sources;

    $actions->{$Conf->{action}}->($sources);
}

BEGIN {
    $Version = VERSION;
    main();
}

END {

}

__END__