#!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