#!/usr/bin/perl -w

# TODO: I'd like to be able to tell it to get some extra files, by name.
# I'm thinking Contents files. It would be really nice if it could pull
# a whole directory -- think project/trace, or disks-i386...
# TODO: It would probably be cleaner and easier to learn if it took
# apt-style lines to tell where to mirror from and what portions to use.

=head1 NAME

debmirror - Debian partial mirror script, with ftp, http, hftp or
rsync and package pool support

=head1 SYNOPSIS

debmirror [options] <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.

To support package pools, 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. clean up unknown files

Any files and directories on the local mirror that are not in the list are
removed.

=item 3. 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 md5sum) checks.
Any necessary files are downloaded.

=back

=cut

sub usage {
  warn join(" ", @_)."\n" if @_;
  warn <<EOF;
Usage: $0 [--progress] [--verbose] [--debug] [--dry-run] [--help]
          [--host=remotehost] [--root=directory]
          [--method=ftp|hftp|http|rsync] [--passive]
          [--user=remoteusername] [--passwd=remoteuserpassword]
          [--proxy=http://user:pass\@url:port/]
          [--dist=foo[,bar,..] ...] [--omit-suite-symlinks]
          [--section=foo[,bar,..] ...] [--arch=foo[,bar,..] ...]
          [--adddir=directory] [--rsync-extra=foo[,bar,..] ...]
          [--di-dist=foo[,bar,..] ...] [--di-arch=foo[,bar,..] ...]
          [--source|--nosource] [--getcontents] [--md5sums]
          [--ignore-missing-release] [--ignore-release-gpg]
          [--ignore=regex] [--exclude=regex] [--include=regex]
          [--exclude-deb-section=regex] [--limit-priority=regex]
          [--timeout=seconds] [--max-batch=number]
          [--rsync-batch=number] [--rsync-options=options]
          [--postcleanup|--cleanup|--nocleanup] [--skippackages]
          [--pdiff=use|mirror|none] [--state-cache-days=number]
          [--ignore-small-errors] [--allow-dist-rename]
          <mirrordir>

For details, see man page.
EOF
  exit(1);
}

=head1 OPTIONS

=over 4

=item <mirrordir>

This required 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 --progress -p

Displays progress bars as files are downloaded.

=item --verbose -v

Displays progress between file downloads.

=item --debug

Enables verbose debug output, including ftp protocol dump.

=item --dry-run

Simulate a mirror run. This will still download the meta files to .temp
but won't replace the old meta files, won't download debs and source
files and only simulates cleanup.

=item --help

Display a usage summary.

=item --host=remotehost -h

Specify the remote host to mirror from. Defaults to ftp.debian.org,
you are strongly encouraged to find a closer mirror.

=item --root=directory -r directory

Specifies the directory on the remote host that is the root of the Debian
archive. Defaults to "debian", which will work for most mirrors. The root
directory has a dists/ subdirectory.

=item --method=ftp|hftp|http|rsync -e

Specify the method to download files. Currently, supported methods are
ftp, hftp (ftp over http proxy), http or rsync.

Note: starting with version 1.1 it is no longer needed to add a ':' prefix
for the root directory.

=item --passive

Download in passive mode.

=item --user=remoteusername -u

Specify the remote user name to use to log to the remote host. Helpful when
dealing with brain damaged proxy servers. Defaults to anonymous.

=item --passwd=remoteuserpassword

Specify the remote user password to use to log into the remote ftp host.
It is used with --user and defaults to anonymous@.

=item --proxy=http://user:pass@url:port/

Specifies the http proxy (like Squid) to use for http and hftp method.

=item --dist=foo[,bar,..] -d foo

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. Using the
links (stable, testing, unstable) does not have the expected results
but you may add those links manually. Defaults to mirroring sid.

=item --omit-suite-symlinks

With this option set, debmirror will not create the 'suite->codename'
symlink. This is needed for example when mirroring archived Debian
releases as they will all have either 'stable' or 'oldstable' as
suite in their Release files.

=item --section=foo[,bar,..] -s foo

Specify the section of Debian to mirror. Defaults to
main,contrib,non-free,main/debian-installer.

=item --arch=foo[,bar,..] -a foo

Specify the architectures to mirror. The default is --arch=i386.
Specifying --arch=none will mirror no archs.

=item --adddir directory

Also download Packages and Sources files from the specified directory
on the remote host (the directory is relative to the root of the
Debian archive). This feature is now obsolete and may be removed in
a future release.

=item --rsync-extra=foo[,bar,..]

Allows to also mirror files from a number of directories that are not part
of the package archive itself. Debmirror will B<always> use rsync for the
transfer of these files, irrespective of what transfer method is specified
in the --method option.

This option can therefore not be used if your remote mirror does not support
rsync, or if the mirror needs a different --root option for rsync than for
the main transfer method specified with --method.

The following values are supported.

=over 2

=item doc

Download all files and subdirectories in ./doc directory, and all README
files in the root directory of the archive.

=item indices

Download all files and subdirectories in ./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 tools

Download all files and subdirectories in ./tools directory.

=item trace

Download the remote mirror's trace files for the archive (./project/trace/*).

=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 comma's; unknown values are ignored.

=item --di-dist=dists | foo[,bar,..]

Mirror "current" Debian Installer images for the specified dists.
See further the section L<Mirroring Debian Installer images> below.

=item --di-arch=arches | foo[,bar,..]

Mirror "current" Debian Installer images for the specified architectures.
See further the section L<Mirroring Debian Installer images> below.

=item --source

Include source in the mirror (default).

=item --nosource

Do not include source.

=item --getcontents

Additionally download Contents.arch.gz files.

=item --md5sums -m

Use md5sums 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, debmirror will only check md5sums during runs
where the cache has expired or been invalidated, so it is worth considering
to use these two options together.

=item --ignore-missing-release

Don't fail if the Release file is missing.

=item --ignore-release-gpg

Don't fail if the Release.gpg file is missing.

=item --ignore=regex

Never delete any files whose filenames match the regex. May be used multiple times.

=item --exclude=regex

Never download any files whose filenames match the regex. May be used multiple times.

=item --include=regex

Don't exclude any files whose filenames match the regex. May be used multiple times.

=item --exclude-deb-section=regex

Never download any files whose Debian Section (games, doc, oldlibs,
science, ...) match the regex.  May be used multiple times.

=item --limit-priority=regex

Limit download to files whose Debian Priority (required, extra,
optional, ...) match the regex.  May be used multiple times.

=item --timeout=seconds -t

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 --max-batch=number

Download at most max-batch number of files (and ignore rest).

=item --rsync-batch=number

Download at most number of files with each rsync call and then loop.

=item --rsync-options=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 --postcleanup

Clean up the local mirror but only after mirroring is complete and
only if there was no error. This is the default.

=item --cleanup

Do clean up any unknown files and directories on the local mirror (see
step 2 above).

=item --nocleanup

Do not clean up the local mirror after mirroring is complete.

=item --skippackages

Don't re-download Packages and Sources files. Useful if you know they are
up-to-date.

=item --pdiff=use|mirror|none

If --pdiff=use is specified and the Release file contains entries for
pdiff files, then debmirror will attempt to use them to update the
Packages and Sources files (can reduce download size of meta files),
but will not include them in the mirror. This is the default behavior
and avoids having time consuming pdiff files for a fast local mirror.
Specifying --pdiff=mirror does the same as 'use', but will also include
the downloaded pdiff files in the local mirror. Specify --pdiff=none to
completely ignore pdiff files.

=item --state-cache-days=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, 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 --ignore-small-errors

Normally 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 --ignore-small-errors
causes debmirror to ignore missing or broken deb and source files but
still be pedantic about checking meta files.

=item --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.
debmirror can rename them automatically.
An existing symlink 'codename->suite' will be removed, but debmirror will
automatically create a new symlink 'suite->codename' (immediately after
moving meta files in place). This conversion should only be needed once.

=back

=head1 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" resp. "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".

=head2 Limitations

There are no progress updates displayed for D-I images.

=head1 ARCHIVE SIZE

The tables below give an indication of the space needed to mirror the
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 have to allow for around 1-4 GB of meta data (in dists/<dist>) per
suite (depending in your settings) [1]. Plus whatever space is needed
for extra directories (e.g. tools, 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 extend) 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.

Total archive size (binary + source) per section:

 (in MiB)|  etch |      lenny       |     squeeze      |       sid       |    all
---------+-------+------------------+------------------+-----------------+-------
main     | 79844 | 119617 (+114304) | 144855 (+109368) | 158548 (+52139) | 355343
contrib  |   448 |   1379 (+  1264) |   1222 (+   339) |   1284 (+  129) |   2163
non-free |  1752 |   5274 (+  4749) |   5570 (+  3256) |   6028 (+ 1471) |  11226
main/d-i |   297 |    360 (+   359) |    363 (+   171) |    353 (+  232) |   1061
---------+-------+------------------+------------------+-----------------+-------
total    | 82342 | 126633 (+120678) | 152012 (+113136) | 166215 (+53973) | 369795

Archive size per section for a single architecture (i386) without source:

 (in MiB)|  etch |      lenny       |     squeeze      |       sid       |   all
---------+-------+------------------+------------------+-----------------+-------
main     | 12985 |  18634 (+ 17833) |  22448 (+ 17507) |  24435 (+ 7340) |  55638
contrib  |   112 |    341 (+   306) |    285 (+    62) |    289 (+   18) |    499
non-free |   584 |   1869 (+  1676) |   2161 (+  1294) |   2327 (+  416) |   3971
main/d-i |    23 |     37 (+    36) |     38 (+    13) |     40 (+   29) |    103
---------+-------+------------------+------------------+-----------------+-------
total    | 13707 |  20882 (+ 19851) |  24934 (+ 18876) |  27093 (+ 7803) |  60213

Archive size per architecture (source and arch=all packages are shown
separately):

 (in MiB)|  etch |     lenny        |     squeeze      |       sid       |    all
---------+-------+------------------+------------------+-----------------+-------
source   | 13261 |  19291 (+ 15911) |  22466 (+ 13117) |  23935 (+ 3923) |  46122
all      |  7906 |  12496 (+ 11626) |  14799 (+ 11120) |  16046 (+ 2780) |  33429
i386     |  5801 |   8385 (+  8225) |  10135 (+  7757) |  11047 (+ 5024) |  26784
amd64    |  5656 |   8555 (+  8419) |  10359 (+  7879) |  11236 (+ 5124) |  27057
alpha    |  5853 |   7976 (+  7814) |   9643 (+  7309) |  10309 (+ 3900) |  24855
arm      |  5122 |   7087 (+  6942) |                  |                 |  12064
armel    |       |   7179 (+  7179) |   8697 (+  6707) |   9101 (+ 3348) |  17214
hppa     |  5545 |   7619 (+  7463) |   9220 (+  6872) |   9878 (+ 3312) |  23172
ia64     |  6478 |   9257 (+  9076) |  11020 (+  8205) |  11681 (+ 4056) |  27790
mips     |  5356 |   7679 (+  7517) |   9353 (+  7092) |   9775 (+ 2433) |  22379
mipsel   |  5225 |   7541 (+  7389) |   9166 (+  6940) |   9506 (+ 2742) |  22276
powerpc  |  5788 |   8247 (+  8094) |  10047 (+  7586) |  10813 (+ 4267) |  25716
s390     |  5100 |   7562 (+  7410) |   8932 (+  6694) |   9557 (+ 3563) |  22750
sparc    |  5245 |   7752 (+  7606) |   9551 (+  7235) |  10086 (+ 3307) |  23372
kfreebsd-i386                       |   4232 (+  4232) |   6655 (+ 3200) |   7432
kfreebsd-amd64                      |   4386 (+  4386) |   6582 (+ 2987) |   7374

All numbers reflect the state of te archive per 19 Aug 2009.

[1] Note that 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

 debmirror /mirror/debian

Simply make a mirror in /mirror/debian, using all defaults (or the settings
defined in debmirror.conf).

 debmirror -a i386,sparc -d sid -d etch -s main --nosource \
           -h ftp.nl.debian.org --progress $HOME/debian/mirror

Make a mirror of i386 and sparc binaries, main only, and include both unstable
and testing versions of Debian. Download from ftp.kernel.org.

 debmirror -e rsync -r :debian $HOME/debian/mirror

Make a mirror using rsync. rsync server is ftp.debian.org::debian.

=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

    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.

    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 Net::FTP;
use Getopt::Long;
use File::Temp qw/ tempfile /;
use LockFile::Simple;
use Compress::Zlib;
use Digest::MD5;
use Digest::SHA1;
use LWP::UserAgent;

# Yeah, I use too many global variables in this program.
our ($debug, $progress, $verbose, $passive, $skippackages, $getcontents);
our ($ua, $proxy);
our (@rdists, @sections, @arches, @extra_dirs, @ignores, @excludes, @includes);
our (@excludes_deb_section, @limit_priority);
our (@di_dists, @di_arches, @rsync_extra);
our $state_cache_days = 0;
our $check_md5sums = 0;
our $check_downloads = 0;
our $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_release=0;
our $ignore_release_gpg=0;
our $start_time = time;
our $dry_run=0;
our $dry_run_var=0;
our $rsync_options="-aIL --partial";
our $ignore_small_errors=0;
our $pdiff_mode="use";
our $omit_suite_symlinks=0;
our $allow_dist_rename=0;
my @errlog;
my $HOME;
($HOME = $ENV{'HOME'}) or die "HOME not defined in environment!\n";

# Load in config files
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. The codename is the key and
# the value is the name of the suite.
my %dists=();

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

# 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;
GetOptions('debug'                  => \$debug,
	   'progress|p'             => \$progress,
	   'verbose|v'              => \$verbose,
	   'source!'                => \$do_source,
	   'md5sums|m'              => \$check_md5sums,
	   'nomd5sums'              => \$check_downloads,
	   'passive!'               => \$passive,
	   'host|h=s'               => \$host,
	   'user|u=s'               => \$user,
	   'passwd=s'               => \$passwd,
	   'root|r=s'               => \$remoteroot,
	   'dist|d=s'               => \@rdists,
	   'section|s=s'            => \@sections,
	   'arch|a=s'               => \@arches,
	   'adddir=s'               => \@extra_dirs,
	   'di-dist=s'              => \@di_dists,
	   'di-arch=s'              => \@di_arches,
	   'rsync-extra=s'          => \@rsync_extra,
	   'cleanup'                => \$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,
	   'skippackages'           => \$skippackages,
	   '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_release,
	   'ignore-release-gpg'     => \$ignore_release_gpg,
	   'dry-run'                => \$dry_run_var,
	   'proxy=s'                => \$proxy,
	   'rsync-options=s'        => \$rsync_options,
	   'ignore-small-errors'    => \$ignore_small_errors,
	   'pdiff=s'                => \$pdiff_mode,
	   'omit-suite-symlinks'    => \$omit_suite_symlinks,
	   'allow-dist-rename'      => \$allow_dist_rename,
	   'help'                   => \$help,
) or usage;
usage if $help;

# This parameter is so important that it is the only required parameter.
my $mirrordir=shift or usage("mirrordir not specified");

# Check for patch binary if needed
if (!($pdiff_mode eq "none")) {
  if (system("patch --version 2>/dev/null >/dev/null")) {
    say("Patch binary missing, falling back to --pdiff=none");
    push (@errlog,"Patch binary missing, falling back to --pdiff=none\n");
    $pdiff_mode = "none";
  }
  if (system("ed --version 2>/dev/null >/dev/null")) {
    say("Ed binary missing, falling back to --pdiff=none");
    push (@errlog,"Ed binary missing, falling back to --pdiff=none\n");
    $pdiff_mode = "none";
  }
}

# Backwards compatibility: remote root dir no longer needs prefix
$remoteroot =~ s%^[:/]%%;

# Post-process arrays. Allow commas to separate values the user entered.
# If the user entered nothing, provide defaults.
@rdists=split(/,/,join(',',@rdists));
@rdists=qw(sid) unless @rdists;
@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));
@rsync_extra=split(/,/,join(',',@rsync_extra));
if (@di_dists) {
  @di_dists = @rdists if ($di_dists[0] eq "dists");
  @di_arches = @arches if (!@di_arches || $di_arches[0] eq "arches");
} elsif (@di_arches) {
  @di_dists = @rdists if (!@di_dists);
  @di_arches = @arches if ($di_arches[0] eq "arches");
}
$cleanup=0 if ($no_cleanup);
$post_cleanup=0 if ($no_cleanup);
$post_cleanup=0 if ($cleanup);

