#!/usr/bin/perl
# TODO: --clean option to cleanup repo accrding to metadata

use strict;
use warnings "all";
use Fcntl;
use File::Basename;
use File::Path qw(make_path);
use File::Spec;
use XML::Parser;
use IO::Zlib;
use URI::URL;
use Data::Dumper;

sub dlfunc(@);
sub urlencode($);
sub getmetadata();
sub help($);
sub path_normalize_by_string_manipulation($);

help(1) unless (defined $ARGV[1]);
help(0) if ($ARGV[0] eq '--help');
help(0) if ($ARGV[0] eq '-h');

my $BASEURL = $ARGV[0];
my $BASEDIR = $ARGV[1];

my $primaryxmlgz = getmetadata();

my $fh = new IO::Zlib;
my $xmldata = '';

if ($fh->open($BASEDIR . $primaryxmlgz, "rb")) {

        while (<$fh>) {
                $xmldata .= $_;
        }

        $fh->close;
} else {
        syswrite STDERR, sprintf("An error has occured while reading %s.", $BASEDIR . 'repodata/primary.xml.gz');
        exit 1;
}

my $p1 = new XML::Parser(Style => 'Tree');
my $ref = $p1->parse($xmldata);
undef $xmldata;
my @array = @{ $ref->[1] };

for (my $i = 0; $i < @array; $i++) {

        if (defined($array[$i]) and ($array[$i] eq 'package')) {
                $i++;
                my @array2 = @{ $array[$i] };
                my $size = -1;
                my $link;

                for (my $j = 0; $j < @array2; $j++) {

                        if (defined($array2[$j]) and ($array2[$j] eq 'size')) {
                                $j++;
                                $size = $array2[$j][0]{'package'};
                        }

                        if (defined($array2[$j]) and ($array2[$j] eq 'location')) {
                                $j++;
                                $link = $array2[$j][0]{'href'};
#                               syswrite STDOUT, "+ " . $array2[$j][0]{'href'} . "\n";
                        }

                }

                dlfunc($link, $size);
                undef $size;
                undef $link;
                @array2 = -1;
        }
}

exit 0;

sub help($) {
        my $rc = shift;
        my $help = <<'HELP';
Usage: cr.pl source destination

Where
Source must be http(s) url which trimmed at repodata folder. If full url is
http://mirror.yandex.ru/centos/7.4.1708/os/x86_64/repodata/repomd.xml
source must be given as:
http://mirror.yandex.ru/centos/7.4.1708/os/x86_64/

Destination is the folder where all files and metadata will be downloaded, if
folder does not exist it will be created. Must contain trailng slash char.
For example:
/var/www/htdocs/repo/
HELP

        syswrite STDOUT, $help;
        exit $rc;
}

sub dlfunc(@) {
        my $url = shift; # short (relative) URL without BASE part
        my $size = shift;
        my $wgetpath;
        my $savepath = path_normalize_by_string_manipulation ($BASEDIR . $url);

        if (substr($savepath, 0, length($BASEDIR)) ne $BASEDIR) {
                syswrite STDERR, sprintf("Skipping package %s, because it out of destdir %s, looks like quirky metadata.\n", $savepath, $BASEDIR);
                return;
        }

        # do not re-download already downloaded rpm packages
        unless ($size == -1) {

                if (-f $savepath) {
                        my $filesize = (stat($savepath))[7];

                        if ($size == $filesize) {
                               return;
                        }
                }

        }

        my $basedir; (undef, $basedir) = fileparse($savepath);

        unless (-d $basedir) {
                my $ret = make_path ($basedir);

                if ($ret < 1) {
                        syswrite STDERR, sprintf("Unable to create directory %s .\n", $basedir);
                        exit 1;
                }
        }

        if (-f "/bin/wget") {
                $wgetpath = '/bin/wget';
        } elsif (-f "/usr/bin/wget") {
                $wgetpath = '/usr/bin/wget';
        } elsif (-f "/usr/local/bin/wget") {
                $wgetpath = '/usr/local/bin/wget';
        } else {
                syswrite STDERR, "Please install wget. (Unable to find it in std locations)\n";
                exit 1;
        }

        $url = $BASEURL . $url;
        $url = urlencode($url);
        system($wgetpath, '--no-check-certificate', '-q', '-T', '20', '-O', $savepath, '-o', '/dev/null', $url);

        undef $savepath;
        undef $url;
}

sub urlencode($) {
        my $url = shift;
        my $urlobj = url $url;
        $url = $urlobj->as_string;
        undef $urlobj;
        return $url;
}

sub getmetadata() {
        dlfunc('repodata/repomd.xml', -1);

        my $p1 = new XML::Parser(Style => 'Tree');
        my $ref = $p1->parsefile($BASEDIR . 'repodata/repomd.xml');

#print Dumper $ref->[1][8][12][0]{'href'};
#  must be 'data'-------^
#  must be 'location'------^

        my @array = @{ $ref->[1] };
        my $primaryxmlgz;

        for (my $i = 0; $i < @array; $i++) {

                if (defined($array[$i]) and ($array[$i] eq 'data')){
                        $i++;
                        my @array2 = @{ $array[$i] };

                        for (my $j = 0; $j < @array2; $j++) {
                                if (defined($array2[$j]) and ($array2[$j] eq 'location')) {
                                        $j++;
                                        dlfunc($array2[$j][0]{'href'}, -1);

                                        if ($array2[$j][0]{'href'} =~ /primary\.xml\.gz$/) {
                                                $primaryxmlgz = $array2[$j][0]{'href'};
                                        }
                                }

                        }

                        @array2 = -1;
                }

        }

        return $primaryxmlgz;
}

sub path_normalize_by_string_manipulation ($) {
    my $path = shift;

    # canonpath does string manipulation, but does not remove "..".
    my $ret = File::Spec->canonpath($path);

    # Let's remove ".." by using a regex.
    while ($ret =~ s{
        (^|/)              # Either the beginning of the string, or a slash, save as $1
        (                  # Followed by one of these:
            [^/]|          #  * Any one character (except slash, obviously)
            [^./][^/]|     #  * Two characters where
            [^/][^./]|     #    they are not ".."
            [^/][^/][^/]+  #  * Three or more characters
        )                  # Followed by:
        /\.\./             # "/", followed by "../"
        }{$1}x
    ) {
        # Repeat this substitution until not possible anymore.
    }

    # Re-adding the trailing slash, if needed.
    if ($path =~ m!/$! && $ret !~ m!/$!) {
        $ret .= '/';
    }

    return $ret;
}
__END__