You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

3336 lines
108 KiB

#!/usr/bin/perl -w
=head1 NAME
debmirror - Debian partial mirror script, with ftp, http or
rsync and package pool support
=head1 SYNOPSIS
B<debmirror> [I<options>] I<mirrordir>
=head1 DESCRIPTION
This program downloads and maintains a partial local Debian mirror. It can
mirror any combination of architectures, distributions, and sections. Files
are transferred by ftp, and package pools are fully supported. It also does
locking and updates trace files.
The partial mirror created by this program is not suitable to be used as a
public Debian mirror. If that is your aim, you should instead follow
the instructions at L<http://www.debian.org/mirrors/ftpmirror>.
This program mirrors in three steps.
=over 4
=item 1. download Packages and Sources files
First it downloads all Packages and Sources files for the subset of Debian it
was instructed to get.
=item 2. download everything else
The Packages and Sources files are scanned, to build up a list of all the
files they refer to. A few other miscellaneous files are added to the list.
Then the program makes sure that each file in the list is present on the
local mirror and is up-to-date, using file size (and optionally checksum) checks.
Any necessary files are downloaded.
=item 3. clean up unknown files
Any files and directories on the local mirror that are not in the list are
removed.
=back
=cut
sub usage {
warn join(" ", @_)."\n" if @_;
warn <<EOF;
Usage: $0 [options] <mirrordir>
For details, see man page.
EOF
exit(1);
}
=head1 OPTIONS
=over 4
=item I<mirrordir>
This required (unless defined in a configuration file) parameter specifies
where the local mirror directory is. If the directory does not exist, it will
be created. Be careful; telling this program that your home directory is the
mirrordir is guaranteed to replace your home directory with a Debian mirror!
=item B<-p>, B<--progress>
Displays progress bars as files are downloaded.
=item B<-v>, B<--verbose>
Displays progress between file downloads.
=item B<--debug>
Enables verbose debug output, including ftp protocol dump.
=item B<--dry-run>
Simulate a mirror run. This will still download the meta files to the
F<./.temp> working directory, but won't replace the old meta files, won't
download debs and source files and only simulates cleanup.
=item B<--help>
Display a usage summary.
=item B<--version>
Print version number and exit.
=item B<-h>, B<--host>=I<remotehost>
Specify the remote host to mirror from. Defaults to I<ftp.debian.org>,
you are strongly encouraged to find a closer mirror.
=item B<-r>, B<--root>=I<directory>
Specifies the directory on the remote host that is the root of the Debian
archive. Defaults to F<debian>, which will work for most mirrors. The root
directory has a F<dists> subdirectory.
=item B<--method>=I<method>
Specify the method to download files. Currently, supported methods are
B<ftp>, B<http>, B<https>, and B<rsync>. The B<file> method is
experimentally supported.
=item B<--passive>
Download in passive mode when using ftp.
=item B<-u>, B<--user>=I<remoteusername>
Specify the remote user name to use to log into the remote host.
Defaults to C<anonymous>.
=item B<--passwd>=I<remoteuserpassword>
Specify the remote user password to use to log into the remote ftp host.
It is used with B<--user> and defaults to C<anonymous@>.
=item B<--proxy>=I<http://user:pass@url:port/>
Specifies the http proxy (like Squid) to use for http or ftp methods.
=item B<-d>, B<--dist>=I<foo[,bar,..]>
Specify the distribution (etch, lenny, squeeze, sid) of Debian to
mirror. This switch may be used multiple times, and multiple
distributions may be specified at once, separated by commas.
You may also use the stable, testing, unstable, names.
=item B<--omit-suite-symlinks>
With this option set, B<debmirror> will not create the
symlink from I<suite> to I<codename>.
This is needed for example when mirroring archived Debian
releases as they will all have either C<stable> or C<oldstable> as
suite in their F<Release> files.
=item B<-s>, B<--section>=I<foo[,bar,..]>
Specify the section of Debian to mirror. Defaults to
C<main,contrib,non-free,main/debian-installer>.
=item B<-a>, B<--arch>=I<foo[,bar,..]>
Specify the architectures to mirror. The default is B<--arch=i386>.
Specifying B<--arch=none> will mirror no archs.
=item B<--rsync-extra>=I<foo[,bar,..]>
Allows you to also mirror files from a number of directories that are not
part of the package archive itself.
B<Debmirror> will B<always> use rsync for the transfer of these files,
irrespective of what transfer method is specified in the B<--method> option.
This
will therefore not work if your remote mirror does not support rsync, or if
the mirror needs a different B<--root> option for rsync than for the main
transfer method specified with B<--method>.
Note that excluding individual files in the directories is not supported.
The following values are supported.
=over 2
=item B<doc>
Download all files and subdirectories in F<doc> directory, and all README
files in the root directory of the archive.
=item B<indices>
Download all files and subdirectories in F<indices> directory. Note that
this directory can contain some rather large files; don't include this
type unless you know you need these files.
=item B<tools>
Download all files and subdirectories in F<tools> directory.
=item B<trace>
Download the remote mirror's trace files for the archive (F<project/trace/*>).
This is enabled by default.
=item B<none>
This can be used to disable getting extra files with rsync.
=back
If specified, the update of trace files will be done at the beginning of
the mirror run; the other types are done near the end.
This switch may be used multiple times, and multiple values may be specified
at once, separated by commas; unknown values are ignored.
=item B<--di-dist>=I<dists | foo[,bar,..]>
Mirror current Debian Installer images for the specified dists.
See further the section L<Mirroring Debian Installer images> below.
=item B<--di-arch>=I<arches | foo[,bar,..]>
Mirror current Debian Installer images for the specified architectures.
See further the section L<Mirroring Debian Installer images> below.
=item B<--source>
Include source in the mirror (default).
=item B<--nosource>
Do not include source.
=item B<--i18n>
Additionally download F<Translation-E<lt>langE<gt>.*> files, which contain
translations of package descriptions. Selection of specific translations is
possible using the B<--include> and B<--exclude> options. The default
is to download only the English file.
=item B<--getcontents>
Additionally download F<Contents.E<lt>archE<gt>.gz> files. Note that these
files can be relatively big and can change frequently, especially for the
testing and unstable suites. Use of the available diff files is strongly
recommended (see the B<--diff> option).
=item B<--checksums>
Use checksums to determine if files on the local mirror that are
the correct size actually have the correct content. Not enabled by default,
because it is too paranoid, and too slow.
When the state cache is used, B<debmirror> will only check checksums
during runs
where the cache has expired or been invalidated, so it is worth considering
to use these two options together.
=item B<--ignore-missing-release>
Don't fail if the F<Release> file is missing.
=item B<--check-gpg>, B<--no-check-gpg>
Controls whether gpg signatures from the F<Release.gpg> file should be
checked. The default is to check signatures.
=item B<--keyring>=I<file>
Use I<file> as an additional gpg-format keyring. May be given multiple times.
Note that these will be used in addition to $GNUPGHOME/trustedkeys.gpg.
The latter can be removed from the set of keyrings by setting
$GNUPGHOME to something non-existent when using this option.
On a typical Debian system, the Debian archive keyring can be used
directly with this option:
debmirror --keyring /usr/share/keyrings/debian-archive-keyring.gpg ...
=item B<--ignore-release-gpg>
Don't fail if the F<Release.gpg> file is missing. If the file does exist, it
is mirrored and verified, but any errors are ignored.
=item B<--ignore>=I<regex>
Never delete any files whose filenames match the regex. May be used multiple times.
=item B<--exclude>=B<regex>
Never download any files whose filenames match the regex. May be used multiple times.
=item B<--include>=I<regex>
Don't exclude any files whose filenames match the regex. May be used multiple times.
=item B<--exclude-deb-section>=I<regex>
Never download any files whose Debian Section (games, doc, oldlibs,
science, ...) match the regex. May be used multiple times.
=item B<--limit-priority>=I<regex>
Limit download to files whose Debian Priority (required, extra,
optional, ...) match the regex. May be used multiple times.
=item B<--exclude-field>=I<fieldname>=I<regex>
Never download any binary packages where the contents of I<fieldname> match
the regex. May be used multiple times. If this option is used and the mirror
includes source packages, only those source packages corresponding to
included binary packages will be downloaded.
=item B<--include-field>=I<fieldname>=I<regex>
Don't exclude any binary packages where the contents of I<fieldname> match
the regex. May be used multiple times. If this option is used and the mirror
includes source packages, only those source packages corresponding to
included binary packages will be downloaded.
=item B<-t>, B<--timeout>=I<seconds>
Specifies the timeout to use for network operations (either FTP or rsync).
Set this to a higher value if you experience failed downloads. Defaults
to 300 seconds.
=item B<--max-batch>=I<number>
Download at most max-batch number of files (and ignore rest).
=item B<--rsync-batch>=I<number>
Download at most number of files with each rsync call and then loop.
=item B<--rsync-options>=I<options>
Specify alternative rsync options to be used. Default options are
"-aIL --partial". Care must be taken when specifying alternative
options not to disrupt operations, it's best to only add to those
options.
The most likely option to add is "--bwlimit=x" to avoid saturating the
bandwidth of your link.
=item B<--postcleanup>
Clean up the local mirror but only after mirroring is complete and
only if there was no error.
This is the default, because it ensures that the mirror is consistent
at all times.
=item B<--precleanup>
Clean up the local mirror before starting mirroring.
This option may be useful if you have limited disk space, but it will result
in an inconsistent mirror when debmirror is running.
The deprecated B<--cleanup> option also enables this mode.
=item B<--nocleanup>
Do not clean up the local mirror.
=item B<--skippackages>
Don't re-download F<Packages> and F<Sources> files.
Useful if you know they are up-to-date.
=item B<--diff>=I<use|mirror|none>
If B<--diff=use> is specified and the F<Release> file contains entries for
diff files, then debmirror will attempt to use them to update F<Packages>,
F<Sources>, and F<Contents> files (which can significantly reduce the download
size for meta files), but will not include them in the mirror. This is
the default behavior and avoids having time consuming diff files for a
fast local mirror.
Specifying B<--diff=mirror> does the same as B<use>, but will also include
the downloaded diff files in the local mirror. Specify B<--diff=none> to
completely ignore diff files.
Note that if rsync is used as method to download files and the archive
being mirrored has "rsyncable" gzipped meta files, then using B<--diff=none>
may be the most efficient way to download them. See the B<gzip>(1) man page
for information about its rsyncable option.
=item B<--gzip-options>=I<options>
Specify alternative options to be used when calling B<gzip>(1) to compress meta
files after applying diffs. The default options are C<-9 -n --rsyncable>
which corresponds with the options used to gzip meta files for the main
Debian archive.
These options may need to be modified if the checksum of the file as gzipped by
debmirror does not match the checksum listed in the F<Release> file (which will
result in the gzipped file being downloaded unnecessarily after diffs were
successfully applied).
=item B<--slow-cpu>
By default debmirror saves some bandwidth by performing cpu-intensive
tasks, such as compressing files to generate .gz and .xz files. Use this
mode if the computer's CPU is slow, and it makes more sense to use more
bandwidth and less CPU.
This option implies B<--diff=none>.
=item B<--state-cache-days>=I<number>
Save the state of the mirror in a cache file between runs. The cache will
expire after the specified number of days, at which time a full check and
cleanup of the mirror will be done. While the cache is valid, B<debmirror>
will trust that the mirror is consistent with this cache.
The cache is only used for files that have a unique name, i.e. binary
packages and source files. If a mirror update fails for any reason, the
cache will be invalidated and the next run will include a full check.
Main advantage of using the state cache is that it avoids a large amount
of disk access while checking which files need to be fetched. It may also
reduce the time required for mirror updates.
=item B<--ignore-small-errors>
Normally B<debmirror> will report an error if any deb files or sources
fail to download and refuse to update the meta data to an inconsistent
mirror. Normally this is a good things as it indicates something went
wrong during download and should be retried. But sometimes the
upstream mirror actually is broken. Specifying B<--ignore-small-errors>
causes B<debmirror> to ignore missing or broken deb and source files but
still be pedantic about checking meta files.
=item B<--allow-dist-rename>
The directory name for a dist should be equal to its Codename and not to
a Suite. If the local mirror currently has directories named after Suites,
B<debmirror> can rename them automatically.
An existing symlink from I<codename> to I<suite> will be removed,
but B<debmirror>
will automatically create a new symlink S<suite -E<gt> codename> (immediately
after moving meta files in place). This conversion should only be needed once.
=item B<--disable-ssl-verification>
When https is used, debmirror checks that the SSL certificate is value.
If the server has a self-signed certificate, the check can be disabled
with this option.
=item B<--debmarshal>
On each pull, keep the repository meta data from dists/* in a numbered
subdirectory, and maintain a symlink latest to the most recent pull.
This is similar to Debmarshal in tracking mode, see
debmarshal.debian.net for examples and use.
debmirror cleanup is disabled when this flag is specified.
Separate pool and snapshot cleanup utilities are available at
http://code.google.com/p/debmarshal/source/browse/#svn/trunk/repository2
=item B<--config-file>=I<file>
Specify a configuration file. This option may be repeated to read
multiple configuration files. By default debmirror reads
/etc/debmirror.conf and ~/.debmirror.conf (see section FILES).
=back
=head2 Experimental options
=over 4
=item B<--retry-rsync-packages>=I<number>
While downloading Packages and related files via rsync, try up to
this many times if rsync fails to connect. Defaults to 1, to try
only once. (A typical nondefault value is 10. To try an unlimited
number of times, use -1 or 0.)
=back
=head1 USING DEBMIRROR
=head2 Using regular expressions in options
Various options accept regular expressions that can be used to tune what
is included in the mirror. They can be any regular expression valid in
I<perl>, which also means that extended syntax is standard. Make sure to
anchor regular expressions appropriately: this is not done by debmirror.
The --include and --exclude options can be combined. This combination
for example will, if the --i18n option is used, exclude all F<Translation>
files, except for the ones for Portuguese (pt) and Brazillian (pt_BR):
--exclude='/Translation-.*' --include='/Translation-pt.*'
=head2 Mirroring Debian Installer images
Debmirror will only mirror the "current" images that are on the remote
mirror. At least one of the options --di-dist or --di-arch must be
passed to enable mirroring of the images.
The special values "dists" and "arches" can be used to tell debmirror
to use the same dists and architectures for D-I images as for the archive,
but it is also possible to specify different values. If either option is
not set, it will default to the same values as for the archive.
If you wish to create custom CD images using for example I<debian-cd>,
you will probably also want add the option "--rsync-extra=doc,tools".
B<Limitations>
There are no progress updates displayed for D-I images.
=head2 Archive size
The tables in the file F</usr/share/doc/debmirror/mirror_size> give an
indication of the space needed to mirror the Debian archive. They are
particularly useful if you wish to set up a partial mirror.
Only the size of source and binary packages is included. You should allow
for around 1-4 GB of meta data (in F<./dists/E<lt>distE<gt>>) per suite
(depending in your settings). Plus whatever space is needed for extra
directories (e.g. F<tools>, F<doc>) you wish to mirror.
The tables also show how much additional space is required if you add
a release on top of its predecessor. Note that the additional space
needed for testing and (to a lesser extent) unstable varies during the
development cycle of a release. The additional space needed for testing
is zero immediately after a stable release and grows from that time
onwards.
B<Note>
Debmirror keeps an extra copy of all meta data. This is necessary to
guarantee that the local mirror stays consistent while debmirror is
running.
=head1 EXAMPLES
Simply make a mirror in F</srv/mirror/debian>, using all defaults (or the
settings defined in F<debmirror.conf>):
debmirror /srv/mirror/debian
Make a mirror of i386 and sparc binaries, main only, and include both unstable
and testing versions of Debian; download from 'ftp.nl.debian.org':
debmirror -a i386,sparc -d sid -d etch -s main --nosource \
-h ftp.nl.debian.org --progress $HOME/mirror/debian
Make a mirror using rsync (rsync server is 'ftp.debian.org::debian'),
excluding the section 'debug' and the package 'foo-doc':
debmirror -e rsync $HOME/mirror/debian --exclude='/foo-doc_' \
--exclude-deb-section='^debug$'
=head1 FILES
/etc/debmirror.conf
~/.debmirror.conf
Debmirror will look for the presence of these files and load them
in the indicated order if they exist.
See the example in /usr/share/doc/debmirror/examples for syntax.
~/.gnupg/trustedkeys.gpg
When gpg checking is enabled,
debmirror uses gpgv to verify Release and Release.gpg using the
default keying ~/.gnupg/trustedkeys.gpg. This can be changed by
exporting GNUPGHOME resulting in $GNUPGHOME/trustedkeys.gpg being
used. (Note that keyring files can also be specified directly
with debmirror's --keyring option -- see above).
To add the right key to this keyring you can import it from the
debian keyring (in case of the debian archive) using:
gpg --keyring /usr/share/keyrings/debian-archive-keyring.gpg --export \
| gpg --no-default-keyring --keyring trustedkeys.gpg --import
or download the key from a keyserver:
gpg --no-default-keyring --keyring trustedkeys.gpg \
--keyserver keyring.debian.org --recv-keys <key ID>
The <key ID> can be found in the gpgv error message in debmirror:
gpgv: Signature made Tue Jan 23 09:07:53 2007 CET using DSA key ID 2D230C5F
=cut
use strict;
use Cwd;
use Storable qw(nstore retrieve);
use Getopt::Long;
use File::Temp qw/ tempfile /;
use File::Path qw(make_path);
use IO::Pipe;
use IO::Select;
use Fcntl;
use LockFile::Simple;
use Compress::Zlib;
use Digest::MD5;
use Digest::SHA;
use if $] lt "5.022", "Net::INET6Glue";
use Net::FTP;
use LWP::UserAgent;
our $version="1:2.29";
# Yeah, I use too many global variables in this program.
our $mirrordir;
our @config_files;
our ($debug, $progress, $verbose, $passive, $skippackages, $getcontents, $i18n);
our ($ua, $proxy, $ftp);
our (@dists, @sections, @arches, @ignores, @excludes, @includes, @keyrings);
our (@excludes_deb_section, @limit_priority);
our (%excludes_field, %includes_field);
our (@di_dists, @di_arches, @rsync_extra);
our $state_cache_days = 0;
our $verify_checksums = 0;
our $pre_cleanup=0;
our $post_cleanup=1;
our $no_cleanup=0;
our $do_source=1;
our $host="ftp.debian.org";
our $user="anonymous";
our $passwd="anonymous@";
our $remoteroot="debian";
our $download_method="ftp";
our $timeout=300;
our $max_batch=0;
our $rsync_batch=200;
our $num_errors=0;
our $bytes_to_get=0;
our $bytes_gotten=0;
our $bytes_meta=0;
our $doing_meta=1;
our $ignore_missing_release=0;
our $ignore_release_gpg=0;
our $start_time = time;
our $start_date = `LC_ALL=C date -R`;
chomp $start_date;
our $dry_run=0;
our $do_dry_run=0;
our $rsync_options="-aIL --partial";
our $ignore_small_errors=0;
our $diff_mode="use";
our $gzip_options="-9 -n --rsyncable";
our $omit_suite_symlinks=0;
our $allow_dist_rename=0;
our $debmarshal=0;
our $disable_ssl_verification;
our $retry_rsync_packages=1;
our $slow_cpu=0;
our $check_gpg=1;
our $new_mirror=0;
our $retry_rsync_packages_delay=30; # seconds
my @errlog;
my $HOME;
($HOME = $ENV{'HOME'}) or die "HOME not defined in environment!\n";
# Load in config files first so options can override them.
Getopt::Long::Configure qw(pass_through);
GetOptions('config-file=s' => \@config_files);
if (@config_files) {
foreach my $config_file (@config_files) {
die "Can't open config file $config_file!\n" if ! -r $config_file;
require $config_file;
}
} else {
require "/etc/debmirror.conf" if -r "/etc/debmirror.conf";
require "$HOME/.debmirror.conf" if -r "$HOME/.debmirror.conf";
}
# This hash contains the releases to mirror. If both codename and suite can be
# determined from the Release file, the codename is used in the key. If not,
# it can also be a suite (or whatever was requested by the user).
# The hash has tree subtypes:
# - suite: if both codename and suite could be determined from the Release file,
# the codename is the key and the value is the name of the suitei - used to
# update the suite -> codename symlinks;
# - mirror: set to 1 if the package archive should be mirrored for the dist;
# - d-i: set to 1 if D-I images should be mirrored for the dist.
# For the last two subtypes the key can also include a subdir.
my %distset=();
# This hash holds all the files we know about. Values are:
# - -1: file was not on mirror and download attempt failed
# - 0: file was not on mirror and either needs downloading or was
# downloaded this run
# - 1: file is on mirror and wanted according to meta data
# - 2: file is on mirror and listed in state cache, but not (yet)
# verified as wanted according to meta data
# Values -1 and 2 can occur in the state cache; see $files_cache_version
# below! Filenames should be relative to $mirrordir.
my %files;
# Hash to record size and checksums of meta files and package files (from the
# Release file and Source/Packages files).
my %file_lists;
# Hash to record which Translation files needs download. Contains size and sha1
# info. Files also get registered in %files.
my %i18n_get;
# Hash to record which DEP-11 metadata files need to be downloaded. Files
# also get registered in %files.
my %dep11_get;
# Hash to record which command-not-found metadata files need to be downloaded.
# Files also get registered in %files.
my %cnf_get;
# Separate hash for files belonging to Debian Installer images.
# This data is not cached.
my %di_files;
## State cache meta-data
my $use_cache = 0;
my $state_cache_exptime;
# Next variable *must* be changed if the structure of the %files hash is
# changed in a way that makes old state-cache files incompatible.
my $files_cache_version = "1.0";
my $help;
my $print_version;
Getopt::Long::Configure qw(no_pass_through);
GetOptions('debug' => \$debug,
'progress|p' => \$progress,
'verbose|v' => \$verbose,
'source!' => \$do_source,
'checksums!' => \$verify_checksums,
'md5sums|m' => \$verify_checksums, # back compat
'passive!' => \$passive,
'host|h=s' => \$host,
'user|u=s' => \$user,
'passwd=s' => \$passwd,
'root|r=s' => \$remoteroot,
'dist|d=s' => \@dists,
'section|s=s' => \@sections,
'arch|a=s' => \@arches,
'di-dist=s' => \@di_dists,
'di-arch=s' => \@di_arches,
'rsync-extra=s' => \@rsync_extra,
'precleanup' => \$pre_cleanup,
'cleanup' => \$pre_cleanup,
'postcleanup' => \$post_cleanup,
'nocleanup' => \$no_cleanup,
'ignore=s' => \@ignores,
'exclude=s' => \@excludes,
'exclude-deb-section=s' => \@excludes_deb_section,
'limit-priority=s' => \@limit_priority,
'include=s' => \@includes,
'exclude-field=s' => \%excludes_field,
'include-field=s' => \%includes_field,
'skippackages' => \$skippackages,
'i18n' => \$i18n,
'getcontents' => \$getcontents,
'method|e=s' => \$download_method,
'timeout|t=s' => \$timeout,
'max-batch=s' => \$max_batch,
'rsync-batch=s' => \$rsync_batch,
'state-cache-days=s' => \$state_cache_days,
'ignore-missing-release' => \$ignore_missing_release,
'ignore-release-gpg' => \$ignore_release_gpg,
'check-gpg!' => \$check_gpg,
'dry-run' => \$dry_run,
'proxy=s' => \$proxy,
'rsync-options=s' => \$rsync_options,
'gzip-options=s' => \$gzip_options,
'ignore-small-errors' => \$ignore_small_errors,
'diff=s' => \$diff_mode,
'omit-suite-symlinks' => \$omit_suite_symlinks,
'allow-dist-rename' => \$allow_dist_rename,
'debmarshal' => \$debmarshal,
'slow-cpu' => \$slow_cpu,
'disable-ssl-verification' => \$disable_ssl_verification,
'retry-rsync-packages=s' => \$retry_rsync_packages,
'keyring=s' => \@keyrings,
'help' => \$help,
'version' => \$print_version,
) or usage;
usage if $help;
usage("invalid number of arguments") if $ARGV[1];
if ($print_version) {
print "debmirror $version\n";
exit(0);
}
# This parameter is so important that it is the only required parameter,
# unless specified in a configuration file.
$mirrordir = shift if $ARGV[0];
usage("mirrordir not specified") unless defined $mirrordir;
# Constrain other parameters
$diff_mode="none" if $slow_cpu;
if ($download_method eq 'hftp') { # deprecated
$download_method='ftp';
}
$retry_rsync_packages =~ /^-?\d+$/
or die 'unusable retry-rsync-packages value';
$retry_rsync_packages < 1 and $retry_rsync_packages = -1;
# Check for patch binary if needed
if (!($diff_mode eq "none")) {
if (system("patch --version 2>/dev/null >/dev/null")) {
say("Patch binary missing, falling back to --diff=none");
push (@errlog,"Patch binary missing, falling back to --diff=none\n");
$diff_mode = "none";
}
if (system("ed --version 2>/dev/null >/dev/null")) {
say("Ed binary missing, falling back to --diff=none");
push (@errlog,"Ed binary missing, falling back to --diff=none\n");
$diff_mode = "none";
}
}
# Backwards compatibility: remote root dir no longer needs prefix
$remoteroot =~ s%^[:/]%% unless downloads_via_file();
# Post-process arrays. Allow commas to separate values the user entered.
# If the user entered nothing, provide defaults.
@dists=split(/,/,join(',',@dists));
@dists=qw(sid) unless @dists;
@sections=split(/,/,join(',',@sections));
@sections=qw(main contrib non-free main/debian-installer) unless @sections;
@arches=split(/,/,join(',',@arches));
@arches=qw(i386) unless @arches;
@arches=() if (join(',',@arches) eq "none");
@di_dists=split(/,/,join(',',@di_dists));
@di_arches=split(/,/,join(',',@di_arches));
if (@di_dists) {
@di_dists = @dists if ($di_dists[0] eq "dists");
@di_arches = @arches if (!@di_arches || $di_arches[0] eq "arches");
} elsif (@di_arches) {
@di_dists = @dists if (!@di_dists);
@di_arches = @arches if ($di_arches[0] eq "arches");
}
@rsync_extra=split(/,/,join(',',@rsync_extra));
@rsync_extra="trace" unless @rsync_extra;
if (! grep { $_ eq 'trace' } @rsync_extra) {
print STDERR "Warning: --rsync-extra is not configured to mirror the trace files.\n";
print STDERR " This configuration is not recommended.\n";
}
@rsync_extra=() if grep { $_ eq "none" } @rsync_extra;
$pre_cleanup=0 if ($no_cleanup);
$pre_cleanup=0 if ($debmarshal);
$post_cleanup=0 if ($no_cleanup);
$post_cleanup=0 if ($pre_cleanup);
$post_cleanup=0 if ($debmarshal);
# Display configuration.
$|=1 if $debug;
if ($passwd eq "anonymous@") {
if (downloads_via_http()) {
say("Mirroring to $mirrordir from $download_method://$host/$remoteroot/");
} else {
say("Mirroring to $mirrordir from $download_method://$user\@$host/$remoteroot/");
}
} else {
say("Mirroring to $mirrordir from $download_method://$user:XXX\@$host/$remoteroot/");
}
say("Arches: ".join(",", @arches));
say("Dists: ".join(",", @dists));
say("Sections: ".join(",", @sections));
say("Including source.") if $do_source;
say("D-I arches: ".join(",", @di_arches)) if @di_arches;
say("D-I dists: ".join(",", @di_dists)) if @di_dists;
say("Pdiff mode: $diff_mode");
say("Slow CPU mode.") if $slow_cpu;
say("Verifying checksums.") if $verify_checksums;
say("Not checking Release gpg signatures.") if ! $check_gpg;
say("Passive mode on.") if $passive;
say("Proxy: $proxy") if $proxy;
say("Download at most $max_batch files.") if ($max_batch > 0);
say("Download at most $rsync_batch files per rsync call.") if (downloads_via_rsync());
if ($pre_cleanup) {
say("Will clean up before mirroring.");
} elsif ($post_cleanup) {
say("Will clean up after mirroring.");
} else {
say("Will NOT clean up.");
}
say("Dry run.") if $dry_run;
say("Debmarshal snapshots kept.") if $debmarshal;
say("Disable SSL verification.") if $disable_ssl_verification;
# Set up mirror directory and resolve $mirrordir to a full path for
# locking and rsync
if (! -d $mirrordir) {
make_dir($mirrordir);
$new_mirror = 1;
}
die "You need write permissions on $mirrordir" if (! -w $mirrordir);
chdir($mirrordir) or die "chdir $mirrordir: $!";
$mirrordir = cwd();
# Handle the lock file. This is the same method used by official
# Debian push mirrors.
my $hostname=`hostname -f 2>/dev/null || hostname`;
chomp $hostname;
my $lockfile="Archive-Update-in-Progress-$hostname";
say("Attempting to get lock ...");
my $lockmgr = LockFile::Simple->make(-format => "%f/$lockfile", -max => 12,
-delay => 10, -nfs => 1, -autoclean => 1,
-warn => 1, -stale => 1, -hold => 0);
my $lock = $lockmgr->lock("$mirrordir")
or die "$lockfile exists or you lack proper permissions; aborting";
$SIG{INT}=sub { $lock->release; exit 1 };
$SIG{TERM}=sub { $lock->release; exit 1 };
# Create tempdir if missing
my $tempdir=".temp";
make_dir($tempdir) if (! -d $tempdir);
die "You need write permissions on $tempdir" if (! -w $tempdir);
# Load the state cache.
load_state_cache() if $state_cache_days;
# Register the trace and lock files.
my $tracefile="project/trace/$hostname";
$files{$tracefile}=1;
$files{$lockfile}=1;
my $rsynctempfile;
END { unlink $rsynctempfile if $rsynctempfile }
sub init_connection {
$_ = $download_method;
downloads_via_http() && do {
$ua = LWP::UserAgent->new(keep_alive => 1);
$ua->timeout($timeout);
$ua->proxy('http', $ENV{http_proxy}) if $ENV{http_proxy};
$ua->proxy('http', $proxy) if $proxy;
$ua->show_progress($progress);
return;
};
downloads_via_https() && do {
$ua = LWP::UserAgent->new(keep_alive => 1, ssl_opts => {
verify_hostname => ! $disable_ssl_verification });
$ua->timeout($timeout);
$ua->proxy('https', $ENV{https_proxy}) if $ENV{https_proxy};
$ua->proxy('https', $proxy) if $proxy;
$ua->show_progress($progress);
return;
};
downloads_via_ftp() && do {
if ($proxy || $ENV{ftp_proxy}) {
$ua = LWP::UserAgent->new;
$ua->timeout($timeout);
$ua->proxy('ftp', $proxy ? $proxy : $ENV{ftp_proxy});
}
else {
my %opts = (Debug => $debug, Passive => $passive, Timeout => $timeout);
$ftp=Net::FTP->new($host, %opts) or die "$@\n";
$ftp->login($user, $passwd) or die "login failed"; # anonymous
$ftp->binary or die "could not set binary mode";
$ftp->cwd("/$remoteroot") or die "cwd to /$remoteroot failed";
$ftp->hash(\*STDOUT,102400) if $progress;
}
return;
};
downloads_via_file() && do {
$ua = LWP::UserAgent->new;
$ua->timeout($timeout);
$ua->show_progress($progress);
$host='localhost';
return;
};
downloads_via_rsync() && do {
return;
};
usage("unknown download method: $_");
}
init_connection();
# determine remote root for rsync transfers
my $rsyncremote;
if (length $remoteroot) {
if (downloads_via_file()) {
$rsyncremote = "$remoteroot/";
}
else {
$rsyncremote = "$host\:\:$remoteroot/";
if ($user ne 'anonymous') {
$rsyncremote = "$user\@$rsyncremote";
}
}
}
else {
if (downloads_via_rsync()) {
die "rsync cannot be used with a root of $remoteroot/\n";
}
}
# Update the remote trace files; also update ignores for @rsync_extra.
rsync_extra(1, @rsync_extra);
# Get Release files without caching for http
say("Getting meta files ...");
$ua->default_header( "Cache-Control" => "max-age=0" ) if ($ua);
foreach my $dist (@dists) {
my $tdir="$tempdir/.tmp/dists/$dist";
my $have_release = get_release($tdir, $dist);
next unless ($have_release || $ignore_missing_release);
my ($codename, $suite, $dist_sdir) = name_release("mirror", $tdir, $dist);
if ($have_release) {
my $next;
make_dir ("dists/$codename$dist_sdir");
make_dir ("$tempdir/dists/$codename$dist_sdir");
rename("$tdir/Release", "$tempdir/dists/$codename$dist_sdir/Release")
or die "Error while moving $tdir/Release: $!\n";
$files{"dists/$codename$dist_sdir/Release"}=1;
$files{$tempdir."/"."dists/$codename$dist_sdir/Release"}=1;
if ($debmarshal) {
$next = make_next_snapshot($mirrordir,$dist,$codename,
$dist_sdir,$tempdir);
}
if (-f "$tdir/Release.gpg") {
rename("$tdir/Release.gpg", "$tempdir/dists/$codename$dist_sdir/Release.gpg")
or die "Error while moving $tdir/Release.gpg: $!\n";
$files{"dists/$codename$dist_sdir/Release.gpg"}=1;
$files{$tempdir."/"."dists/$codename$dist_sdir/Release.gpg"}=1;
if ($debmarshal) {
link_release_into_snapshot($mirrordir,$dist,$next,$tempdir,
$codename,$dist_sdir,"Release.gpg");
}
}
if (-f "$tdir/InRelease") {
rename("$tdir/InRelease", "$tempdir/dists/$codename$dist_sdir/InRelease")
or die "Error while moving $tdir/InRelease: $!\n";
$files{"dists/$codename$dist_sdir/InRelease"}=1;
$files{$tempdir."/"."dists/$codename$dist_sdir/InRelease"}=1;
if ($debmarshal) {
link_release_into_snapshot($mirrordir,$dist,$next,$tempdir,
$codename,$dist_sdir,"InRelease");
}
}
}
}
# Check that @di_dists contains valid codenames
di_check_dists() if @di_dists;
foreach my $dist (keys %distset) {
next unless exists $distset{$dist}{mirror};
# Parse the Release and extract the files listed for all checksum types.
if (open my $release, "<", "$tempdir/dists/$dist/Release") {
my $checksum_type;
while (<$release>) {
if (/^(MD5Sum|SHA\d+):/) {
$checksum_type=$1;
}
elsif (/^ / && defined $checksum_type) {
my ($checksum, $size, $filename) = /^ +([a-z0-9]+) +(\d+) +(.*)$/;
$file_lists{"$tempdir/dists/$dist/$filename"}{$checksum_type} = $checksum;
$file_lists{"$tempdir/dists/$dist/$filename"}{size} = $size;
}
}
close $release;
}
}
if ($num_errors != 0 && $ignore_missing_release) {
say("Ignoring failed Release files.");
push (@errlog,"Ignoring failed Release files\n");
$num_errors = 0;
}
if ($num_errors != 0) {
print "Errors:\n ".join(" ",@errlog) if (@errlog);
die "Failed to download some Release, Release.gpg or InRelease files!\n";
}
# Enable caching again for http
init_connection if ($ua);
# Calculate expected downloads for meta files
# As we don't actually download most of the meta files (due to getting
# only one compression variant or using diffs), we keep a separate count
# of the actual downloaded amount of data in $bytes_meta.
# The root Release files have already been downloaded
$bytes_to_get = $bytes_meta;
$bytes_gotten = $bytes_meta;
sub add_bytes {
my $name=shift;
$bytes_to_get += $file_lists{"$tempdir/$name"}{size} if exists $file_lists{"$tempdir/$name"}{size};
}
foreach my $dist (keys %distset) {
next unless exists $distset{$dist}{mirror};
foreach my $section (@sections) {
foreach my $arch (@arches, "all") {
add_bytes("dists/$dist/$section/binary-$arch/Packages");
add_bytes("dists/$dist/$section/binary-$arch/Packages.gz");
add_bytes("dists/$dist/$section/binary-$arch/Packages.xz");
add_bytes("dists/$dist/$section/binary-$arch/Release");
add_bytes("dists/$dist/$section/binary-$arch/Packages.diff/Index") unless ($diff_mode eq "none");
}
# d-i does not have separate source sections
if ($do_source && $section !~ /debian-installer/) {
add_bytes("dists/$dist/$section/source/Sources");
add_bytes("dists/$dist/$section/source/Sources.gz");
add_bytes("dists/$dist/$section/source/Sources.xz");
add_bytes("dists/$dist/$section/source/Release");
add_bytes("dists/$dist/$section/source/Sources.diff/Index") unless ($diff_mode eq "none");
}
add_bytes("dists/$dist/$section/i18n/Index");
}
}
# Get and parse MD5SUMS files for D-I images.
# (There are not currently other checksums for these.)
di_add_files() if @di_dists;
# Get Packages and Sources files and other miscellany.
my (@package_files, @source_files);
foreach my $dist (keys %distset) {
next unless exists $distset{$dist}{mirror};
foreach my $section (@sections) {
# some suites don't have d-i
next if ($section =~ /debian-installer/ && di_skip_dist($dist) );
foreach my $arch (@arches, "all") {
get_index("dists/$dist/$section/binary-$arch", "Packages");
link_index($dist,$section,$arch) if $debmarshal;
}
# d-i does not have separate source sections
if ($do_source && $section !~ /debian-installer/) {
get_index("dists/$dist/$section/source", "Sources");
link_index($dist,$section,"source") if $debmarshal;
}
}
}
# Set download size for meta files to actual values
$doing_meta=0;
$bytes_to_get=$bytes_meta;
$bytes_gotten=$bytes_meta;
# Sanity check. I once nuked a mirror because of this..
if (@arches && ! @package_files) {
print "Errors:\n ".join(" ",@errlog) if (@errlog);
die "Failed to download any Packages files!\n";
}
if ($do_source && ! @source_files) {
print "Errors:\n ".join(" ",@errlog) if (@errlog);
die "Failed to download any Sources files!\n";
}
if ($num_errors != 0) {
print "Errors:\n ".join(" ",@errlog) if (@errlog);
die "Failed to download some Package, Sources or Release files!\n";
}
# Activate dry-run option now if it was given. This delay is needed
# for the ftp method.
$do_dry_run = $dry_run;
# Determine size of Contents, Translation, and DEP-11 files to get.
if ($getcontents) {
# Updates of Contents files using diffs are done here; only full downloads
# are delayed.
say("Update Contents files.") if ($diff_mode ne "none");
my $update_contents_files_using_diffs = sub {
my($operational_parameters, $dist, $arch, $sect) = @_;
# In Debian Wheezy, the Contents-*.gz moved to '/dists/$dist/$sect/'.
# This handles the new location, but also checks the old location
# for backwards compatibility.
if ($diff_mode ne "none") {
if (!update_contents("dists/$dist$sect", "Contents-$arch")) {
add_bytes("dists/$dist$sect/Contents-$arch.gz");
}
} elsif (!check_lists("$tempdir/dists/$dist$sect/Contents-$arch.gz")) {
add_bytes("dists/$dist$sect/Contents-$arch.gz");
}
};
do_contents_for_each_dist_arch_sect(
$update_contents_files_using_diffs, [], {}
);
}
foreach my $dist (keys %distset) {
next unless exists $distset{$dist}{mirror};
foreach my $section (@sections) {
i18n_from_release($dist,"$section/i18n");
dep11_from_release($dist,"$section/dep11");
cnf_from_release($dist,"$section/cnf");
}
}
# close ftp connection to avoid timeouts, will reopen later
if ($ftp) { $ftp->quit; }
say("Parsing Packages and Sources files ...");
{
local $/="\n\n"; # Set input separator to read entire package
my $empty_mirror = 1;
my %arches = map { $_ => 1 } (@arches, "all");
my $include = "(".join("|", @includes).")" if @includes;
my $exclude = "(".join("|", @excludes).")" if @excludes;
my $exclude_deb_section =
"(".join("|", @excludes_deb_section).")" if @excludes_deb_section;
my $limit_priority = "(".join("|", @limit_priority).")" if @limit_priority;
my $field_filters =
scalar(keys %includes_field) || scalar(keys %excludes_field);
my %binaries;
foreach my $file (@package_files) {
next if (!-f $file);
open(my $fh, "<", $file) or die "$file: $!";
for (;;) {
unless (defined( $_ = <$fh> )) {
last if eof;
die "$file: $!" if $!;
}
my ($filename)=m/^Filename:\s+(.*)/im;
$filename=~s:/+:/:; # remove redundant slashes in paths
my ($deb_section)=m/^Section:\s+(.*)/im;
my ($deb_priority)=m/^Priority:\s+(.*)/im;
my ($architecture)=m/^Architecture:\s+(.*)/im;
next if (!$arches{$architecture});
if(!(defined($include) && ($filename=~/$include/o))) {
next if (defined($exclude) && $filename=~/$exclude/o);
next if (defined($exclude_deb_section) && defined($deb_section)
&& $deb_section=~/$exclude_deb_section/o);
next if (defined($limit_priority) && defined($deb_priority)
&& ! ($deb_priority=~/$limit_priority/o));
}
next if $field_filters && !check_field_filters($_);
my ($package)=m/^Package:\s+(.*)/im;
$binaries{$package} = 1;
# File was listed in state cache, or file occurs multiple times
if (exists $files{$filename}) {
if ($files{$filename} >= 0) {
$files{$filename} = 1 if $files{$filename} == 2;
$empty_mirror = 0;
next;
} else { # download failed previous run, retry
$files{$filename} = 0;
}
}
my ($size)=m/^Size:\s+(\d+)/im;
my %checksums;
while (m/^(MD5sum|SHA\d+):\s+([A-Za-z0-9]+)/img) {
$checksums{$1}=$2;
}
if (check_file(filename => $filename, size => $size, %checksums)) {
$files{$filename} = 1;
} else {
$files{$filename} = 0;
$file_lists{$filename} = \%checksums;
$file_lists{$filename}{size} = $size;
$bytes_to_get += $size;
}
$empty_mirror = 0;
}
close($fh);
}
foreach my $file (@source_files) {
next if (!-f $file);
open(my $fh, "<", $file) or die "$file: $!";
SOURCE:
for (;;) {
my $stanza;
unless (defined( $stanza = <$fh> )) {
last if eof;
die "$file: $!" if $!;
}
my @lines=split(/\n/, $stanza);
my $directory;
my %source_files;
my $parse_source_files=sub {
my $checksum_type=shift;
while (@lines && $lines[0] =~ m/^ ([A-Za-z0-9]+ .*)/) {
my ($checksum, $size, $filename)=split(' ', $1, 3);
$source_files{$filename}{size}=$size;
$source_files{$filename}{$checksum_type}=$checksum;
shift @lines;
}
};
while (@lines) {
my $line=shift @lines;
if ($line=~/^Directory:\s+(.*)/i) {
$directory=$1;
}
elsif ($line=~/^Section:\s+(.*)/i) {
my $deb_section=$1;
next SOURCE if (defined($exclude_deb_section) && defined($deb_section)
&& $deb_section=~/$exclude_deb_section/o);
}
elsif ($line=~/^Priority:\s+(.*)/i) {
my $deb_priority=$1;
next SOURCE if (defined($limit_priority) && defined($deb_priority)
&& ! ($deb_priority=~/$limit_priority/o));
}
elsif ($line=~/^Binary:\s+(.*)/i) {
if ($field_filters) {
my @binary_names=split(/\s*,\s*/,$1);
my $fetching_binary=0;
for my $binary_name (@binary_names) {
if (exists $binaries{$binary_name}) {
$fetching_binary=1;
last;
}
}
next SOURCE unless $fetching_binary;
}
}
elsif ($line=~/^Files:/i) {
$parse_source_files->("MD5Sum");
}
elsif ($line=~/^Checksums-(\w+):/i) {
$parse_source_files->($1);
}
}
foreach my $filename (keys %source_files) {
my %file_data=%{$source_files{$filename}};
$filename="$directory/$filename";
$filename=~s:/+:/:; # remove redundant slashes in paths
if(!(defined($include) && $filename=~/$include/o)) {
next if (defined($exclude) && $filename=~/$exclude/o);
}
# File was listed in state cache, or file occurs multiple times
if (exists $files{$filename}) {
if ($files{$filename} >= 0) {
$files{$filename} = 1 if $files{$filename} == 2;
$empty_mirror = 0;
next;
} else { # download failed previous run, retry
$files{$filename} = 0;
}
}
if (check_file(filename => $filename, %file_data)) {
$files{$filename} = 1;
} else {
$files{$filename} = 0;
$file_lists{$filename} = \%file_data;
$bytes_to_get += $file_data{size};
}
}
$empty_mirror = 0;
}
close($fh);
}
# Sanity check to avoid completely nuking a mirror.
if ($empty_mirror && ! $new_mirror) {
print "Errors:\n ".join(" ",@errlog) if (@errlog);
die "No packages after parsing Packages and Sources files!\n";
}
}
# With pre-mirror cleanup Contents, Translation, and DEP-11 files need to be
# downloaded before the cleanup as otherwise they would be deleted
# because they haven't been registered yet.
# With post-mirror cleanup it's more neat to do all downloads together.
# This could be simplified if we could register the files earlier.
# Download Contents, Translation, and DEP-11 files.
init_connection();
get_contents_files() if ($getcontents);
get_i18n_files();
get_dep11_files();
get_cnf_files();
# Pre-mirror cleanup
if ($pre_cleanup) {
# close ftp connection during cleanup to avoid timeouts
if ($ftp) { $ftp->quit; }
cleanup_unknown_files();
init_connection();
}
say("Files to download: ".print_dl_size($bytes_to_get - $bytes_gotten));
# Download all package files that we need to get.
batch_get();
sub batch_get {
if (uses_LWP()) {
my $dirname;
my $i=0;
foreach my $file (sort keys %files) {
if (!$files{$file}) {
if (($dirname) = $file =~ m:(.*)/:) {
make_dir($dirname);
}
if ($ftp) {
ftp_get($file);
}
else {
http_get($file);
}
if ($max_batch > 0 && ++$i >= $max_batch) {
push (@errlog,"Batch limit exceeded, mirror run was partial\n");
$num_errors++;
last;
}
}
}
return;
}
else {
my $opt=$rsync_options;
my $fh;
my @result;
my $i=0;
my $j=0;
$opt .= " --progress" if $progress;
$opt .= " -v" if $verbose or $debug;
$opt .= " -n" if $do_dry_run;
$opt .= " --no-motd" unless $verbose;
foreach my $file (sort keys %files) {
if (!$files{$file}) {
my $dirname;
my @dir;
($dirname) = $file =~ m:(.*/):;
@dir= split(/\//, $dirname);
for (0..$#dir) {
push (@result, "" . join('/', @dir[0..$_]) . "/");
}
push (@result, "$file");
if (++$j >= $rsync_batch) {
$j = 0;
($fh, $rsynctempfile) = tempfile();
if (@result) {
@result = sort(@result);
my $prev = "not equal to $result[0]";
@result = grep($_ ne $prev && ($prev = $_, 1), @result);
for (@result) {
print $fh "$_\n";
}
}
while (1) {
system (
"rsync --timeout=$timeout $opt $rsyncremote --include-from=$rsynctempfile --exclude='*' $mirrordir"
);
my $rc = $?;
last if ($rc == 0);
# Retry on connection failures
if (($rc>>8) == 5) {
die "rsync failed too many times!"
if ($retry_rsync_packages >= 1 && --$retry_rsync_packages < 1);
say("Pausing before retry...");
sleep($retry_rsync_packages_delay);
}
else {
die "rsync failed!";
}
}
close $fh;
unlink $rsynctempfile;
foreach my $dest (@result) {
if (-f $dest) {
if (!check_lists($dest)) {
say("$dest failed checksum verification");
$num_errors++;
}
} elsif (!-d $dest) {
say("$dest missing");
$num_errors++;
}
}
@result = ();
}
if ($max_batch > 0 && ++$i >= $max_batch) {
print "Batch limit exceeded, mirror run will be partial\n";
push (@errlog,"Batch limit exceeded, mirror run was partial\n");
$num_errors++;
last;
}
}
}
($fh, $rsynctempfile) = tempfile();
if (@result) {
@result = sort(@result);
my $prev = "not equal to $result[0]";
@result = grep($_ ne $prev && ($prev = $_, 1), @result);
for (@result) {
print $fh "$_\n";
}
system ("rsync --timeout=$timeout $opt $rsyncremote --include-from=$rsynctempfile --exclude='*' $mirrordir");
close $fh;
foreach my $dest (@result) {
if (-f $dest) {
if (!check_lists($dest)) {
say("$dest failed checksum verification");
$num_errors++;
}
} elsif (!-d $dest) {
say("$dest missing");
$num_errors++;
}
}
}
return;
}
}
if (! @di_dists) {
download_finished();
}
say("Everything OK. Moving meta files ...");
if ($debmarshal) {
update_latest_links($mirrordir, $tempdir, @dists);
}
chdir($tempdir) or die "unable to chdir($tempdir): $!\n";
my $res=0;
foreach my $file (`find . -type f`) {
chomp $file;
$file=~s:^\./::;
# this skips diff files if unwanted
next if (!exists $files{$file});
print("Moving $file\n") if ($debug);
if (! $do_dry_run) {
$res &= unlink($mirrordir."/".$file) if ($mirrordir."/".$file);
"$file" =~ m,(^.*)/,;
make_dir("$mirrordir/$1");
if (!link($file, $mirrordir."/".$file)) {
$res &= system("cp $file $mirrordir/$file");
}
}
}
chdir($mirrordir) or die "chdir $mirrordir: $!";
# Get optional directories using rsync.
rsync_extra(0, @rsync_extra);
# Download D-I images.
if (@di_dists) {
di_get_files();
download_finished();
}
# Update suite->codename symlinks.
if (! $omit_suite_symlinks && ! $do_dry_run) {
my %suites;
opendir (DIR, 'dists') or die "Can't open dists/: $!\n";
foreach my $file (grep (!/^\.\.?$/, readdir (DIR))) {
if (-l "dists/$file") {
my $cur = readlink("dists/$file") or die "Error reading symlink dists/$file: $!";
if (exists $distset{$cur}{suite} &&
($file eq $distset{$cur}{suite} || $file eq "stable-$distset{$cur}{suite}")) {
$suites{$file} = "ok";
} else {
unlink("dists/$file") or die "Failed to remove symlink dists/$file: $!";
}
}
}
closedir (DIR);
foreach my $dist (keys %distset) {
next if (! exists $distset{$dist}{suite});
next if (!-d "dists/$dist");
my $suite = $distset{$dist}{suite};
if (! exists $suites{$suite}) {
symlink("$dist", "dists/$suite") or die "Failed to create symlink dists/$suite: $!";
}
if ($suite eq "proposed-updates"&& !exists $suites{"stable-$suite"}) {
symlink("$dist", "dists/stable-$suite") or die "Failed to create symlink dists/stable-$suite: $!";
}
}
}
# Write out trace file.
if (! $do_dry_run) {
make_dir("project/trace");
my $end_date = `LC_ALL=C date -R`;
chomp $end_date;
my $trace_dists = join(' ', @dists);
my $trace_arches = join(' ', @arches);
$trace_arches .= ' source' if $do_source;
open my $out, '>', $tracefile or die "$tracefile: $!";
print $out `LC_ALL=C date -u`;
print $out <<EOF;
Date: $end_date
Date-Started: $start_date
Used debmirror version: $version
Creator: debmirror $version
Running on host: $hostname
Suites: $trace_dists
Architectures: $trace_arches
Upstream-Mirror: $host
EOF
close $out;
}
# Post mirror cleanup.
cleanup_unknown_files() if ($post_cleanup && ! $debmarshal);
# Mirror cleanup for directories.
if (! $use_cache && ($pre_cleanup || $post_cleanup)) {
# Remove all empty directories. Not done as part of main cleanup
# to prevent race problems with pool download code, which
# makes directories.. Sort so they are removable in bottom-up
# order.
chdir($mirrordir) or die "chdir $mirrordir: $!";
system("find . -depth -type d ! -name . ! -name .. -print0 | xargs -0 rmdir 2>/dev/null") if (! $do_dry_run);
}
if ($res != 0) {
die("Failed to move some meta files.");
}
# Save the state cache.
save_state_cache() if $state_cache_days && !$do_dry_run;
say("All done.");
$lock->release;
print "Errors:\n ".join(" ",@errlog) if (@errlog);
if ($num_errors != 0) {
print "Failed to download files ($num_errors errors)!\n";
exit 1 if (!$ignore_small_errors);
}
exit;
sub print_dl_size {
my $size=shift;
my $unit;
if ($size >= 10*1000*1024) {
$size=int($size/1024/1024);
$unit="MiB";
} elsif ($size >= 10*1000) {
$size=int($size/1024);
$unit="kiB";
} else {
$unit="B";
}
return "$size $unit";
}
sub add_bytes_gotten {
my $size=shift;
$bytes_gotten += $size;
if ($doing_meta) {
$bytes_meta += $size;
}
}
# Return true if a package stanza is permitted by
# --include-field/--exclude-field.
sub check_field_filters {
my $stanza = shift;
for my $name (keys %includes_field) {
if ($stanza=~/^\Q$name\E:\s+(.*)/im) {
my $value=$1;
return 1 if $value=~/$includes_field{$name}/;
}
}
return 0 if keys %includes_field;
for my $name (keys %excludes_field) {
if ($stanza=~/^\Q$name\E:\s+(.*)/im) {
my $value=$1;
return 0 if $value=~/$excludes_field{$name}/;
}
}
return 1;
}
# Takes named parameters: filename, size.
#
# Optionally can also be passed parameters specifying expected checksums
# for the file, using checksum names as in the Release/Packages/Sources files
# ("SHA1", "MD5Sum", etc).
#
# Size is always checked; verifying the checksum is optional. However, if
# a value of -1 is passed for size, a check of the checksum is forced.
#
# It will return true if the tests show the file matches.
sub check_file {
my %params=@_;
my ($filename, $size)=delete @params{qw{filename size}};
if (! -f $filename) {
return 0;
}
my $disksize = -s _;
if ($size == $disksize || $size == -1) {
if ($verify_checksums || $size == -1) {
# Prefer checking stronger checksums, and failing that, fall back
# to whatever checksums are present and supported, trying to prefer
# FOObignum over FOOsmallnum.
my ($summer, $checksum);
foreach my $checksum_type ("SHA512", "SHA256", "SHA1", reverse sort keys %params) {
next unless defined $params{$checksum_type};
if (lc $checksum_type eq 'md5sum') {
$summer=Digest::MD5->new;
}
elsif ($checksum_type=~/^sha(\d+)$/i) {
# returns undef on unknown/too large SHA type
$summer=Digest::SHA->new($1);
}
if (defined $summer) {
$checksum=$params{$checksum_type};
last;
}
}
if (! defined $summer) {
die "unsupported checksum type(s): ".(join(" ", keys %params))."\n";
}
open my $handle, "<", $filename or die "$filename: $!";
$summer->addfile($handle);
close $handle;
return 1 if $checksum eq $summer->hexdigest;
}
else {
return 1;
}
}
return 0;
}
# Check uncompressed diff content against sha1sum from Index file.
sub check_diff {
my ($filename, $size, $sha1) = @_;
my $digest = Digest::SHA->new(1);
my $ret = 0;
if (-f "$filename.gz") {
system_redirect_io("gzip -d", "$filename.gz", "$filename");
if ($size == -s $filename) {
open my $handle, "<", $filename or die "$filename: $!";
$digest->addfile($handle);
close $handle;
$ret = ($sha1 eq $digest->hexdigest);
}
unlink ($filename);
}
return $ret;
}
# Check file against checksum and size from the Release file.
# It will return true if the checksum matches.
sub check_lists {
my $file = shift;
my $t = $verify_checksums;
my $ret = 1;
$verify_checksums = 1;
if (exists $file_lists{$file}{size}) {
$ret = check_file(filename => $file, %{$file_lists{$file}});
}
$verify_checksums = $t;
return $ret;
}
sub remote_get {
my $file=shift;
my $tdir=shift;
my $res;
return 1 if ($skippackages);
$tdir=$tempdir unless $tdir;
chdir($tdir) or die "unable to chdir($tdir): $!\n";
if (uses_LWP()) {
$res=$ftp ? ftp_get($file) : http_get($file);
$res=$res && check_lists($file);
if (-f $file && !$res) {
say("$file failed checksum verification, removing");
unlink($file) if (-f $file);
}
}
else {
$res=rsync_get($file);
$res=$res && check_lists($file);
if (-f $file && !$res) {
say("$file failed checksum verification");
# FIXME: make sure the size doesn't match so it gets retried
}
}
chdir($mirrordir) or die "unable to chdir($mirrordir): $!\n";
return $res;
}
sub print_percent {
my $message=shift;
my $percent = $bytes_to_get ? (($bytes_gotten / $bytes_to_get)*100) : 0;
printf "[%3.0f%%] %s", $percent, $message;
}
# Get a file via http, or possibly ftp if a proxy is being used with that
# method. First displaying its filename if progress is on.
sub http_get {
my $oldautoflush = $|;
$| = 1;
my $file=shift;
my $url;
if ($user eq 'anonymous'){
$url="$download_method://${host}/${remoteroot}/${file}";
}
else {
$url="$download_method://${user}:${passwd}\@${host}/${remoteroot}/${file}";
}
my $ret=1;
print "$url => " if $debug;
print_percent "Getting: $file... " if $progress or $verbose;
print "\t #" if $progress;
if (! $do_dry_run) {
unlink $file if -f $file;
my $tmpfile="$file-$$";
unlink $tmpfile if -f $tmpfile;
my $prevsize=0;
eval {
open my $fh, ">", $tmpfile or die "Can't open $tmpfile: $!";
for (;;) {
my $got=0;
my $write_content=sub {
print $fh $_[0] or die "Can't write to $tmpfile: $!";
$fh->flush;
$got += length $_[0];
};
my %headers;
$headers{Range}="bytes=$prevsize-" if $prevsize;
$headers{':content_cb'}=$write_content;
my $response=$ua->get($url, %headers);
print $response->status_line . "\n" if $debug;
die $response->header('X-Died') if $response->header('X-Died');
if ($response->is_success) {
my $content_length=$response->header('Content-Length');
if (defined $content_length) {
if ($got < $content_length) {
# We got a partial response, but if we at least made some
# progress then we can try again.
if ($got > 0) {
print "Got $got out of $content_length bytes.\n"
if $progress or $verbose;
print "$url => " if $debug;
print_percent "Retrying: $file... " if $progress or $verbose;
print "\t #" if $progress;
$prevsize += $got;
next;
} else {
die "Transfer truncated: " .
"only $got out of $content_length bytes received\n";
}
} elsif ($got > $content_length) {
die "Content-Length mismatch: " .
"expected $content_length bytes, got $got\n";
}
}
} else {
die "Download of $file failed: " . $response->status_line . "\n";
}
last;
}
};
if ($@) {
unlink $tmpfile if -f $tmpfile;
$files{$file} = -1;
warn $@ if $progress or $verbose;
push (@errlog,$@);
$num_errors++;
$ret='';
} else {
rename $tmpfile, $file;
print "ok\n" if $progress or $verbose;
$ret=1;
}
} elsif ($progress || $verbose) {
print "ok\n";
}
# Account for actual bytes gotten
my @stat = stat $file;
add_bytes_gotten($stat[7]) if (@stat);
$| = $oldautoflush;
return $ret;
}
# Get a file via ftp, first displaying its filename if progress is on.
sub ftp_get {
my $oldautoflush = $|;
$| = 1;
my $file=shift;
my $mtime;
my @stat = stat $file;
if (@stat) { # already have the file?
my $size = $ftp->size($file);
my $mtime = $ftp->mdtm($file);
if ($mtime && $size
&& $size == $stat[7]
&& $mtime == $stat[9]) { # size and time match
print_percent "Keeping: $file\n" if $progress or $verbose;
add_bytes_gotten($size);
return 1;
}
}
print_percent "Getting: $file" if $progress or $verbose;
print "\t #" if $progress;
my $ret=1;
if (! $do_dry_run) {
unlink($file) if (-f $file);
$ret = $ftp->get($file, $file);
if ($ret) {
my $mtime=$ftp->mdtm($file);
utime($mtime, $mtime, $file) if defined $mtime;
} else {
$files{$file} = -1;
warn " failed:".$ftp->message if ($progress or $verbose);
push (@errlog,"Download of $file failed: ".$ftp->message."\n");
$num_errors++;
}
}
my $size=$ftp->size($file);
add_bytes_gotten($size) if $size;
$| = $oldautoflush;
print "\n" if (($verbose and not $progress) or ($do_dry_run and $progress));
return $ret;
}
sub rsync_get {
my $file=shift;
my $opt=$rsync_options;
(my $dirname) = $file =~ m:(.*/):;
my @dir= split(/\//, $dirname);
for (0..$#dir) {
$opt = "$opt --include=" . join('/', @dir[0..$_]) . "/";
}
$opt .= " --progress" if $progress;
$opt .= " -v" if $debug;
$opt .= " --no-motd" unless $verbose;
system ("rsync --timeout=$timeout $opt $rsyncremote --include=$file --exclude='*' .");
if ($? == 0 && -f $file) {
return 1;
} else {
$files{$file} = -1;
push (@errlog,"Download of $file failed\n");
$num_errors++;
return 0;
}
}
sub rsync_extra {
my ($early, @extras) = @_;
my @includes;
if (! defined $rsyncremote) {
say("Not able to use rsync to update remote trace files ...");
return;
}
# @ignores is updated during $early to prevent removal of files
# if cleanup is done early.
for my $type (@extras) {
if ($early) {
if ($type eq "trace") {
push(@includes, "- /project/trace/$hostname");
push(@includes, "/project/trace/*");
push(@ignores, "^project/trace/");
say("Updating remote trace files (using rsync) ...");
} elsif ($type eq "doc") {
push(@ignores, "^doc/");
push(@ignores, "^README*");
} elsif ($type eq "tools") {
push(@ignores, "^tools/");
} elsif ($type eq "indices") {
push(@ignores, "^indices/");
}
} else {
if ($type eq "doc") {
push(@includes, "/doc/***");
push(@includes, "/README*");
} elsif ($type eq "tools") {
push(@includes, "/tools/***");
} elsif ($type eq "indices") {
push(@includes, "/indices/***");
}
}
}
return if (! @includes);
if (! $early) {
@extras = grep(!/^trace$/, @extras); # drop 'trace' from list
say("Updating extra files (using rsync): @extras.");
}
rsync_extra_get(@includes);
}
sub rsync_extra_get {
my @includes = @_;
my $fh;
my @result;
my $opt=$rsync_options;
$opt .= " --progress" if $progress;
$opt .= " -v" if $verbose or $debug;
$opt .= " -n" if $do_dry_run;
$opt .= " --no-motd" unless $verbose;
($fh, $rsynctempfile) = tempfile();
foreach my $line (@includes) {
if ($line !~ /^- /) {
my $dirname;
my @dir;
($dirname) = ($line =~ m:(.*/):);
@dir= split(/\//, $dirname);
for (1..$#dir) {
push (@result, "" . join('/', @dir[0..$_]) . "/");
}
}
push (@result, "$line");
}
for (@result) {
print $fh "$_\n";
}
my $ret=system("rsync --timeout=$timeout $opt $rsyncremote --delete --include-from=$rsynctempfile --exclude='*' $mirrordir");
if ($ret != 0) {
print STDERR "Warning: failed to use rsync to download extra files.\n";
}
close $fh;
unlink $rsynctempfile;
}
# run system() with stdin and stdout redirected to files
# unlinks stdout target file first to break hard links
sub system_redirect_io {
my ($command, $fromfile, $tofile) = @_;
if (-f $tofile) {
unlink($tofile) or die "unlink($tofile) failed: $!";
}
my $cmd="$command <$fromfile >$tofile";
system("$cmd");
die "Failed: $cmd\n" if ($? != 0);
}
sub split_dist {
my $dist = shift;
my ($dist_raw) = ($dist =~ m:^([^/]+)/?:);
$dist =~ m:^[^/]+(/.*)?$:;
my $dist_sdir = $1 // "";
return ($dist_raw, $dist_sdir);
}
sub get_next_snapshot {
my ($dist) = @_;
my $latest = readlink("$mirrordir/dists/$dist/latest");
if (defined $latest) {
$latest++;
} else {
$latest = 0;
}
return $latest;
}
sub make_next_snapshot {
my ($mirrordir, $dist, $codename, $dist_sdir, $tempdir) = @_;
my $next = get_next_snapshot($dist);
make_dir("$mirrordir/dists/$dist/$next");
unlink("$mirrordir/dists/$dist/$next/Release");
link("$tempdir/dists/$codename$dist_sdir/Release",
"$mirrordir/dists/$dist/$next/Release")
or die "Error while linking $tempdir/dists/$codename$dist_sdir/Release: $!\n";
return $next;
}
sub update_latest_links {
my ($mirrordir, $tempdir, @dists) = @_;
foreach my $dist (@dists) {
system("diff","-q","$mirrordir/dists/$dist/latest/Release",
"$tempdir/dists/$dist/Release");
if ($?) {
my $next = get_next_snapshot($dist);
say("Updating $mirrordir/dists/$dist/latest to $next");
unlink("$mirrordir/dists/$dist/latest");
symlink($next,"$mirrordir/dists/$dist/latest")
or die "Error while symlinking $mirrordir/dists/$dist/latest to $next: $\n";
} else {
say("Not updating $mirrordir/dists/$dist/latest");
}
}
}
sub link_release_into_snapshot {
my ($mirrordir,$dist,$next,$tempdir,$codename,$dist_sdir,$base) = @_;
unlink("$mirrordir/dists/$dist/$next/$base");
link("$tempdir/dists/$codename$dist_sdir/$base",
"$mirrordir/dists/$dist/$next/$base")
or die "Error while linking $tempdir/dists/$codename$dist_sdir/$base: $!\n";
}
sub link_contents_into_snapshot {
my ($dist,$mirrordir,$arch,$tempdir) = @_;
my $next = get_next_snapshot($dist);
push my @sects, @sections, "";
foreach my $sect (@sects) {
if ($sect ne "") {$sect = "/$sect";}
if (exists $file_lists{"$tempdir/dists/$dist$sect/Contents-$arch.gz"}{size}) {
unlink("$mirrordir/dists/$dist/$next$sect/Contents-$arch.gz");
link("$tempdir/dists/$dist$sect/Contents-$arch.gz",
"$mirrordir/dists/$dist/$next$sect/Contents-$arch.gz")
or die "Error while linking $tempdir/dists/$dist$sect/Contents-$arch.gz: $!\n";
}
}
}
sub link_auxfile_into_snapshot {
my ($file,$dist,$distpath,$filename,$mirrordir,$tempdir) = @_;
my $next = get_next_snapshot($dist);
my $target_path = "$mirrordir/dists/$dist/$next/$distpath";
say("linking $file");
unlink("$target_path/$filename");
make_path($target_path);
link("$tempdir/$file", "$target_path/$filename")
or die "Error while linking $tempdir/$file: $!";
}
# Split a clearsigned message into data and signature.
# Based on the similar SplitClearSignedFile in APT.
sub split_clearsigned_file {
my ($filename, $content_fh, $signature_fh) = @_;
my $found_message_start = '';
my $found_message_end = '';
my $skip_until_empty_line = '';
my $found_signature = '';
my $first_line = 1;
my $signed_message_not_on_first_line = '';
my $found_garbage = '';
open my $handle, "<", $filename or die "can't open $filename: $1";
while (my $line = <$handle>) {
$line =~ s/[\n\r]+$//;
if (not $found_message_start) {
if ($line eq '-----BEGIN PGP SIGNED MESSAGE-----') {
$found_message_start = 1;
$skip_until_empty_line = 1;
} else {
$signed_message_not_on_first_line = 1;
$found_garbage = 1;
}
} elsif ($skip_until_empty_line) {
if ($line eq '') {
$skip_until_empty_line = '';
}
} elsif (not $found_signature) {
if ($line eq '-----BEGIN PGP SIGNATURE-----') {
$found_signature = 1;
$found_message_end = 1;
print $signature_fh "$line\n";
} elsif (not $found_message_end) { # we are in the message block
# We don't have any fields that need to be dash-escaped, but
# implementations are free to encode all lines.
$line =~ s/^- //;
if ($first_line) { # first line does not need a newline
$first_line = '';
} else {
print $content_fh "\n";
}
# RFC 4880, section 7.1: trailing spaces and tabs are removed when
# the cleartext signature is generated.
$line =~ s/[ \t]+$//;
print $content_fh $line;
} else {
$found_garbage = 1;
}
} else {
print $signature_fh "$line\n";
if ($line eq '-----END PGP SIGNATURE-----') {
$found_signature = '';
}
}
}
$content_fh->flush;
$signature_fh->flush;
if ($found_message_start) {
if ($signed_message_not_on_first_line) {
die "Clearsigned file '$filename' does not start with a signed message block.\n";
} elsif ($found_garbage) {
die "Clearsigned file '$filename' contains unsigned lines or multiple signed message blocks.\n";
}
}
if ($found_signature) {
die "Signature in file $filename wasn't closed.\n";
}
if ($first_line and not $found_message_start and not $found_message_end) {
# This is an unsigned file, so don't generate an error, but splitting
# was unsuccessful nonetheless.
return 0;
} elsif ($first_line or not $found_message_start or not $found_message_end) {
# Syntax error.
die "Splitting of $filename failed as it doesn't contain all expected signature parts.";
}
return 1;
}
sub gpg_verify {
my ($real_filename, @files) = @_;
# Check for gpg
if (system("gpgv --version >/dev/null 2>/dev/null")) {
say("gpgv failed: gpgv binary missing?");
push (@errlog,"gpgv failed: gpgv binary missing?\n");
$num_errors++;
} else {
# Verify Release signature
my $outp = IO::Pipe->new;
my $errp = IO::Pipe->new;
my $statusp = IO::Pipe->new;
my $gpgvout = "";
my $gpgverr = "";
my $gpgvstatus = "";
if (my $child = fork) {
$outp->reader;
$errp->reader;
$statusp->reader;
my $sel = IO::Select->new;
$sel->add($outp, $errp, $statusp);
while (my @ready = $sel->can_read) {
for (@ready) {
my $buf = "";
my $bytesread = $_->read($buf, 1024);
if (!defined($bytesread)) {
die "read error: $!\n";
} elsif ($bytesread == 0) {
$sel->remove($_);
$_->close;
} else {
if ($_ == $outp) {
$gpgvout .= $buf;
} elsif ($_ == $errp) {
$gpgverr .= $buf;
} elsif ($_ == $statusp) {
$gpgvstatus .= $buf;
}
}
}
}
waitpid($child, 0) == -1
and die "was pid $child automatically reaped?\n";
}
else {
$outp->writer;
$errp->writer;
$statusp->writer;
STDOUT->fdopen(fileno($outp), "w") or die;
STDERR->fdopen(fileno($errp), "w") or die;
my $status_flags = fcntl($statusp, F_GETFD, 0)
or die "get flags on gpg status-fd: $!";
fcntl($statusp, F_SETFD, $status_flags & ~FD_CLOEXEC)
or die "clear close-on-exec flag on gpg status-fd: $!";
my @gpgv = qw(gpgv --output - --status-fd);
push @gpgv, fileno($statusp);
push @gpgv, (map { ('--keyring' => $_) } @keyrings);
push @gpgv, @files;
exec(@gpgv) or die "exec: $gpgv[0]: $!\n";
}
my $gpgv_ok = $gpgvstatus =~ /^\[GNUPG:\] GOODSIG /m;
# In debug or verbose mode, display the gpg error message on stdout.
if (! $gpgv_ok || $debug) {
print $gpgvstatus;
print $gpgvout;
print $gpgverr;
}
if ($verbose && ! $debug) {
print $gpgverr;
}
if (! $gpgv_ok) {
say("$real_filename signature does not verify.");
push (@errlog,"$real_filename signature does not verify\n");
$num_errors++;
}
}
}
sub get_release {
my ($tdir, $dist) = @_;
make_dir ("$tdir");
return 0 unless remote_get("dists/$dist/Release", "$tempdir/.tmp");
# Save current error state so we can roll back if $ignore_release_gpg
# is set; needed because remote_get() can register errors
my @t_errlog = @errlog;
my $t_errors = $num_errors;
remote_get("dists/$dist/InRelease", "$tempdir/.tmp");
my @inr_t_errlog = @errlog;
my $inr_t_errors = $num_errors;
remote_get("dists/$dist/Release.gpg", "$tempdir/.tmp");
# We only need one of InRelease and Release.gpg.
if ($inr_t_errors == $t_errors || $num_errors == $inr_t_errors) {
@errlog = @t_errlog;
$num_errors = $t_errors;
}
if (! $check_gpg) {
# Nothing to do.
}
else {
my $got_gpg = 0;
if (-f "$tdir/Release" && -f "$tdir/Release.gpg") {
$got_gpg = 1;
gpg_verify("$tdir/Release.gpg", "$tdir/Release.gpg", "$tdir/Release");
}
if (-f "$tdir/InRelease") {
my ($content_fh, $content_filename) = tempfile();
my ($signature_fh, $signature_filename) = tempfile();
eval {
if (split_clearsigned_file("$tdir/InRelease",
$content_fh, $signature_fh)) {
$got_gpg = 1;
gpg_verify("$tdir/InRelease",
$signature_filename, $content_filename);
} else {
say("InRelease file is not signed.");
}
};
if ($@) {
warn $@;
push (@errlog,$@);
$num_errors++;
}
unlink($content_filename);
unlink($signature_filename);
}
if (! $got_gpg) {
say("Release gpg signature does not verify, file missing.");
push (@errlog,"Release gpg signature does not verify\n");
$num_errors++;
}
}
if ($ignore_release_gpg) {
@errlog = @t_errlog;
$num_errors = $t_errors;
}
return 1
}
sub name_release {
my ($type, $tdir, $dist) = @_;
my ($codename, $suite);
my $origin = "unknown";
if (-f "$tdir/Release") {
my $buf = "";
if (open my $release, "<", "$tdir/Release") {
while (<$release>) {
last if /^MD5Sum:/;
$buf = $buf . $_;
}
close $release;
}
$_ = $buf;
($origin) = m/^Origin:\s+(.*)/im if (/^Origin:/im);
($codename) = m/^Codename:\s+(.*)/im;
($suite) = m/^Suite:\s+(.*)/im;
} elsif ($ignore_missing_release) {
$origin = "none";
}
# Allow for example "<codename|suite>/updates"; split into the
# raw dist (codename or suite) and the subdirectory.
my ($dist_raw, $dist_sdir) = split_dist($dist);
if ($origin eq "none") {
$codename = $dist_raw;
} elsif ($origin eq "Ubuntu" or $origin eq "Canonical" or $origin eq "UbuntuESM") {
if ($suite) {
say("Ubuntu Release file: using Suite ($suite).");
$codename = $suite;
} else {
say("Invalid Ubuntu Release file.");
push (@errlog,"Invalid Ubuntu Release file.\n");
$num_errors++;
next;
}
} elsif ($codename) {
if ($dist_raw ne $codename && $dist_raw ne $suite) {
say("Broken Release file: neither Codename nor Suite matches $dist.");
push (@errlog,"Broken Release file: neither Codename nor Suite matches $dist\n");
$num_errors++;
next;
}
} elsif ($suite) {
say("Release file does not contain Codename; using Suite ($suite).");
$codename = $suite;
} else {
say("Release file contains neither Codename nor Suite; using $dist.");
$codename = $dist_raw;
}
# For experimental the suite is the same as the codename
$suite = "" if (! $suite || $suite eq $codename);
die("Duplicate dist $codename$dist_sdir.\n")
if exists $distset{"$codename$dist_sdir"}{$type};
$distset{"$codename$dist_sdir"}{$type} = 1;
die("Conflicting suites '$suite' and '$distset{$codename}{suite}' for $codename.\n")
if (exists $distset{"$codename"}{suite} && ($suite ne $distset{$codename}{suite}));
$distset{$codename}{suite} = "$suite" if ($suite);
# This should be a one-time conversion only
if ($suite) {
if (-d "$tempdir/dists/$suite" && !-l "$tempdir/dists/$suite") {
rename_distdir("$tempdir/dists", $codename, $suite);
}
if (-d "dists/$suite" && !-l "dists/$suite") {
rename_distdir("dists", $codename, $suite);
}
}
return ($codename, $suite, $dist_sdir);
}
# Get Index file in the passed subdirectory.
sub get_index {
my $subdir=shift;
my $file=shift;
make_dir($subdir);
make_dir("$tempdir/$subdir");
if ($diff_mode ne "none" && exists $file_lists{"$tempdir/$subdir/$file.diff/Index"}{size}) {
if (!check_lists("$tempdir/$subdir/$file.diff/Index")) {
make_dir("$tempdir/$subdir/$file.diff");
if (!remote_get("$subdir/$file.diff/Index")) {
push (@errlog,"$subdir/$file.diff/Index failed checksum verification, removing\n");
} else {
fetch_and_apply_diffs(0, $subdir, $file);
if (check_lists("$tempdir/$subdir/$file")) {
if (! $slow_cpu) {
system_redirect_io("gzip $gzip_options", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.gz");
system_redirect_io("xz", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.xz");
}
}
}
} else {
$bytes_gotten += $file_lists{"$tempdir/$subdir/$file.diff/Index"}{size};
fetch_and_apply_diffs(0, $subdir, "$file");
if (check_lists("$tempdir/$subdir/$file")) {
if (! $slow_cpu) {
system_redirect_io("gzip $gzip_options", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.gz");