# Display configuration.
$|=1 if $debug;
if ($passwd eq "anonymous@") {
  if ($download_method eq "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(",", @rdists));
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: $pdiff_mode");
say("Checking md5sums.") if $check_md5sums;
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 ($download_method eq "rsync");
if ($post_cleanup) {
  say("Will clean up AFTER mirroring.");
} else {
  say("Will NOT clean up.") unless $cleanup;
}
say("Dry run.") if $dry_run_var;

my $md5;
$md5=Digest::MD5->new;

# Set up mirror directory and resolve $mirrordir to a full path for
# locking and rsync
make_dir($mirrordir) if (! -d $mirrordir);
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, this might take 2 minutes before it fails.");
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;

# Start up ftp.
my $ftp;
my %opts = (Debug => $debug, Passive => $passive, Timeout => $timeout);

my $rsynctempfile;
END { unlink $rsynctempfile if $rsynctempfile }

sub init_connection {
  $_ = $download_method;

  /^hftp$/  && do {
    # LWP stuff
    $ua = new LWP::UserAgent;
    if ($proxy) {
      $ua->proxy('ftp', $proxy);
    } elsif ($ENV{ftp_proxy}) {
      $ua->proxy('ftp', $ENV{ftp_proxy});
    } else {
      die("hftp method needs a proxy.");
    }
    return;
  };

  /^http$/ && do {
    # LWP stuff[
    $ua = new LWP::UserAgent;
    $ua->proxy('http', $ENV{http_proxy}) if ($ENV{http_proxy});
    $ua->proxy('http', $proxy) if ($proxy);
    return;
  };

  /^ftp$/ && do {
    $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;
  };

  /^rsync$/ && do {
    return;
  };

  usage("unknown download method: $_");
}
init_connection;

# determine remote root for rsync transfers
my $rsyncremote = "$host\:\:$remoteroot/";
if (! ($user eq 'anonymous')) {
  $rsyncremote = "$user\@$rsyncremote";
}

# Update the remote trace files; also update ignores for @rsync_extra.
rsync_extra(1, @rsync_extra);

say("Get Release files.");
# Get Release files without caching for http
$ua->default_header( "Cache-Control" => "max-age=0" ) if ($ua);
my (%file_lists_md5, %file_lists_size);
foreach my $dist (@rdists) {
  my $tdir="$tempdir/.tmp/dists/$dist";
  next unless get_release($tdir, $dist);
  my ($codename, $suite, $dist_sdir) = name_release("mirror", $tdir, $dist);

  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";
  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"}=1;
  $files{$tempdir."/"."dists/$codename$dist_sdir/Release"}=1;
  $files{"dists/$codename$dist_sdir/Release.gpg"}=1;
  $files{$tempdir."/"."dists/$codename$dist_sdir/Release.gpg"}=1;
}

# Check that @di_dists contains valid codenames
di_check_dists() if @di_dists;

foreach my $dist (keys %dists) {
  next unless exists $dists{$dist}{mirror};
  # Parse the Release
  if (open RELEASE, "<$tempdir/dists/$dist/Release") {
    while (<RELEASE>) {
	last if /^MD5Sum:/;
    }
    $_ = <RELEASE>;
    while (defined $_ && $_ =~ /^ /) {
      my ($md5sum, $size, $filename) =
	(/ ([a-z0-9]+) +(\d+) +(.*)$/);
      $file_lists_md5{"$tempdir/dists/$dist/$filename"} = $md5sum;
      $file_lists_size{"$tempdir/dists/$dist/$filename"} = $size;
      $_ = <RELEASE>;
    }
    close RELEASE;
  }
}

if ($num_errors != 0 && $ignore_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 or Release.gpg 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 pdiffs), 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_size{"$tempdir/$name"} if (exists $file_lists_size{"$tempdir/$name"});
}
foreach my $dist (keys %dists) {
  next unless exists $dists{$dist}{mirror};
  foreach my $section (@sections) {
    foreach my $arch (@arches) {
      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.bz2");
      add_bytes("dists/$dist/$section/binary-$arch/Release");
      add_bytes("dists/$dist/$section/binary-$arch/Packages.diff/Index") unless ($pdiff_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.bz2");
      add_bytes("dists/$dist/$section/source/Release");
      add_bytes("dists/$dist/$section/source/Sources.diff/Index") unless ($pdiff_mode eq "none");
    }
  }
}
foreach (@extra_dirs) {
  add_bytes("$_/Packages");
  add_bytes("$_/Packages.gz");
  add_bytes("$_/Packages.bz2");
  add_bytes("$_/Release");
  add_bytes("$_/Packages.diff/Index");
  if ($do_source) {
    add_bytes("$_/Sources");
    add_bytes("$_/Sources.gz");
    add_bytes("$_/Sources.bz2");
    add_bytes("$_/Sources.diff/Index");
  }
}

# Get and parse MD5SUMS files for D-I images.
di_add_files() if @di_dists;

say("Get Packages and Sources files and other miscellany.");
# Get Packages and Sources files and other miscellany.
my (@package_files, @source_files);
foreach my $dist (keys %dists) {
  next unless exists $dists{$dist}{mirror};
  foreach my $section (@sections) {
    # no d-i in woody
    next if ($section =~ /debian-installer/ && $dist eq "woody");
    next if ($section =~ /debian-installer/ && $dist eq "experimental");
    next if ($section =~ /debian-installer/ && $dist =~ /.*-proposed-updates/);
    next if ($section =~ /debian-installer/ && $dist =~ /.*breezy-updates/ );
    next if ($section =~ /debian-installer/ && $dist eq "breezy-security" );
    foreach my $arch (@arches) {
      get_index("dists/$dist/$section/binary-$arch", "Packages");
    }
    # d-i does not have separate source sections
    if ($do_source && $section !~ /debian-installer/) {
      get_index("dists/$dist/$section/source", "Sources");
    }
  }
}
foreach (@extra_dirs) {
  get_packages($_, "Packages");
  get_sources($_, "Sources") if ($do_source);
}

# 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";
}

# Really set dry-run option now if it was given. This delay is needed
# for the ftp method.
$dry_run = $dry_run_var;

if ($getcontents) {
  say("Get Contents files.");
  foreach my $dist (keys %dists) {
    next unless exists $dists{$dist}{mirror};
    foreach my $arch (@arches) {
      next if $dist=~/experimental/;
      next if $dist=~/.*-proposed-updates/;
      next if $arch=~/source/;
      if (!check_lists ("$tempdir/dists/$dist/Contents-$arch.gz")) {
	add_bytes("dists/$dist/Contents-$arch.gz");
      }
    }
  }
  foreach my $dist (keys %dists) {
    next unless exists $dists{$dist}{mirror};
    foreach my $arch (@arches) {
      next if $dist=~/experimental/;
      next if $dist=~/.*-proposed-updates/;
      next if $arch=~/source/;
      if (!check_lists ("$tempdir/dists/$dist/Contents-$arch.gz")) {
	remote_get("dists/$dist/Contents-$arch.gz");
      }
      $files{"dists/$dist/Contents-$arch.gz"}=1;
      $files{$tempdir."/"."dists/$dist/Contents-$arch.gz"}=1;
    }
  }
}

# close ftp connection to avoid timeouts, will reopen later
if ($download_method eq 'ftp') { $ftp->quit; }

say("Parse Packages and Sources files and add to the file list everything therein.");
{
  local $/="\n\n"; # Set input separator to read entire package

  my ($filename, $size, $md5sum, $directory, $exclude, $include,
      $architecture, $exclude_deb_section, $limit_priority, $deb_section,
      $deb_priority);
  my $empty_mirror = 1;

  my %arches = map { $_ => 1 } (@arches, "all");

  $exclude = "(".join("|", @excludes).")" if @excludes;
  $exclude_deb_section =
    "(".join("|", @excludes_deb_section).")" if @excludes_deb_section;
  $limit_priority =
    "(".join("|", @limit_priority).")" if @limit_priority;
  $include = "(".join("|", @includes).")" if @includes;
  foreach my $file (@package_files) {
    next if (!-f $file);
    open(FILE, "<", $file) or die "$file: $!";
    for (;;) {
      my $buf;
      unless (defined( $buf = <FILE> )) {
	last if eof;
	die "$file: $!" if $!;
      }
      $_ = $buf;
      ($filename)=m/^Filename:\s+(.*)/im;
      $filename=~s:/+:/:;	# remove redundant slashes in paths
      ($deb_section)=m/^Section:\s+(.*)/im;
      ($deb_priority)=m/^Priority:\s+(.*)/im;
      ($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));
      }
      # 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;
	}
      }
      ($size)=m/^Size:\s+(\d+)/im;
      ($md5sum)=m/^MD5sum:\s+([A-Za-z0-9]+)/im;
      if (check_file($filename, $size, $md5sum)) {
	$files{$filename} = 1;
      } else {
	$files{$filename} = 0;
	$file_lists_md5{$filename} = $md5sum;
	$file_lists_size{$filename} = $size;
	$bytes_to_get += $size;
      }
      $empty_mirror = 0;
    }
    close(FILE);
  }
  foreach my $file (@source_files) {
    next if (!-f $file);
    open(FILE, "<", $file) or die "$file: $!";
    for (;;) {
      my $buf = "";
      unless (defined( $buf = <FILE> )) {
	last if eof;
	die "$file: $!" if $!;
      }
      $_ = $buf;
      ($directory) = m/^Directory:\s+(.*)/im;
      ($deb_section)=m/^Section:\s+(.*)/im;
      ($deb_priority)=m/^Priority:\s+(.*)/im;
      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));
      while (m/^ ([A-Za-z0-9]{32} .*)/mg) {
	($md5sum, $size, $filename)=split(' ', $1, 3);
	$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, $size, $md5sum)) {
	  $files{$filename} = 1;
	} else {
	  $files{$filename} = 0;
	  $file_lists_md5{$filename} = $md5sum;
	  $file_lists_size{$filename} = $size;
	  $bytes_to_get += $size;
	}
      }
      $empty_mirror = 0;
    }
    close(FILE);
  }

  # Sanity check to avoid completely nuking a mirror.
  if ($empty_mirror) {
    print "Errors:\n ".join(" ",@errlog) if (@errlog);
    die "No packages after parsing Packages and Sources files!\n";
  }
}

