#!perl -w
# Copyright 2009, 2010, 2011, 2014, 2015 Kevin Ryde
# This file is part of apt-file-from-installed.
#
# apt-file-from-installed 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; either version 3, or (at your option) any
# later version.
#
# apt-file-from-installed 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 apt-file-from-installed. If not, see .
use 5.010;
use strict;
use warnings;
use AptPkg::Config;
use Config::File;
use Config::Apt::Sources;
use File::Temp;
use FindBin;
use Getopt::Long;
use File::Slurp 'slurp';
use URI;
# uncomment this to run the ### lines
# use Smart::Comments;
our $VERSION = 8;
my $apt_file_conf_file = '/etc/apt/apt-file.conf';
my $sources_file = '/etc/apt/sources.list';
my $verbose = 0;
my $progname = $FindBin::Script;
my $saw_arg = 0;
GetOptions ('verbose:+' => \$verbose,
version => sub {
print "$progname version $VERSION\n";
exit 0;
}
);
# apt's various configs
my $aptconfig = $AptPkg::Config::_config; ## no critic (ProtectPrivateVars)
$aptconfig->init;
# apt-file's config file
my $aptfileconf = Config::File::read_config_file ($apt_file_conf_file);
$aptfileconf->{'cache'} ||= $aptconfig->get_dir('Dir::Cache') . 'apt-file';
### $aptfileconf
my $arch = $aptconfig->{'APT::Architecture'};
defined $arch or die "Oops, no architecture";
my $sources_content = slurp($sources_file);
# expand $(ARCH) as described in the sources.list(5) man page
$sources_content =~ s/\Q$(ARCH)/$arch/g;
my $sobj = Config::Apt::Sources->new;
$sobj->parse_stream ($sources_content);
my @sources = $sobj->get_sources;
# last entry
{
my $sentry = pop @sources
|| die "Empty $sources_file";
my $destfile = sourcesentry_to_contents_filename($sentry);
if ($verbose) {
say "generate $destfile";
}
my $tempfh = File::Temp->new
(TEMPLATE => "${destfile}.apt-file-from-installed.XXXXXX");
my $tempfile = $tempfh->filename;
close $tempfh;
chmod 0644, $tempfile
or die "Cannot set tempfile mode 644: $!";
my $command = <<'HERE';
(set -e;
echo 'FILE LOCATION'
dpkg --search '*' \
| sed -n -e 's/, /,/g' \
-e 's%^\([^ :]*\): /\(.*\)%\2 \1%p' )\
| gzip -1 - >>
HERE
chomp $command;
$command .= $tempfile;
if ($verbose) {
say $command;
}
system($command) == 0
or die 'Error from dpkg/sed/gzip';
rename $tempfile, $destfile
or die "Cannot rename to $destfile: $!";
system 'ls', '-l', $destfile;
}
# other entries
foreach my $sentry (@sources) {
### $sentry
my $destfile = sourcesentry_to_contents_filename($sentry);
if (-e $destfile) {
if ($verbose) { print "Remove other $destfile\n"; }
unlink $destfile or warn "Cannot remove $destfile: $!\n";
}
}
# $sentry is a Config::Apt::Sources object.
# Return the local filename apt-file would create for the contents file from
# the $sentry source.
#
sub sourcesentry_to_contents_filename {
my ($sentry) = @_;
### sources destination: $aptfileconf->{'destination'}
my $dest = sourcesentry_aptfile_expand
($sentry, $aptfileconf->{'destination'});
### expanded: $dest
$dest =~ s{[/_]+}{_}g;
### crunch slashes: $dest
return $aptfileconf->{'cache'} . '/' . $dest;
}
# $sentry is a Config::Apt::Sources object.
# $template is the kind of "xxx//yyy" pattern from /etc/apt/apt-file.conf
# Expand the parts the way apt-file does in parse_sources_list() and
# return the resulting string.
#
sub sourcesentry_aptfile_expand {
my ($sentry, $template) = @_;
### sourcesentry_aptfile_expand() ...
### $sentry
my $dist = $sentry->get_dist;
if (my ($component) = $sentry->get_components) {
$dist .= "/$component";
}
my %part;
my $uri = URI->new ($sentry->get_uri);
$part{'host'} = ($uri->can('host') ? $uri->host : '');
$part{'port'} = ($uri->can('port') ? $uri->port : '');
($part{'user'}, $part{'passwd'}) = uri_user_and_password ($uri);
$part{'path'} = ($uri->can('path') ? $uri->path : '');
$part{'dist'} = $dist;
# pkg
$part{'cache'} = $aptfileconf->{'cache'};
$part{'arch'} = $arch;
$part{'uri'} = $uri;
$template =~ s{<([^>|]+)(\|(.*?))?>}
{$part{$1} // $3 // ''}eg;
return $template;
}
sub uri_user_and_password {
my ($uri) = @_;
# URI::ftp and URI::rsync have user() and password() methods, URI::http
# only has userinfo, URI::file has none
my ($user, $password);
if ($uri->can('userinfo')) {
my $userinfo = $uri->userinfo;
if (defined $userinfo) {
($user, $password) = ($userinfo =~ /(.*):(.*)/);
}
}
if ($uri->can('user')) { $user = $uri->user; }
if ($uri->can('password')) { $password = $uri->password; }
return ($user, $password);
}
exit 0
__END__
=head1 NAME
apt-file-from-installed -- create apt-file contents from installed packages
=head1 SYNOPSIS
apt-file-from-installed [--verbose] [--version]
=head1 DESCRIPTION
C creates a contents file as used by C,
built from the currently installed packages instead of downloading. For
example if your C had C the file might be
/var/cache/apt/apt-file/ftp.debian.org_debian_dists_unstable_main_Contents-i386.gz
The contents created is not a full list of files, only what you have
installed. But it's faster than downloading and it includes any packages
installed locally and not through an actual private repository (important
for C).
New contents are written first to a temporary file in
F and only moved to the real name when complete.
This is atomic so users running C see the new contents file only
when it's complete.
=head2 Other Notes
Currently the last C entry is used as the target, and any
other contents files are removed. Perhaps that should be configurable.
Only C level compression is used for the contents file, so that
it's faster to update if you do so repeatedly after installing new things.
That compression level already takes the file to about 1/4 of original size.
=head1 FILES
F -- contents files directory.
F -- temporary files.
F -- the C configs (determining the
contents directory and filename format)
=head1 SEE ALSO
L
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2009, 2010, 2011, 2014, 2015 Kevin Ryde
apt-file-from-installed 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; either version 3, or (at your option) any
later version.
apt-file-from-installed 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 can get a copy of the GNU General Public License online at
L.
=cut