#!/usr/bin/perl
package Local::AptMirror;

use warnings;
use strict;
use File::Copy;
use File::Compare;
use File::Path qw(make_path);
use File::Basename;
use Fcntl qw(:flock);

# If you add/modify/delete any of these setting, please also update the manual page.
our %config_variables = (
    "defaultarch" => `dpkg --print-architecture 2>/dev/null` || 'i386',
    "nthreads"    => 20,
    "base_path"   => '/var/spool/apt-mirror',
    "mirror_path" => '$base_path/mirror',
    "skel_path"   => '$base_path/skel',
    "var_path"    => '$base_path/var',
    "cleanscript" => '$var_path/clean.sh',
    "_contents"   => 1,
    "_autoclean"  => 0,
    "_tilde"      => 0,
    "limit_rate"  => '100m',
    "run_postmirror"       => 1,
    "auth_no_challenge"    => 0,
    "no_check_certificate" => 0,
    "unlink"               => 0,
    "postmirror_script"    => '$var_path/postmirror.sh',
    "use_proxy"            => 'off',
    "http_proxy"           => '',
    "https_proxy"          => '',
    "proxy_user"           => '',
    "proxy_password"       => ''
);
chomp $config_variables{"defaultarch"};

my @config_binaries = ();
my @config_sources  = ();

my @index_urls;
my @childrens       = ();
my %skipclean       = ();
my %clean_directory = ();

######################################################################################
## Setting up $config_file variable

my $config_file = "/etc/apt/mirror.list";    # Default value

######################################################################################
## Common subroutines

sub round_number
{
    my ( $n ) = @_;
    my $minus = $n < 0 ? '-' : '';
    $n = abs($n);
    $n = int( ( $n + .05 ) * 10 ) / 10;
    $n .= '.0' unless $n =~ /\./;
    $n .= '0' if substr( $n, ( length($n) - 1 ), 1 ) eq '.';
    chop $n if $n =~ /\.\d\d0$/;
    return "$minus$n";
}

sub format_bytes
{
    my ( $bytes ) = @_;
    my $bytes_out = '0';
    my $size_name = 'bytes';
    my $KiB       = 1024;
    my $MiB       = 1024 * 1024;
    my $GiB       = 1024 * 1024 * 1024;

    if ( $bytes >= $KiB )
    {
        $bytes_out = $bytes / $KiB;
        $size_name = 'KiB';
        if ( $bytes >= $MiB )
        {
            $bytes_out = $bytes / $MiB;
            $size_name = 'MiB';
            if ( $bytes >= $GiB )
            {
                $bytes_out = $bytes / $GiB;
                $size_name = 'GiB';
            }
        }
        $bytes_out = round_number($bytes_out);
    }
    else
    {
        $bytes_out = $bytes;
        $size_name = 'bytes';
    }

    return "$bytes_out $size_name";
}

sub get_variable
{
    my ( $var ) = @_;
    my $value = $config_variables{ $var };
    my $count = 16;
    while ( $value =~ s/\$(\w+)/$config_variables{$1}/xg )
    {
        die("apt-mirror: too many substitution while evaluating variable") if ( $count-- ) < 0;
    }
    return $value;
}

sub quoted_path
{
    my ( $path ) = @_;
    $path =~ s/'/'\\''/g;
    return "'" . $path . "'";
}

sub lock_aptmirror
{
    open( LOCK_FILE, '>', get_variable("var_path") . "/apt-mirror.lock" );
    my $lock = flock( LOCK_FILE, LOCK_EX | LOCK_NB );
    if ( !$lock )
    {
        die("apt-mirror is already running, exiting");
    }
}

sub unlock_aptmirror
{
    close(LOCK_FILE);
    unlink( get_variable("var_path") . "/apt-mirror.lock" );
}