# Pre-mirror cleanup
cleanup_unknown_files() if ($cleanup && ! $post_cleanup);

say("Download all files that we need to get (".print_dl_size($bytes_to_get - $bytes_meta).").");
# Download all files that we need to get.
DOWNLOAD: {
  init_connection;
  $_ = $download_method;

  # hftp (ftp using http mirror) method
  /^hftp$/ && do {
    # LWP stuff
    my $dirname;
    my $i=0;
    foreach my $file (sort keys %files) {
      if (!$files{$file}) {
	if (($dirname) = $file =~ m:(.*)/:) {
	  make_dir($dirname);
	}
	hftp_get($file);
	if ($max_batch > 0 && ++$i >= $max_batch) {
	  push (@errlog,"Batch limit exceeded, mirror run was partial\n");
	  $num_errors++;
	  last;
	}
      }
    }
    last DOWNLOAD;
  };

  # http method
  /^http$/ && do {
    # LWP stuff
    my $dirname;
    my $i=0;
    foreach my $file (sort keys %files) {
      if (!$files{$file}) {
	if (($dirname) = $file =~ m:(.*)/:) {
	  make_dir($dirname);
	}
	http_get($file);
	if ($max_batch > 0 && ++$i >= $max_batch) {
	  push (@errlog,"Batch limit exceeded, mirror run was partial\n");
	  $num_errors++;
	  last;
	}
      }
    }
    last DOWNLOAD;
  };

  # ftp method
  /^ftp$/ && do {
    my $dirname;
    my $i=0;
    foreach my $file (sort keys %files) {
      if (!$files{$file}) {
	if (($dirname) = $file =~ m:(.*)/:) {
	  make_dir($dirname);
	}
	ftp_get($file);
	if ($max_batch > 0 && ++$i >= $max_batch) {
	  push (@errlog,"Batch limit exceeded, mirror run was partial\n");
	  $num_errors++;
	  last;
	}
      }
    }
    last DOWNLOAD;
  };

  # rsync method
  /^rsync$/ && do {
    my $opt=$rsync_options;
    my $fh;
    my @result;
    my $i=0;
    my $j=0;
    $opt = "$opt --progress" if $progress;
    $opt = "$opt -v" if $verbose;
    $opt = "$opt -v" if $debug;
    $opt = "$opt -n" if $dry_run;
    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";
	    }
	  }
	  system ("rsync --timeout=$timeout $opt $rsyncremote --include-from=$rsynctempfile --exclude='*' $mirrordir");
	  close $fh;
	  unlink $rsynctempfile;
	  foreach my $dest (@result) {
	    if (-f $dest) {
	      if (!check_lists($dest)) {
		say("$dest failed md5sum check");
		$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 md5sum check");
	    $num_errors++;
	  }
	} elsif (!-d $dest) {
	  say("$dest missing");
	  $num_errors++;
	}
      }
    }
    last DOWNLOAD;
  };
}

