misc/cr.pl

#!/usr/bin/perl
# TODO: implement fool proof paths check (add trailing backslash if it absent on url and path)
#

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($);
sub getfilenames($);

help(0) unless (defined $ARGV[0]);
help(1) unless (defined $ARGV[1]);

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

my $noclean = 0;

if (defined($ARGV[0]) and $ARGV[0] eq '--noclean') {
	$noclean = 1;
}

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

if ($noclean == 1) {
	help(1) unless (defined $ARGV[2]);
	$BASEURL = $ARGV[1];
	$BASEDIR = $ARGV[2];
}

my @REPOFILES;
my @FILES;

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 if ($noclean == 1);

my $searchpath = $BASEDIR;
chop $searchpath;
getfilenames($searchpath);
my @filesToDelete;

foreach my $fileOnDisk (@FILES) {
	my $flag = 0;

	foreach my $fileInXML (@REPOFILES) {
		if ($fileInXML eq $fileOnDisk) {
			$flag = 1;
			last;
		}
	}

	if ($flag == 0) {
		push @filesToDelete, $fileOnDisk;
	}
}


foreach my $file (@filesToDelete) {
	unless (-d $file) {
		unlink $file;
	}
}

exit 0;

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

Where
--noclean is optional argument, if it specified, no cleanup operation will
be performed after rpm downloading complete.

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

	push @REPOFILES, $savepath;

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

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

	opendir (DIR, $path) or return "";
	my @localfiles;
	@localfiles =
	map { $path . '/' . $_ }
	grep { !/^\.{1,2}$/ }
	readdir (DIR);
	@FILES = (@FILES, @localfiles);

	foreach (@localfiles) {
		next if(-l $_);

		if( -d $_){
			getfilenames($_);
		}
	}

}

__END__