sub download_urls
{
    my ( $stage ) = @_;
    my @urls;
    my $i = 0;
    my $pid;
    my $nthreads = get_variable("nthreads");
    my @args     = ();
    local $| = 1;

    @urls = @_;
    $nthreads = @urls if @urls < $nthreads;

    if ( get_variable("auth_no_challenge") == 1 )    { push( @args, "--auth-no-challenge" ); }
    if ( get_variable("no_check_certificate") == 1 ) { push( @args, "--no-check-certificate" ); }
    if ( get_variable("unlink") == 1 )               { push( @args, "--unlink" ); }
    if ( length( get_variable("use_proxy") ) && ( get_variable("use_proxy") eq 'yes' || get_variable("use_proxy") eq 'on' ) )
    {
        if ( length( get_variable("http_proxy") ) || length( get_variable("https_proxy") ) ) { push( @args, "-e use_proxy=yes" ); }
        if ( length( get_variable("http_proxy") ) ) { push( @args, "-e http_proxy=" . get_variable("http_proxy") ); }
        if ( length( get_variable("https_proxy") ) ) { push( @args, "-e https_proxy=" . get_variable("https_proxy") ); }
        if ( length( get_variable("proxy_user") ) ) { push( @args, "-e proxy_user=" . get_variable("proxy_user") ); }
        if ( length( get_variable("proxy_password") ) ) { push( @args, "-e proxy_password=" . get_variable("proxy_password") ); }
    }
    print "Downloading " . scalar(@urls) . " $stage files using $nthreads threads...\n";

    while ( scalar @urls )
    {
        my @part = splice( @urls, 0, int( @urls / $nthreads ) );
        open URLS, ">" . get_variable("var_path") . "/$stage-urls.$i" or die("apt-mirror: can't write to intermediate file ($stage-urls.$i)");
        foreach (@part) { print URLS "$_\n"; }
        close URLS or die("apt-mirror: can't close intermediate file ($stage-urls.$i)");

        $pid = fork();

        die("apt-mirror: can't do fork in download_urls") if !defined($pid);

        if ( $pid == 0 )
        {
            exec 'wget', '--no-host-directories', '--no-cache', '--limit-rate=' . get_variable("limit_rate"), '-t', '5', '-r', '-N', '-l', 'inf', '-o', get_variable("var_path") . "/$stage-log.$i", '-i', get_variable("var_path") . "/$stage-urls.$i", @args;

            # shouldn't reach this unless exec fails
            die("\n\nCould not run wget, please make sure its installed and in your path\n\n");
        }

        push @childrens, $pid;
        $i++;
        $nthreads--;
    }

    print "Begin time: " . localtime() . "\n[" . scalar(@childrens) . "]... ";
    while ( scalar @childrens )
    {
        my $dead = wait();
        @childrens = grep { $_ != $dead } @childrens;
        print "[" . scalar(@childrens) . "]... ";
    }
    print "\nEnd time: " . localtime() . "\n\n";
}

## utils