if (! @di_dists) {
  download_finished();
}

say("Everything OK. Moving meta files.");
chdir($tempdir) or die "unable to chdir($tempdir): $!\n";
my $res=0;
foreach my $file (`find . -type f`) {
  chomp $file;
  $file=~s:^\./::;
  # this skips pdiff files if unwanted
  next if (!exists $files{$file});
  print("Moving $file\n") if ($debug);
  if (! $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 && ! $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 $dists{$cur}{suite} &&
	  ($file eq $dists{$cur}{suite} || $file eq "stable-$dists{$cur}{suite}")) {
	$suites{$file} = "ok";
      } else {
	unlink("dists/$file") or die "Failed to remove symlink dists/$file: $!";
      }
    }
  }
  closedir (DIR);

  foreach my $dist (keys %dists) {
    next if (! exists $dists{$dist}{suite});
    next if (!-d "dists/$dist");
    my $suite = $dists{$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 (! $dry_run) {
  make_dir("project/trace");
  open OUT, ">$tracefile" or die "$tracefile: $!";
  print OUT `date -u`;
  close OUT;
}

# Post mirror cleanup
cleanup_unknown_files() if ($post_cleanup);

# mirror cleanup for directories
if (! $use_cache && ($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 (! $dry_run);
}

if ($res != 0) {
  die("Failed to move some meta files.");
}

# Save the state cache.
save_state_cache() if $state_cache_days && !$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;
  }
}

# Pass this function a filename, a file size (bytes), and a md5sum (hex).
# Size is always checked; checking the md5sum is optional. However, if
# a value of -1 is passed for size, a check of the md5sum is forced.
# It will return true if the tests show the file matches.
sub check_file {
  my ($filename, $size, $md5sum)=@_;
  if (-f $filename and ($size == -s _ || $size == -1)) {
    if ($check_md5sums || $size == -1) {
      open HANDLE, $filename or
	die "$filename: $!";
      $md5->addfile(*HANDLE);
      my $digest = $md5->hexdigest;
      return ($md5sum eq $digest);
    }
    else {
      # Assume it is ok, w/o md5 check.
      return 1;
    }
  }
  return 0;
}

# Check uncompressed pdiff content against sha1sum from Index file.
sub check_pdiff {
  my ($filename, $size, $sha1) = @_;
  my $digest = Digest::SHA1->new;
  my $ret = 0;

  if (-f "$filename.gz") {
    system_redirect_io("gzip -d", "$filename.gz", "$filename");
    if ($size == -s $filename) {
      open HANDLE, $filename or die "$filename: $!";
      $digest->addfile(*HANDLE);
      $ret = ($sha1 eq $digest->hexdigest);
    }
    unlink ($filename);
  }
  return $ret;
}

# Check file against md5sum and size from the Release file.
# It will return true if the md5sum matches.
sub check_lists {
  my $file = shift;
  my $t = $check_md5sums;
  my $ret = 1;
  $check_md5sums = 1;
  if (exists $file_lists_size{$file}) {
    $ret = check_file ($file, $file_lists_size{$file},
		       $file_lists_md5{$file});
  }
  $check_md5sums = $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";

  METHOD: {
    $_ = $download_method;

    /^hftp$/ && do {
      $res=hftp_get($file);
      $res=$res && check_lists($file);
      if (!$res) {
	say("$file failed md5sum check, removing");
	unlink($file) if (-f $file);
      }
    };

    /^http$/ && do {
      $res=http_get($file);
      $res=$res && check_lists($file);
      if (!$res) {
	say("$file failed md5sum check, removing");
	unlink($file) if (-f $file);
      }
    };

    /^ftp$/ && do {
      $res=ftp_get($file);
      $res=$res && check_lists($file);
      if (!$res) {
	say("$file failed md5sum check, removing");
	unlink($file) if (-f $file);
      }
    };

    /^rsync$/ && do {
      $res=rsync_get($file);
      $res=$res && check_lists($file);
      if (!$res) {
	say("$file failed md5sum check");
	# FIXME: make sure the size doesn't match so it gets retried
      }
    };
  }

  chdir($mirrordir) or die "unable to chdir($mirrordir): $!\n";
  return $res;
}

# Get a file via hftp, first displaying its filename if progress is on.
sub hftp_get {
  my $oldautoflush = $|;
  $| = 1;
  my $file=shift;
  my $url="ftp://${host}/${remoteroot}/${file}";
  my $ret=1;

  print "$url => " if ($debug);
  if ($progress || $verbose) {
    print "Getting: $file... ";
  }
  if (! $dry_run) {
    unlink($file) if (-f $file);
    $ret = $ua->mirror($url, $file);
    print $ret->status_line . "\n" if ($debug);
    if ($ret->is_error) {
      $files{$file} = -1;
      warn "$file failed " . $ret->status_line . "\n" if ($progress or $verbose);
      push (@errlog,"Download of $file failed: ".$ret->status_line."\n");
      $num_errors++;
    } elsif ($progress || $verbose) {
      print "ok\n";
    }
    $ret = not ( $ret->is_error );
  } elsif ($progress || $verbose) {
    print "ok\n";
  }
  $| = $oldautoflush;
  return $ret;
}

# Get a file via http, first displaying its filename if progress is on.
sub http_get {
  my $oldautoflush = $|;
  $| = 1;
  my $file=shift;
  my $percent = 0;
  my $url="http://${host}/${remoteroot}/${file}";
  my $ret=1;
  $percent = sprintf("%3.0f",(($bytes_gotten/$bytes_to_get)*100)) unless($bytes_to_get == 0);

  print "$url => " if ($debug);
  if ($progress || $verbose) {
    print "[$percent%] Getting: $file... ";
  }
  if (! $dry_run) {
    unlink($file) if (-f $file);
    $ret = $ua->mirror($url, $file);
    print $ret->status_line . "\n" if ($debug);
    if ($ret->is_error) {
      $files{$file} = -1;
      warn "$file failed " . $ret->status_line . "\n" if ($progress or $verbose);
      push (@errlog,"Download of $file failed: ".$ret->status_line."\n");
      $num_errors++;
    } elsif ($progress || $verbose) {
      print "ok\n";
    }
    $ret = not ( $ret->is_error );
  } 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.
# I should just be able to subclass Net::Ftp and override the get method,
# but it's late.
sub ftp_get {
  my $oldautoflush = $|;
  $| = 1;
  my $file=shift;
  my $percent = 0;
  my $mtime;
  $percent = sprintf("%3.0f",(($bytes_gotten/$bytes_to_get)*100)) unless($bytes_to_get == 0);

  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 || $verbose);
      add_bytes_gotten($size);
      return 1;
    }
  }
  if ($progress) {
    print "[$percent%] Getting: $file\t #";
  } elsif ($verbose) {
    print "[$percent%] Getting: $file";
  }
  my $ret=1;
  if (! $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 ($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 = "$opt --progress" if $progress;
  $opt = "$opt -v" if $debug;
  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;

  # @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 = "$opt --progress" if $progress;
  $opt = "$opt -v" if $verbose;
  $opt = "$opt -v" if $debug;
  $opt = "$opt -n" if $dry_run;

  ($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";
  }
  system ("rsync --timeout=$timeout $opt $rsyncremote --delete --include-from=$rsynctempfile --exclude='*' $mirrordir");
  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: $!";
  }
  system("$command <$fromfile >$tofile");
}

sub split_dist {
  my $dist = shift;
  my ($dist_raw) = ($dist =~ m:^([^/]+)/?:);
  $dist =~ m:^[^/]+(/.*)?$:;
  my $dist_sdir = $1 // "";
  return ($dist_raw, $dist_sdir);
}

sub get_release {
  my ($tdir, $dist) = @_;

  make_dir ("$tdir");
  return 0 unless remote_get("dists/$dist/Release", "$tempdir/.tmp");
  my $t = $num_errors;
  return 0 unless remote_get("dists/$dist/Release.gpg", "$tempdir/.tmp");
  # Check for gpg
  if (!$ignore_release_gpg) {
    if (system("gpgv --version >/dev/null 2>/dev/null")) {
      say("gpgv failed: --ignore-release-gpg or gpgv binary missing?");
      push (@errlog,"gpgv failed: --ignore-release-gpg or gpgv binary missing?\n");
      $num_errors++;
    }
    # Verify Release signature
    if (-f "$tdir/Release.gpg" || -f "$tdir/Release") {
      my $gpgv_res="failed";
      open GPGV, "gpgv 2>/dev/null --status-fd 1 $tdir/Release.gpg $tdir/Release|";
      while (<GPGV>) {
	$gpgv_res="valid" if /^\[GNUPG:\] VALIDSIG/;
      }
      close GPGV;
      if ($gpgv_res eq "failed" || $debug) {
	system("gpgv --status-fd 1 $tdir/Release.gpg $tdir/Release");
      }
      if ($verbose && !$debug) {
	system("gpgv --status-fd 1 $tdir/Release.gpg $tdir/Release >/dev/null");
      }
      if ($gpgv_res eq "failed") {
	say("Release signature does not verify.");
	push (@errlog,"Release signature does not verify\n");
	$num_errors++;
      }
    } else {
      say("Release signature does not verify, file missing.");
      push (@errlog,"Release signature does not verify\n");
      $num_errors++;
    }
  }
  $num_errors=$t if ($ignore_release_gpg);
  return 1
}