sub remove_double_slashes
{
    local ($_) = @_;
    while (s[(^|/)\./][$1]g) { }
    while (s[(?<!:)//][/]g) { }
    while (s[(^|(?<!:/)/)[^/]+/\.\./][$1]g) { }
    s/~/\%7E/g if get_variable("_tilde");
    s{^/+}{};
    return $_;
}

sub sanitise_uri
{
    my ( $uri ) = @_;
    $uri =~ s{^\w+://[^/]+/}{};
    $uri = remove_double_slashes($uri);
    return $uri;
}

## Parse config

sub parse_config_line
{
    my $pattern_deb_line = qr/^[\t ]*(?<type>deb-src|deb)(?:-(?<arch>[\w\-]+))?[\t ]+(?:\[(?<options>[^\]]+)\][\t ]+)?(?<uri>[^\s]+)[\t ]+(?<components>.+)$/;
    my $line = $_;
    my %config;
    if ( $line =~ $pattern_deb_line ) {
        $config{'type'} = $+{type};
        $config{'arch'} = $+{arch};
        $config{'options'} = $+{options} ? $+{options} : "";
        $config{'uri'} = $+{uri};
        $config{'components'} = $+{components};
        if ( $config{'options'} =~ /arch=((?<arch>[\w\-]+)[,]*)/g ) {
            $config{'arch'} = $+{arch};
        }
        $config{'components'} = [ split /\s+/, $config{'components'} ];
    } elsif ( $line =~ /set[\t ]+(?<key>[^\s]+)[\t ]+(?<value>"[^"]+"|'[^']+'|[^\s]+)/ ) {
        $config{'type'} = 'set';
        $config{'key'} = $+{key};
        $config{'value'} = $+{value};
        $config{'value'} =~ s/^'(.*)'$/$1/;
        $config{'value'} =~ s/^"(.*)"$/$1/;
    } elsif ( $line =~ /(?<type>clean|skip-clean)[\t ]+(?<uri>[^\s]+)/ ) {
        $config{'type'} = $+{type};
        $config{'uri'} = $+{uri};
    }

    return %config;
}

sub load_config
{
open CONFIG, "<$config_file" or die("apt-mirror: can't open config file ($config_file)");
while (<CONFIG>)
{
    next if /^\s*#/;
    next unless /\S/;
    my $line = $_;
    my %config_line = parse_config_line;

    if ( $config_line{'type'} eq "set" ) {
        $config_variables{ $config_line{'key'} } = $config_line{'value'};
        next;
    } elsif ( $config_line{'type'} eq "deb" ) {
        my $arch = $config_line{'arch'};
        $arch = get_variable("defaultarch") if ! defined $config_line{'arch'};
        push @config_binaries, [ $arch, $config_line{'uri'}, @{$config_line{'components'}} ];
        next;
    } elsif ( $config_line{'type'} eq "deb-src" ) {
        push @config_sources, [ $config_line{'uri'}, @{$config_line{'components'}} ];
        next;
    } elsif ( $config_line{'type'} =~ /(skip-clean|clean)/ ) {
        my $link = $config_line{'uri'};
        $link = sanitise_uri($link);
        $link = '.' if ($link eq '');
        if ( $config_line{'type'} eq "skip-clean" ) {
            $skipclean{ $link } = 1;
        } elsif ( $config_line{'type'} eq "clean" ) {
            $clean_directory{ $link } = 1;
        }
        next;
    }

    die("apt-mirror: invalid line in config file ($.: $line ...)");
}
close CONFIG;

die("Please explicitly specify 'defaultarch' in mirror.list") unless get_variable("defaultarch");
}


######################################################################################
## Create the 3 needed directories if they don't exist yet
sub create_directories
{
my @needed_directories = ( get_variable("mirror_path"), get_variable("skel_path"), get_variable("var_path") );
foreach my $needed_directory (@needed_directories)
{
    unless ( -d $needed_directory )
    {
        make_path($needed_directory) or die("apt-mirror: can't create $needed_directory directory");
    }
}
}

######################################################################################
## Skel download

my %urls_to_download = ();

sub add_url_to_download
{
    my ( $url ) = @_;
    $url = remove_double_slashes($url);
    $urls_to_download{$url} = 1;
}

sub download_skel
{
%urls_to_download = ();

foreach (@config_sources)
{
    my ( $uri, $distribution, @components ) = @{$_};

    if (@components)
    {
        my $url = $uri . "/dists/" . $distribution . "/";

        add_url_to_download( $url . "InRelease" );
        add_url_to_download( $url . "Release" );
        add_url_to_download( $url . "Release.gpg" );
        foreach (@components)
        {
            add_url_to_download( $url . $_ . "/source/Release" );
            add_url_to_download( $url . $_ . "/source/Sources.gz" );
            add_url_to_download( $url . $_ . "/source/Sources.xz" );
        }
    }
    else
    {
        add_url_to_download( $uri . "/$distribution/Release" );
        add_url_to_download( $uri . "/$distribution/Release.gpg" );
        add_url_to_download( $uri . "/$distribution/Sources.gz" );
        add_url_to_download( $uri . "/$distribution/Sources.xz" );
    }
}

foreach (@config_binaries)
{
    my ( $arch, $uri, $distribution, @components ) = @{$_};

    if (@components)
    {
        my $url = $uri . "/dists/" . $distribution . "/";

        add_url_to_download( $url . "InRelease" );
        add_url_to_download( $url . "Release" );
        add_url_to_download( $url . "Release.gpg" );
        if ( get_variable("_contents") )
        {
            add_url_to_download( $url . "Contents-" . $arch . ".gz" );
            add_url_to_download( $url . "Contents-" . $arch . ".xz" );
        }
        foreach (@components)
        {
            if ( get_variable("_contents") )
            {
                add_url_to_download( $url . $_ . "/Contents-" . $arch . ".gz" );
                add_url_to_download( $url . $_ . "/Contents-" . $arch . ".xz" );
            }
            add_url_to_download( $url . $_ . "/binary-" . $arch . "/Release" );
            add_url_to_download( $url . $_ . "/binary-" . $arch . "/Packages.gz" );
            add_url_to_download( $url . $_ . "/binary-" . $arch . "/Packages.xz" );
            add_url_to_download( $url . $_ . "/i18n/Index" );
        }
    }
    else
    {
        add_url_to_download( $uri . "/$distribution/Release" );
        add_url_to_download( $uri . "/$distribution/Release.gpg" );
        add_url_to_download( $uri . "/$distribution/Packages.gz" );
        add_url_to_download( $uri . "/$distribution/Packages.xz" );
    }
}

chdir get_variable("skel_path") or die("apt-mirror: can't chdir to skel");
@index_urls = sort keys %urls_to_download;
download_urls( "index", @index_urls );

foreach ( keys %urls_to_download )
{
    s{^\w+://[^/]+/}{};
    s[~][%7E]g if get_variable("_tilde");
    $skipclean{$_} = 1;
}
}

######################################################################################
## Translation index download

sub find_translation_files_in_release
{
    # Look in the dists/$DIST/Release file for the translation files that belong
    # to the given component.

    my ( $dist_uri, $component ) = @_;
    my ( $release_uri, $release_path, $line ) = '';

    $release_uri  = $dist_uri . "Release";
    $release_path = get_variable("skel_path") . "/" . sanitise_uri($release_uri);

    unless ( open STREAM, "<$release_path" )
    {
        warn( "Failed to open Release file from " . $release_uri );
        return;
    }

    my $checksums = 0;
    while ( $line = <STREAM> )
    {
        chomp $line;
        if ($checksums)
        {
            if ( $line =~ /^ +(.*)$/ )
            {
                my @parts = split( / +/, $1 );
                if ( @parts == 3 )
                {
                    my ( $sha1, $size, $filename ) = @parts;
                    if ( $filename =~ m{^$component/i18n/Translation-[^./]*\.(gz|bz2|xz)$} )
                    {
                        add_url_to_download( $dist_uri . $filename, $size );
                    }
                }
                else
                {
                    warn("Malformed checksum line \"$1\" in $release_uri");
                }
            }
            else
            {
                $checksums = 0;
            }
        }
        if ( not $checksums )
        {
            if ( $line eq "SHA256:" )
            {
                $checksums = 1;
            }
        }
    }
}

sub process_translation_index
{
    # Extract all translation files from the dists/$DIST/$COMPONENT/i18n/Index
    # file. Fall back to parsing dists/$DIST/Release if i18n/Index is not found.

    my ( $url, $component ) = @_;
    my $dist_uri  = remove_double_slashes($url);
    my ( $base_uri, $index_uri, $index_path, $line ) = '';

    $base_uri   = $dist_uri . $component . "/i18n/";
    $index_uri  = $base_uri . "Index";
    $index_path = get_variable("skel_path") . "/" . sanitise_uri($index_uri);

    unless ( open STREAM, "<$index_path" )
    {
        find_translation_files_in_release( $dist_uri, $component );
        return;
    }

    my $checksums = 0;
    while ( $line = <STREAM> )
    {
        chomp $line;
        if ($checksums)
        {
            if ( $line =~ /^ +(.*)$/ )
            {
                my @parts = split( / +/, $1 );
                if ( @parts == 3 )
                {
                    my ( $sha1, $size, $filename ) = @parts;
                    add_url_to_download( $base_uri . $filename, $size );
                }
                else
                {
                    warn("Malformed checksum line \"$1\" in $index_uri");
                }
            }
            else
            {
                $checksums = 0;
            }
        }
        if ( not $checksums )
        {
            if ( $line eq "SHA256:" or $line eq "SHA1:" or $line eq "MD5Sum:" )
            {
                $checksums = 1;
            }
        }
    }

    close STREAM;
}

sub download_translations
{
%urls_to_download = ();

print "Processing translation indexes: [";

foreach (@config_binaries)
{
    my ( $arch, $uri, $distribution, @components ) = @{$_};
    print "T";
    if (@components)
    {
        my $url = $uri . "/dists/" . $distribution . "/";

        my $component;
        foreach $component (@components)
        {
            process_translation_index( $url, $component );
        }
    }
}

print "]\n\n";

push( @index_urls, sort keys %urls_to_download );
download_urls( "translation", sort keys %urls_to_download );

foreach ( keys %urls_to_download )
{
    s{^\w+://[^/]+/}{};
    s[~][%7E]g if get_variable("_tilde");
    $skipclean{$_} = 1;
}
}

######################################################################################
## DEP-11 index download

sub find_dep11_files_in_release
{
    # Look in the dists/$DIST/Release file for the DEP-11 files that belong
    # to the given component and architecture.

    my ( $dist_uri, $component, $arch ) = @_;
    my ( $release_uri, $release_path, $line ) = '';

    $release_uri  = $dist_uri . "Release";
    $release_path = get_variable("skel_path") . "/" . sanitise_uri($release_uri);

    unless ( open STREAM, "<$release_path" )
    {
        warn( "Failed to open Release file from " . $release_uri );
        return;
    }

    my $checksums = 0;
    while ( $line = <STREAM> )
    {
        chomp $line;
        if ($checksums)
        {
            if ( $line =~ /^ +(.*)$/ )
            {
                my @parts = split( / +/, $1 );
                if ( @parts == 3 )
                {
                    my ( $sha1, $size, $filename ) = @parts;
                    if ( $filename =~ m{^$component/dep11/(Components-${arch}\.yml|icons-[^./]+\.tar)\.(gz|bz2|xz)$} )
                    {
                        add_url_to_download( $dist_uri . $filename, $size );
                    }
                }
                else
                {
                    warn("Malformed checksum line \"$1\" in $release_uri");
                }
            }
            else
            {
                $checksums = 0;
            }
        }
        if ( not $checksums )
        {
            if ( $line eq "SHA256:" )
            {
                $checksums = 1;
            }
        }
    }
}

sub download_dep11
{
%urls_to_download = ();

print "Processing DEP-11 indexes: [";

foreach (@config_binaries)
{
    my ( $arch, $uri, $distribution, @components ) = @{$_};
    print "D";
    if (@components)
    {
        my $url = $uri . "/dists/" . $distribution . "/";

        my $component;
        foreach $component (@components)
        {
            find_dep11_files_in_release( $url, $component, $arch );
        }
    }
}

print "]\n\n";

push( @index_urls, sort keys %urls_to_download );
download_urls( "dep11", sort keys %urls_to_download );

foreach ( keys %urls_to_download )
{
    s[^(\w+)://][];
    s[~][%7E]g if get_variable("_tilde");
    $skipclean{$_} = 1;
}

######################################################################################
## cnf directory download

%urls_to_download = ();

sub find_cnf_files_in_release
{
    # Look in the dists/$DIST/Release file for the cnf files that belong
    # to the given component and architecture.

    my $dist_uri  = shift;
    my $component = shift;
    my $arch      = shift;
    my ( $release_uri, $release_path, $line ) = '';

    $release_uri  = $dist_uri . "Release";
    $release_path = get_variable("skel_path") . "/" . sanitise_uri($release_uri);

    unless ( open STREAM, "<$release_path" )
    {
        warn( "Failed to open Release file from " . $release_uri );
        return;
    }

    my $checksums = 0;
    while ( $line = <STREAM> )
    {
        chomp $line;
        if ($checksums)
        {
            if ( $line =~ /^ +(.*)$/ )
            {
                my @parts = split( / +/, $1 );
                if ( @parts == 3 )
                {
                    my ( $sha1, $size, $filename ) = @parts;
                    if ( $filename =~ m{^$component/cnf/(Commands-${arch}(\.(gz|bz2|xz))?)$} )
                    {
                        add_url_to_download( $dist_uri . $filename, $size );
                    }
                }
                else
                {
                    warn("Malformed checksum line \"$1\" in $release_uri");
                }
            }
            else
            {
                $checksums = 0;
            }
        }
        if ( not $checksums )
        {
            if ( $line eq "SHA256:" )
            {
                $checksums = 1;
            }
        }
    }
}

print "Processing cnf indexes: [";

foreach (@config_binaries)
{
    my ( $arch, $uri, $distribution, @components ) = @{$_};
    print "C";
    if (@components)
    {
        my $url = $uri . "/dists/" . $distribution . "/";

        my $component;
        foreach $component (@components)
        {
            find_cnf_files_in_release( $url, $component, $arch );
        }
    }
}

print "]\n\n";

push( @index_urls, sort keys %urls_to_download );
download_urls( "cnf", sort keys %urls_to_download );

foreach ( keys %urls_to_download )
{
    s[^(\w+)://][];
    s[~][%7E]g if get_variable("_tilde");
    $skipclean{$_} = 1;
}
}

######################################################################################
## Main download preparations

my %stat_cache = ();
my ( $FILES_ALL, $FILES_NEW, $FILES_MD5, $FILES_SHA1, $FILES_SHA256 );
my ( %hashes_bin, %hashes_dsc );

sub _stat
{
    my ( $filename ) = @_;
    return @{ $stat_cache{$filename} } if exists $stat_cache{$filename};
    my @res = stat($filename);
    $stat_cache{$filename} = \@res;
    return @res;
}

sub need_update
{
    my ( $filename, $size_on_server ) = @_;

    my ( undef, undef, undef, undef, undef, undef, undef, $size ) = _stat($filename);

    return 1 unless ($size);
    return 0 if $size_on_server == $size;
    return 1;
}

sub remove_spaces($)
{
    my ( $hashref ) = @_;
    foreach ( keys %{$hashref} )
    {
        while ( substr( $hashref->{$_}, 0, 1 ) eq ' ' )
        {
            substr( $hashref->{$_}, 0, 1 ) = '';
        }
    }
}

sub process_index
{
    my ( $uri, $index ) = @_;
    my ( $path, $package, $mirror, $files ) = '';

    $path = sanitise_uri($uri);
    local $/ = "\n\n";
    my $index_path = get_variable("skel_path") . "/" . $path . "/" . $index;
    $mirror = get_variable("mirror_path") . "/" . $path;

    if (-e "$index_path" )
    {
        unless ( open(STREAM, "<", "$index_path") ) {
            warn("apt-mirror: can't read index $index_path in process_index");
            return;
        }
    }
    elsif (-e "$index_path.gz" )
    {
        unless ( open(STREAM, "-|", "gzip -dc $index_path.gz") ) {
            warn("apt-mirror: can't read index $index_path.gz in process_index");
            return;
        }
    }
    elsif (-e "$index_path.xz" )
    {
        unless ( open(STREAM, "-|", "xz -dc $index_path.xz") ) {
            warn("apt-mirror: can't read index $index_path.xz in process_index");
            return;
        }
    }
    elsif (-e "$index_path.bz2" )
    {
        unless ( open(STREAM, "-|", "bzip2 -dc $index_path.bz2") ) {
            warn("apt-mirror: can't read index $index_path.bz2 in process_index");
            return;
        }
    }
    else
    {
        warn("apt-mirror: can't handle index $index_path in process_index");
        return;
    }

    while ( $package = <STREAM> )
    {
        local $/ = "\n";
        chomp $package;
        my ( undef, %lines ) = split( /^([\w\-]+:)/m, $package );

        chomp(%lines);
        remove_spaces( \%lines );

        if ( exists $lines{"Filename:"} )
        {    # Packages index
            my $rel = remove_double_slashes( $path . "/" . $lines{"Filename:"} );
            $skipclean{ $rel } = 1;
            print $FILES_ALL $rel . "\n";
            for my $alg ( keys %hashes_bin )
            {
                print { $hashes_bin{$alg} } $lines{$alg} . "  " . $rel . "\n" if defined $lines{$alg};
            }
            if ( need_update( $mirror . "/" . $lines{"Filename:"}, $lines{"Size:"} ) )
            {
                print $FILES_NEW $rel. "\n";
                add_url_to_download( $uri . "/" . $lines{"Filename:"}, $lines{"Size:"} );
            }
        }
        elsif ( exists $lines{"Directory:"} )
        {    # Sources index
            foreach my $alg ( keys %hashes_dsc )
            {
                next unless exists $lines{$alg};
                my $first = 0;
                foreach ( split( /\n/, $lines{$alg} ) )
                {
                    next if $_ eq '';
                    my ( $hash, $size, $name ) = split;
                    my $rel = remove_double_slashes( $path . "/" . $lines{"Directory:"} . "/" . $name );
                    $skipclean{ $rel } = 1;
                    print { $hashes_dsc{$alg} } $hash . "  " . $rel . "\n";
                    next unless $first;
                    $first = 1;
                    print $FILES_ALL $rel . "\n";
                    if ( need_update( $mirror . "/" . $lines{"Directory:"} . "/" . $name, $size ) )
                    {
                        print $FILES_NEW $rel. "\n";
                        add_url_to_download( $uri . "/" . $lines{"Directory:"} . "/" . $name, $size );
                    }
                }
            }
        }
        else
        {
            die("apt-mirror: Unknown section: $package");
        }
    }

    close STREAM;
}

sub download_packages
{
%urls_to_download = ();
%stat_cache = ();

open $FILES_ALL, ">" . get_variable("var_path") . "/ALL" or die("apt-mirror: can't write to intermediate file (ALL)");
open $FILES_NEW, ">" . get_variable("var_path") . "/NEW" or die("apt-mirror: can't write to intermediate file (NEW)");
open $FILES_MD5, ">" . get_variable("var_path") . "/MD5" or die("apt-mirror: can't write to intermediate file (MD5)");
open $FILES_SHA1, ">" . get_variable("var_path") . "/SHA1" or die("apt-mirror: can't write to intermediate file (SHA1)");
open $FILES_SHA256, ">" . get_variable("var_path") . "/SHA256" or die("apt-mirror: can't write to intermediate file (SHA256)");
%hashes_bin = (
    "MD5sum:" => $FILES_MD5,
    "SHA1:" => $FILES_SHA1,
    "SHA256:" => $FILES_SHA256,
);
%hashes_dsc = (
    "Files:" => $FILES_MD5,
    "Checksums-Sha1:" => $FILES_SHA1,
    "Checksums-Sha256:" => $FILES_SHA256,
);

print "Processing indexes: [";

foreach (@config_sources)
{
    my ( $uri, $distribution, @components ) = @{$_};
    print "S";
    if (@components)
    {
        my $component;
        foreach $component (@components)
        {
            process_index( $uri, "/dists/$distribution/$component/source/Sources" );
        }
    }
    else
    {
        process_index( $uri, "/$distribution/Sources" );
    }
}

foreach (@config_binaries)
{
    my ( $arch, $uri, $distribution, @components ) = @{$_};
    print "P";
    if (@components)
    {
        my $component;
        foreach $component (@components)
        {
            process_index( $uri, "/dists/$distribution/$component/binary-$arch/Packages" );
        }
    }
    else
    {
        process_index( $uri, "/$distribution/Packages" );
    }
}

undef %stat_cache;

print "]\n\n";

close $FILES_ALL    or die("apt-mirror: can't write to intermediate file (ALL)");
close $FILES_NEW    or die("apt-mirror: can't write to intermediate file (NEW)");
close $FILES_MD5    or die("apt-mirror: can't write to intermediate file (MD5)");
close $FILES_SHA1   or die("apt-mirror: can't write to intermediate file (SHA1)");
close $FILES_SHA256 or die("apt-mirror: can't write to intermediate file (SHA256)");

######################################################################################
## Main download

chdir get_variable("mirror_path") or die("apt-mirror: can't chdir to mirror");

my $need_bytes = 0;
foreach ( values %urls_to_download )
{
    $need_bytes += $_;
}

my $size_output = format_bytes($need_bytes);

print "$size_output will be downloaded into archive.\n";

download_urls( "archive", sort keys %urls_to_download );
}

######################################################################################
## Copy skel to main archive

sub copy_file
{
    my ( $from, $to ) = @_;
    my $dir = dirname($to);
    return unless -f $from;
    make_path($dir) unless -d $dir;
    if ( get_variable("unlink") == 1 )
    {
        if ( compare( $from, $to ) != 0 ) { unlink($to); }
    }
    unless ( copy( $from, $to ) )
    {
        warn("apt-mirror: can't copy $from to $to");
        return;
    }
    my ( $atime, $mtime ) = ( stat($from) )[ 8, 9 ];
    utime( $atime, $mtime, $to ) or die("apt-mirror: can't utime $to");
}

sub copy_index
{
foreach (@index_urls)
{
    die("apt-mirror: invalid url in index_urls") unless s{^\w+://[^/]+/}{};
    copy_file( get_variable("skel_path") . "/" . sanitise_uri("$_"), get_variable("mirror_path") . "/" . sanitise_uri("$_") );
}
}

######################################################################################
## Make cleaning script

my ( @rm_dirs, @rm_files ) = ();
my $unnecessary_bytes = 0;

sub process_symlink
{
    return 1;    # symlinks are always needed
}

sub process_file
{
    my ( $file ) = @_;
    $file =~ s[~][%7E]g if get_variable("_tilde");
    return 1 if $skipclean{remove_double_slashes($file)};
    return 1 if $file =~ /\/(?:pre|post)up\.sh(?:\.gpg)?$/;
    return 1 if $file =~ /\/ucs-releases.json$/;
    push @rm_files, $file;
    my ( undef, undef, undef, undef, undef, undef, undef, $size, undef, undef, undef, undef, $blocks ) = stat($file);
    $unnecessary_bytes += $blocks * 512;
    return 0;
}

sub process_directory
{
    my ( $dir ) = @_;
    my $is_needed = 0;
    return 1 if $skipclean{remove_double_slashes($dir)};
    opendir( my $dir_h, $dir ) or die "apt-mirror: can't opendir $dir: $!";
    foreach ( grep { !/^\.$/ && !/^\.\.$/ } readdir($dir_h) )
    {
        my $item = $dir . "/" . $_;
        $is_needed |= process_directory($item) if -d $item && !-l $item;
        $is_needed |= process_file($item)      if -f $item;
        $is_needed |= process_symlink($item)   if -l $item;
    }
    closedir $dir_h;
    push @rm_dirs, $dir unless $is_needed;
    return $is_needed;
}

sub do_clean
{
foreach ( keys %clean_directory )
{
    process_directory($_) if -d $_ && !-l $_;
}

open CLEAN, ">" . get_variable("cleanscript") or die("apt-mirror: can't open clean script file");

my ( $i, $total ) = ( 0, scalar @rm_files );

if ( get_variable("_autoclean") )
{
    my $size_output = format_bytes($unnecessary_bytes);
    print "$size_output in $total files and " . scalar(@rm_dirs) . " directories will be freed...";

    foreach (@rm_files) { unlink $_; }
    foreach (@rm_dirs)  { rmdir $_; }
}
else
{
    my $size_output = format_bytes($unnecessary_bytes);
    print "$size_output in $total files and " . scalar(@rm_dirs) . " directories can be freed.\n";
    print "Run " . get_variable("cleanscript") . " for this purpose.\n\n";

    print CLEAN "#!/bin/sh\n";
    print CLEAN "set -e\n\n";
    print CLEAN "cd " . quoted_path(get_variable("mirror_path")) . "\n\n";
    print CLEAN "echo 'Removing $total unnecessary files [$size_output]...'\n";
    foreach (@rm_files)
    {
        print CLEAN "rm -f '$_'\n";
        print CLEAN "echo -n '[" . int( 100 * $i / $total ) . "\%]'\n" unless $i % 500;
        print CLEAN "echo -n .\n" unless $i % 10;
        $i++;
    }
    print CLEAN "echo 'done.'\n";
    print CLEAN "echo\n\n";

    $i     = 0;
    $total = scalar @rm_dirs;
    print CLEAN "echo 'Removing $total unnecessary directories...'\n";
    foreach (@rm_dirs)
    {
        print CLEAN "if test -d '$_'; then rmdir '$_'; fi\n";
        print CLEAN "echo -n '[" . int( 100 * $i / $total ) . "\%]'\n" unless $i % 50;
        print CLEAN "echo -n .\n";
        $i++;
    }
    print CLEAN "echo 'done.'\n";
    print CLEAN "echo\n";

    close CLEAN;
}

# Make clean script executable
my $perm = ( stat get_variable("cleanscript") )[2] & 07777;
chmod( $perm | 0111, get_variable("cleanscript") );
}

sub do_postrun
{
if ( get_variable("run_postmirror") && -f get_variable("run_postmirror") )
{
    my $postscript = get_variable("postmirror_script");
    print "Running the Post Mirror script ...\n";
    print "(" . $postscript . ")\n\n";
    if ( -x $postscript )
    {
        system( $postscript, '' );
    }
    elsif ( -f $postscript )
    {
        system( '/bin/sh', $postscript );
    }
    print "\nPost Mirror script has completed. See above output for any possible errors.\n\n";
}
}

sub run
{
    my ( undef, $cfg ) = @_;
    $config_file = $cfg if defined $cfg;
    die("apt-mirror: invalid config file specified: $config_file") unless -e $config_file;
    load_config();
    create_directories();
    lock_aptmirror();
    download_skel();
    download_translations();
    download_dep11();
    download_packages();
    copy_index();
    do_clean();
    do_postrun();
    unlock_aptmirror();
}

__PACKAGE__->run( @ARGV ) unless caller();

__END__

=pod

=head1 NAME

apt-mirror - apt sources mirroring tool

=head1 SYNOPSIS

apt-mirror [configfile]

=head1 DESCRIPTION

A small and efficient tool that lets you mirror a part of or
the whole Debian GNU/Linux distribution or any other apt sources.

Main features:
 * It uses a config similar to APT's F<sources.list>
 * It's fully pool compliant
 * It supports multithreaded downloading
 * It supports multiple architectures at the same time
 * It can automatically remove unneeded files
 * It works well on an overloaded Internet connection
 * It never produces an inconsistent mirror including while mirroring
 * It works on all POSIX compliant systems with Perl and F<wget>

=head1 COMMENTS

F<apt-mirror> uses F</etc/apt/mirror.list> as a configuration file.
By default it is tuned to official Debian or Ubuntu mirrors. Change
it for your needs.

After you setup the configuration file you may run as root:

    # su - apt-mirror -c apt-mirror

Or uncomment the line in F</etc/cron.d/apt-mirror> to enable daily mirror updates.

=head1 FILES

F</etc/apt/mirror.list>
        Main configuration file

F</etc/cron.d/apt-mirror>
        Cron configuration template

F</var/spool/apt-mirror/mirror>
        Mirror places here

F</var/spool/apt-mirror/skel>
        Place for temporarily downloaded indexes

F</var/spool/apt-mirror/var>
        Log files placed here. URLs and MD5 checksums also here.

=head1 CONFIGURATION

The F<mirror.list> configuration supports many options, the file is well commented explaining each option.

=head2 SETTINGS

The configuration can be changed changed by using the C<set> command followed by a option name and its value.
Values may reference other options and are recursively substituted to a depth of 16 nestings.

=over 2

=item C<base_path>

Base directory path. Not directly used, but used by other options.
Default: I</var/spool/apt-mirror>

=item C<mirror_path>

Directory where files are mirrored to.
Default: I<$base_path/mirror>

=item C<skel_path>

Directory where index files are downloaded into before being processed.
Default: I<$base_path/skel>

=item C<var_path>

Directory where temporary and log files are kept in.
Default: I<$base_path/var>

=item C<_tilde>

If set to B<1>, the tilde C<~> is replaced with the hex-encoded C<%7E> version.
Otherwise the tile is also used for local paths.
Default: B<0>

=item C<defaultarch>

Specify the default architecture for the binary packages to mirror.
Defaults to the host architecture or B<i386> as a fallback.

=item C<_contents>

The I<Contents> files are also mirrored when set to B<1>.
Default: B<1>

=item C<use_proxy>

If set to B<on> or B<yes>, the following proxy settings for HTTP and HTTPS are explicitly configured for F<wget>.
Otherwise no proxy is used or the ones configured through environment variables.
Default: B<0>

=item C<http_proxy>, C<https_proxy>

Proxy for http:// and https:// requests.

=item C<proxy_user>, C<proxy_password>

User name and password for proxy authentication.

=item C<nthreads>

The number of concurrent download processes.
Default: B<20>

=item C<limit_rate>

Limit the download speed of each F<wget> process to the given amount in bytes per second.
Default: B<100m>

=item C<auth_no_challenge>

By default B<0> F<wget> only sends HTTP authentication information when requested by the remote server.
By setting this to B<1> the information is B<alwas> sent.

=item C<no_check_certificate>

If set to B<1> F<wget> will not check the HTTPS certificates for validity.
Default: B<0>

=item C<unlink>

If set to B<1> files will be unlinked before being overwritten.
This may be useful when using hard-links.
Default: B<0>

=item C<_autoclean>

If set to B<1>, no longer referenced files are automatically cleaned up.
Otherwise the C<cleanscript> can be used.
Default: B<0>

=item C<cleanscript>

The name of a script created by F<apt-mirror>, which can be executed to cleanup no longer referenced files.
The option C<_autoclean> must be disabled and at least one C<clean> statement must be used.
Default: I<$base_path/clean.sh>

=item C<run_postmirror>

Run the user supplied script C<postmirror_script> after mirroring is complete.
Default: B<0>

=item C<postmirror_script>

If C<run_postmirror> is enabled, this specified the script to execute.
Default: I<$var_path/postmirror.sh>

=back

=head2 STATEMENTS

The following statements can be used to configure the distributions to mirror and to clean up:

=over 2

=item C<deb $uri $parts>

Mirror the default architecture of distribution I<$uri>.
I<$parts> may either be a suite name and a list of components C<stable main contrib non-free> or a C<$path/> for flat repository.

=item C<deb-$arch $uri $parts>

Mirror the given architecture I<$arch>.

=item C<deb [arch=$arch] $uri $parts>

Mirror the given architecture I<$arch>.

=item C<deb-src $uri $parts>

Mirror the source packages.

=item C<clean $uri>

Enable cleaning up files below the local directory corresponding to the given I<$uri>.

=item C<skip-clean $uri>

Disable cleaning up files below the local directory corresponding to the given I<$uri>.

=back

=head2 EXAMPLES

Here are some sample mirror configuration lines showing the various supported ways:

Normal:

    deb http://example.com/debian stable main contrib non-free

Arch Specific: (many other architectures are supported)

    deb-powerpc http://example.com/debian stable main contrib non-free
    deb [arch=powerpc] http://example.com/debian stable main contrib non-free

HTTP and FTP Auth or non-standard port:

    deb http://user:pass@example.com:8080/debian stable main contrib non-free

HTTPS with sending Basic HTTP authentication information (plaintext username and password) for all requests:
(this was default behaviour of Wget 1.10.2 and prior and is needed for some servers with new version of Wget)

    set auth_no_challenge 1
    deb https://user:pass@example.com:443/debian stable main contrib non-free

HTTPS without checking certificate:

    set no_check_certificate 1
    deb https://example.com:443/debian stable main contrib non-free

Source Mirroring:

    deb-src http://example.com/debian stable main contrib non-free

=head1 AUTHORS

Dmitry N. Hramtsov E<lt>hdn@nsu.ruE<gt>
Brandon Holtsclaw E<lt>me@brandonholtsclaw.comE<gt>

=head1 SEE ALSO

L<sources.list(5)>,
L<wget(1)>

=cut