sub name_release {
  my ($type, $tdir, $dist) = @_;
  my ($buf, $origin, $codename, $suite);

  if (open RELEASE, "<$tdir/Release") {
    while (<RELEASE>) {
      last if /^MD5Sum:/;
      $buf = $buf . $_;
    }
    close RELEASE;
  }
  $_ = $buf;
  ($origin) = m/^Origin:\s+(.*)/im;
  ($codename) = m/^Codename:\s+(.*)/im;
  ($suite) = m/^Suite:\s+(.*)/im;

  # Allow for 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 "Ubuntu") {
    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 $dists{"$codename$dist_sdir"}{$type};
  $dists{"$codename$dist_sdir"}{$type} = 1;
  die("Conflicting suites '$suite' and '$dists{$codename}{suite}' for $codename.\n")
    if (exists $dists{"$codename"}{suite} && ($suite ne $dists{$codename}{suite}));
  $dists{$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 (!($pdiff_mode eq "none") && exists $file_lists_size{"$tempdir/$subdir/$file.diff/Index"}) {
    if (!check_lists ("$tempdir/$subdir/$file.diff/Index")) {
      make_dir("$tempdir/$subdir/$file.diff");
      say("$subdir/$file.diff/Index needs fetch");
      if (!remote_get("$subdir/$file.diff/Index")) {
	push (@errlog,"$subdir/$file.diff/Index failed md5sum check, removing\n");
      } else {
	fetch_and_apply_pdiffs($subdir, $file);
	if (check_lists ("$tempdir/$subdir/$file")) {
	  system_redirect_io("gzip -9 -n", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.gz");
	  system_redirect_io("bzip2", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.bz2");
	}
      }
    } else {
      $bytes_gotten += $file_lists_size{"$tempdir/$subdir/$file.diff/Index"};
      fetch_and_apply_pdiffs($subdir, "$file");
      if (check_lists ("$tempdir/$subdir/$file")) {
	system_redirect_io("gzip -9 -n", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.gz");
	system_redirect_io("bzip2", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.bz2");
      }
    }
    $files{"$subdir/$file.diff/Index"}=1 if ($pdiff_mode eq "mirror");
    $files{"$tempdir/$subdir/$file.diff/Index"}=1;
  }

  if (exists $file_lists_size{"$tempdir/$subdir/$file.gz"}) {
    if (!check_lists ("$tempdir/$subdir/$file.gz")) {
      say("$subdir/$file.gz needs fetch");
      if (remote_get("$subdir/$file.gz")) {
	system_redirect_io("gzip -d", "$tempdir/$subdir/$file.gz", "$tempdir/$subdir/$file");
	system_redirect_io("bzip2", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.bz2");
      } else {
	push (@errlog,"$subdir/$file.gz failed md5sum check\n");
	$num_errors++;
      }
    } else {
      $bytes_gotten += $file_lists_size{"$tempdir/$subdir/$file.gz"};
    }
  } elsif ($ignore_release) {
    say("Ignoring missing Release file for $subdir/$file.gz");
    push (@errlog,"Ignoring missing Release file for $subdir/$file.gz\n");
    say("$subdir/$file.gz needs fetch");
    remote_get("$subdir/$file.gz");
  } else {
    if (-f "$subdir/$file.gz") {
      say("$subdir/$file.gz exists locally but not in Release");
      die "Won't mirror without $subdir/$file.gz signature in Release";
    } else {
      say("$subdir/$file.gz does not exist locally or in Release, skipping.") if ($debug);
    }
  }
  if (exists $file_lists_size{"$tempdir/$subdir/$file"}) {
    if (!check_lists ("$tempdir/$subdir/$file")) {
      say("$subdir/$file needs fetch");
      if (remote_get("$subdir/$file")) {
	system_redirect_io("bzip2", "$tempdir/$subdir/$file", "$tempdir/$subdir/$file.bz2");
      } else {
	push (@errlog,"$subdir/$file failed md5sum check\n");
	$num_errors++;
      }
    } else {
      $bytes_gotten += $file_lists_size{"$tempdir/$subdir/$file"};
    }
  }
  if (exists $file_lists_size{"$tempdir/$subdir/$file.bz2"}) {
    if (!check_lists ("$tempdir/$subdir/$file.bz2")) {
      say("$subdir/$file.bz2 needs fetch");
      if (!remote_get("$subdir/$file.bz2")) {
	push (@errlog,"$subdir/$file.bz2 failed md5sum check, removing\n");
      }
    } else {
      $bytes_gotten += $file_lists_size{"$tempdir/$subdir/$file.bz2"};
    }
  }
  if (exists $file_lists_size{"$tempdir/$subdir/Release"}) {
    if (!check_lists ("$tempdir/$subdir/Release")) {
      say("$subdir/Release needs fetch");
      if (!remote_get("$subdir/Release")) {
	push (@errlog,"$subdir/Release failed md5sum check, removing\n");
      }
    } else {
      $bytes_gotten += $file_lists_size{"$tempdir/$subdir/Release"};
    }
  }
  if ($file eq "Packages") {
    push @package_files, "$tempdir/$subdir/$file";
  } else {
    if ($file eq "Sources") {
      push @source_files, "$tempdir/$subdir/$file";
    } else {
      die "get_index called with unknown type $file\n";
    }
  }
  $files{"$subdir/$file.gz"}=1;
  $files{"$subdir/$file.bz2"}=1;
  # Uncompressed files are no longer kept on the mirrors
  $files{"$subdir/$file"}=1 unless (exists $file_lists_size{"$tempdir/$subdir/$file.gz"});
  $files{"$subdir/Release"}=1;
  $files{"$tempdir/$subdir/$file.gz"}=1;
  $files{"$tempdir/$subdir/$file.bz2"}=1;
  $files{"$tempdir/$subdir/$file"}=1;
  $files{"$tempdir/$subdir/Release"}=1;
}

sub fetch_and_apply_pdiffs {
  my ($subdir, $list) = @_;
  local (*INDEX, *LIST);
  my (%history_sha1, %history_size, %pdiff_sha1, %pdiff_size);
  my ($current_sha1, $current_size, $sha1, $size, $file, $digest, $ret);
  my $t = $num_errors;

  # Parse DiffIndex file
  open(INDEX, "$tempdir/$subdir/$list.diff/Index") or die "$tempdir/$subdir/$list.diff/Index: $!";
  $_ = <INDEX>;
  while (defined($_)) {
    if (m/^SHA1-Current:/m) {
      ($current_sha1, $current_size) = m/^SHA1-Current:\s+([A-Za-z0-9]+)\s+(\d+)/m;
      $_ = <INDEX>;
    }
    elsif (m/^SHA1-History:/m) {
      while (defined($_ = <INDEX>)) {
	last if (!m/^\s/m);
	($sha1, $size, $file) = m/^\s+([A-Za-z0-9]+)\s+(\d+)\s+(.*)/m;
	$history_sha1{$file} = $sha1;
	$history_size{$file} = $size;
      }
    }
    elsif (m/^SHA1-Patches:/m) {
      while (defined($_ = <INDEX>)) {
	last if (!m/^\s/m);
	($sha1, $size, $file) = m/^\s+([A-Za-z0-9]+)\s+(\d+)\s+(.*)/m;
	$pdiff_sha1{$file} = $sha1;
	$pdiff_size{$file} = $size;
      }
    }
  }
  close(INDEX);

  # Download pdiff files as necessary
  $ret = 1;
  foreach $file (sort keys %pdiff_sha1) {
    if (!check_pdiff("$tempdir/$subdir/$list.diff/$file", $pdiff_size{$file}, $pdiff_sha1{$file})) {
      say("$subdir/$list.diff/$file.gz needs fetch");
      remote_get("$subdir/$list.diff/$file.gz");
#FIXME: before download
      if (-f "$tempdir/$subdir/$list.diff/$file.gz") {
	$bytes_to_get += -s "$tempdir/$subdir/$list.diff/$file.gz";
      }
      if (!check_pdiff("$tempdir/$subdir/$list.diff/$file", $pdiff_size{$file}, $pdiff_sha1{$file})) {
	say("$subdir/$list.diff/$file.gz failed sha1sum check, removing");
	push (@errlog,"$subdir/$list.diff/$file.gz failed sha1sum check, removing\n");
	unlink "$tempdir/$subdir/$list.diff/$file.gz";
	$ret = 0;
      }
    } else {
#FIXME: before download
      $bytes_to_get += -s "$tempdir/$subdir/$list.diff/$file.gz";
      $bytes_gotten += -s "$tempdir/$subdir/$list.diff/$file.gz";
    }
    $files{"$subdir/$list.diff/$file.gz"}=1 if ($pdiff_mode eq "mirror");
    $files{"$tempdir/$subdir/$list.diff/$file.gz"}=1;
  }
  $num_errors = $t if ($ignore_small_errors);
  return unless ($ret);

  # Apply pdiff files
  open(LIST, "$tempdir/$subdir/$list") or return;
  $digest = Digest::SHA1->new;
  $digest->addfile(*LIST);
  $sha1 = $digest->hexdigest;
  $size = -s "$tempdir/$subdir/$list";
  foreach $file (sort keys %history_sha1) {
    next unless ($sha1 eq $history_sha1{$file} && $size eq $history_size{$file});
    if (system("gzip -d < \"$tempdir/$subdir/$list.diff/$file.gz\" | patch --ed \"$tempdir/$subdir/$list\"")) {
      say("Patch $file failed, will fetch $subdir/$list file");
      unlink "$tempdir/$subdir/$list";
      return;
    }
    open(LIST, "$tempdir/$subdir/$list") or return;
    $digest = Digest::SHA1->new;
    $digest->addfile(*LIST);
    $sha1 = $digest->hexdigest;
    $size = -s "$tempdir/$subdir/$list";
    say("$subdir/$list patched with $subdir/$list.diff/$file.gz");
  }
  if (!($sha1 eq $current_sha1 && $size eq $current_size)) {
    say("$subdir/$list failed sha1sum check, removing");
    push (@errlog,"$subdir/$list failed sha1sum check, removing\n");
    unlink "$tempdir/$subdir/$list";
  }
}

# Make a directory including all needed parents.
{
  my %seen;

  sub make_dir {
    my $dir=shift;

    my @parts=split('/', $dir);
    my $current='';
    foreach my $part (@parts) {
      $current.="$part/";
      if (! $seen{$current}) {
	if (! -d $current) {
	  mkdir ($current, 0755) or die "mkdir failed: $!";
	  debug("Created directory: $current");
	}
	$seen{$current}=1;
      }
    }
  }
}

# Mirror cleanup for unknown files that cannot be found in Packages files.
# This subroutine is called on pre- and post-cleanup and takes no arguments.
# It uses some global variables like $files, $mirrordir, @ignores
sub cleanup_unknown_files {
  print("Cleanup mirror") if ($verbose or $progress);
  if ($use_cache) {
    say(": using cache.");
    foreach my $file (sort keys %files) {
      next if (@di_dists && $file =~ m:installer-\w+/current/images/:);
      if ($files{$file} == 2 && -f $file) {
	say("deleting $file") if ($verbose);
	if (! $dry_run) {
	  unlink $file or die "unlink $file: $!";
	}
      }
    }
  } else {
    say($state_cache_days ? ": full." : ".");
    chdir($mirrordir) or die "chdir $mirrordir: $!";
    my $ignore;
    $ignore = "(".join("|", @ignores).")" if @ignores;
    # Remove all files in the mirror that we don't know about
    foreach my $file (`find . -type f`) {
      chomp $file;
      $file=~s:^\./::;
      next if (@di_dists && $file =~ m:installer-\w+/current/images/:);
      unless ((exists $files{$file} && $files{$file} != 2) or
	      (defined($ignore) && $file=~/$ignore/o)) {
	say("deleting $file") if ($verbose);
	if (! $dry_run) {
	  unlink $file or die "unlink $file: $!";
	}
      }
    }
  }
  # Clean up obsolete files of D-I images.
  di_cleanup() if @di_dists;
}

# FIXME: does not work
sub get_http_size {
  my $file = shift;
  my $url = "http://${host}/${remoteroot}/${file}";
  my ($type, $size);
  ($type, $size) = $ua->head($url);
  say("$url -- $size");
  return $size;
}

sub di_check_dists {
  say("Checking validity of D-I dists.");
  DI_DIST:
  for my $di_dist (@di_dists) {
    next if exists $dists{$di_dist}; # dist with valid codename
    foreach my $dist (keys %dists) {
      my ($dist_raw, $dist_sdir) = split_dist($dist);
      if ($di_dist eq $dists{$dist_raw}{suite}) {
	$dists{"$dist_raw$dist_sdir"}{"d-i"} = 1; # suite, use codename instead
	next DI_DIST;
      }
    }
    # Only mirroring D-I images, not the archive itself
    my $tdir="$tempdir/.tmp/dists/$di_dist";
    next unless get_release($tdir, $di_dist);
    name_release("d-i", $tdir, $di_dist);
    unlink "$tdir/Release";
    unlink "$tdir/Release.gpg";
  }
}

sub di_add_files {
  my $tdir = "$tempdir/d-i";

  foreach my $dist (keys %dists) {
    next unless exists $dists{$dist}{"d-i"};
    foreach my $arch (@di_arches) {
      next if $arch =~ /kfreebsd-/;

      my $image_dir = "dists/$dist/main/installer-$arch/current/images";
      make_dir ("$tdir/$image_dir");
      if (!remote_get("$image_dir/MD5SUMS", $tdir)) {
	say("Failed to download $image_dir/MD5SUMS; skipping.");
	return;
      }
      if (-f "$tdir/$image_dir/MD5SUMS") {
	$bytes_to_get += -s _; # As we did not have the size earlier
      }

      local $/;
      undef $/; # Read whole file
      open(FILE, "<", "$tdir/$image_dir/MD5SUMS") or die "$tdir/$image_dir/MD5SUMS: $!";
      $_ = <FILE>;
      while (m/^([A-Za-z0-9]{32}  .*)/mg) {
	my ($md5sum, $filename) = split(' ', $1, 3);
	$filename =~ s:^\./::;
	$di_files{$image_dir}{$filename}{md5sum} = $md5sum;
	#$di_files{$image_dir}{$filename}{size} = get_http_size("$image_dir/$filename");

	# Check against the version currently on the mirror
	if (check_file("$image_dir/$filename", -1, $md5sum)) {
	  $di_files{$image_dir}{$filename}{status} = 1;
	} else {
	  $di_files{$image_dir}{$filename}{status} = 0;
	}
      }
      close(FILE);
    }
  }
}

# ToDo: for rsync maybe it would make sense to sync the images directly
# into place, the whole $image_dir at a time.
sub di_get_files {
  say("Getting Debian Installer images.");
  my $tdir = "$tempdir/d-i";

  foreach my $image_dir (sort keys %di_files) {
    my $lres = 1;
    foreach my $file (sort keys %{ $di_files{$image_dir} }) {
      next unless $di_files{$image_dir}{$file}{status} == 0;
      # Fetch images into a temporary location
      $file =~ m:(^.*)/:;
      make_dir ("$tdir/$image_dir/$1") if $1;
      if (!remote_get("$image_dir/$file", $tdir) ||
          !check_file("$tdir/$image_dir/$file", -1, $di_files{$image_dir}{$file}{md5sum})) {
	$lres = 0;
	last if (! $dry_run);
      }
      if (-f "$tdir/$image_dir/$file") {
	$bytes_to_get += -s _; # As we did not have the size in add_di_files()
      }
    }

    # Move images in place on mirror
    if ($lres && ! $dry_run) {
      foreach my $file (sort keys %{ $di_files{$image_dir} }) {
	next unless $di_files{$image_dir}{$file}{status} == 0;
	$file =~ m:(^.*)/:;
	make_dir ("$image_dir/$1") if $1;
	if (-f "$image_dir/$file") {
	  unlink "$image_dir/$file";
	}
	link("$tdir/$image_dir/$file", "$image_dir/$file");
      }
      # Move the MD5SUMS file in place on mirror
      link("$tdir/$image_dir/MD5SUMS", "$image_dir/MD5SUMS");
    } elsif (! $dry_run) {
      say("Failed to download some files in $image_dir; not updating images.");
    }
  }
}

sub di_cleanup {
  # Clean up obsolete files
  foreach my $image_dir (`find dists/ -type d -name images`) {
    next unless $image_dir =~ m:/installer-\w+/current/images$:;
    chomp $image_dir;
    chdir("$image_dir") or die "unable to chdir($image_dir): $!\n";
    foreach my $file (`find . -type f`) {
      chomp $file;
      $file=~s:^\./::;
      if (! exists $di_files{$image_dir} || ! exists $di_files{$image_dir}{$file}) {
	next if (exists $di_files{$image_dir} && $file eq "MD5SUMS");
	say("deleting $image_dir/$file") if ($verbose);
	if (! $dry_run) {
	  unlink "$file" or die "unlink $image_dir/$file: $!\n";
	}
      }
    }
    chdir("$mirrordir") or die "unable to chdir($tempdir): $!\n";
  }
  # Clean up temporary D-I files (silently)
  chdir("$tempdir/d-i") or die "unable to chdir($tempdir/d-i): $!\n";
  foreach my $file (`find . -type f`) {
    chomp $file;
    $file=~s:^\./::;
    unlink "$file" or die "unlink $tempdir/d-i/$file: $!\n";
  }
  chdir("$mirrordir") or die "unable to chdir($mirrordir): $!\n";
}

sub download_finished {
  if ($download_method eq 'ftp') { $ftp->quit; }

  my $total_time = time - $start_time;
  if ($download_method eq 'rsync' || $bytes_gotten == 0) {
    say("Download completed in ".$total_time."s.");
  } else {
    my $avg_speed = 0;
    $avg_speed = sprintf("%3.0f",($bytes_gotten / $total_time)) unless ($total_time == 0);
    say("Downloaded ".print_dl_size($bytes_gotten)." in ".$total_time."s at ".(int($avg_speed/1024*100)/100)." kiB/s.");
  }
}

sub rename_distdir {
  my ($dir, $codename, $suite) = @_;
  say("The directory for a dist should be its codename, not a suite.");
  if (!$allow_dist_rename) {
    die("Use --allow-dist-rename to have debmirror do the conversion automatically.\n");
  }
  say("Starting conversion - renaming '$dir/$suite' to '$dir/$codename':");
  if (-l "$dir/$codename") {
    say("  removing symlink '$dir/$codename'; a new symlink for the suite will be created later");
    unlink "$dir/$codename";
  }
  if (-d "$dir/$codename") {
    die("Directory '$dir/$codename' already exists; aborting conversion.\n");
  }
  rename("$dir/$suite", "$dir/$codename");
  say("  conversion completed successfully");
}

sub save_state_cache {
  my $cache_file = "$tempdir/debmirror_state.cache";
  say("Saving debmirror state cache.");
  foreach my $file (keys %files) {
    if ($files{$file} == 2) {
      delete $files{$file};
    } elsif ($files{$file} >= 0){
      $files{$file} = 2;
    }
  }
  # Add state cache meta data
  my $now = time();
  $files{cache_version} = $files_cache_version;
  if (! $state_cache_exptime) {
    $state_cache_exptime = $now + $state_cache_days * 24 * 60 * 60;
  }
  $files{cache_expiration_time} = $state_cache_exptime;
  if (! nstore(\%files, $cache_file)) {
    say("Failed to save state cache.");
    unlink $cache_file if -f $cache_file;
  } else {
    my $expires = int(($state_cache_exptime - $now) / (60 * 60)); # hours
    if ($expires > 0) {
      my $days = int($expires / 24);
      my $hours = $expires % 24;
      say("State cache will expire in " .
	  ($days ? "$days day(s)" : ($hours ? "" : "the next hour")) .
	  ($hours ? ($days ? " and " : "") . "$hours hour(s)" : "") . ".");
    } else {
      say("State cache expired during this run; next run will not use cache.");
    }
  }
}

sub load_state_cache {
  my $cache_file = "$tempdir/debmirror_state.cache";
  if (! -f $cache_file) {
    say("State cache file does not exist; doing full mirroring.");
    return;
  }

  my $rfiles;
  say("Loading debmirror state cache.");
  $rfiles = retrieve($cache_file);
  if (! defined $rfiles) {
    say("Failed to load state cache; doing full mirror check.");
    return
  }
  if (! exists $$rfiles{cache_version}) {
    say("Cache version missing in state cache; doing full mirroring.");
    return
  } elsif ($$rfiles{cache_version} ne $files_cache_version) {
    say("State cache is incompatible with this version of debmirror; doing full mirror check.");
    return
  } else {
    delete $$rfiles{cache_version};
  }
  if (! exists $$rfiles{cache_expiration_time}) {
    say("Expiration time missing in state cache; doing full mirror check.");
    return
  } elsif ($$rfiles{cache_expiration_time} < time()) {
    say("State cache has expired; doing full mirror check.");
    return
  } else {
    $state_cache_exptime = $$rfiles{cache_expiration_time};
    delete $$rfiles{cache_expiration_time};
  }

  say("State cache loaded successfully; will use cache.");
  %files = %$rfiles;
  $use_cache = 1;
  # Preserve state cache during dry runs
  if ($dry_run_var) {
    $files{$cache_file} = 1 if $dry_run_var;
  } else {
    unlink $cache_file if -f $cache_file;
  }
}

sub say {
  print join(' ', @_)."\n" if ($verbose or $progress);
}

sub debug {
  print $0.': '.join(' ', @_)."\n" if $debug;
}

=head1 COPYRIGHT

This program is copyright 2001 by Joey Hess <joeyh@debian.org>, under
the terms of the GNU GPL (either version 2 of the licence or, at your
option, any later version), copyright 2001-2002 by Joerg Wendland
<joergland@debian.org>, copyright 2003-2007 by Goswin von Brederlow
<goswin-v-b@web.de> and copyright 2009 by Frans Pop <fjp@debian.org>.

The author disclaims any responsibility for any mangling of your system,
unexpected bandwidth usage bills, meltdown of the Debian mirror network,
etc, that this script may cause. See NO WARRANTY section of GPL.

=head1 AUTHOR

 Current maintainer:
   Frans Pop <fjp@debian.org>

 Previous authors:
   Joey Hess <joeyh@debian.org> (original author)
   Joerg Wendland <joergland@debian.org>
   Goswin von Brederlow <goswin-v-b@web.de>

=head1 MOTTO

Waste bandwith -- put a partial mirror on your laptop today!

=cut
