From 79a36a63f3ab15b3e415c5fef40ec4dfd0023c48 Mon Sep 17 00:00:00 2001 From: Eleksir Date: Fri, 4 Jan 2019 15:43:54 +0300 Subject: [PATCH] rrclone.pl and rrclone-mt.pl are moved to own repo --- rrclone-mt.pl | 403 -------------------------------------------------- rrclone.pl | 325 ---------------------------------------- 2 files changed, 728 deletions(-) delete mode 100644 rrclone-mt.pl delete mode 100644 rrclone.pl diff --git a/rrclone-mt.pl b/rrclone-mt.pl deleted file mode 100644 index f3ec962..0000000 --- a/rrclone-mt.pl +++ /dev/null @@ -1,403 +0,0 @@ -#!/usr/bin/perl -# simple RPM Repository cloning script - -# looks like some toxic ditribution polices for ill-driven distros like debian|ubuntu or less shitty like centos -# make maintainers split std. perl (and python too) distribution to many-many packages, even meta packages like -# perl-modules for ubuntu contain not full set of default perl source distribution' modules, so you have to install -# some packages in order to work with this script -# -# for ubuntu: libjson-pp-perl, libfile-spec-perl, libxml-parser-perl, libio-compress-perl, liburi-perl -# for slackware - everything is bundled with builtin perl :) - -# TODO: use another model of xml processing to use less memory - -use strict; -use warnings "all"; -use Fcntl; -use threads; -use threads::shared; -use File::Basename; -use File::Path qw(make_path); -use File::Spec; -use XML::Parser; -use IO::Zlib; -use URI::URL; -use Data::Dumper; -use HTTP::Tiny; -use IO::Socket::SSL; # implicit requirement in order to HTTP::Tiny work with https - -sub mythread(); -sub dlfunc(@); -sub urlencode($); -sub getmetadata(); -sub help($); -sub path_normalize_by_string_manipulation($); -sub getfilenames($); -sub noslash($); -sub dbg($); - -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; -my $DEBUG = 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]; -} - -noslash($BASEURL); -noslash($BASEDIR); - -syswrite STDOUT, sprintf("Cloning %s to %s\n", $BASEURL, $BASEDIR); - -my @REPOFILES :shared; -my @FILES; -my @LINKS :shared; -my @SIZES :shared; -my $MUTEX :shared = 0; # while $MUTEX = 1, noone picks links - -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'}; - } - - } - - push @LINKS, $link; - push @SIZES, $size; - - undef $size; - undef $link; - @array2 = -1; - } -} - -@array = -1; -undef $p1; - -for (my $i = 1; $i < 4; $i++) { - threads->create('mythread'); -} - -my $tcount = 0; - -do { - $tcount = threads->list(); - - foreach my $thread (threads->list(threads::joinable)) { - $thread->join(); - } - - # list of threads can be polled once per second, it delays consecutive polls by one second - sleep(3); -} while ($tcount > 0); - -undef $tcount; -syswrite STDOUT, "Cloning done.\n"; -exit 0 if ($noclean == 1); - -syswrite STDOUT, sprintf("Cleaning old files in %s\n", $BASEDIR); - -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; - } -} - - -while (@filesToDelete > 0) { - my $file = pop(@filesToDelete); - - unless (-d $file) { - dbg(" - Unlinking $file"); - unlink $file; - } -} - -syswrite STDOUT, "Cleaning done.\n"; -exit 0; - -sub help($) { - my $rc = shift; - my $help = <<'HELP'; -Usage: cr.pl [--noclean] http://source/url/ /destination/dir/ - -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 mythread() { - while ( 1 ) { - my $size; - my $link; - - if ($MUTEX == 0) { - $MUTEX = 1; - $size = pop(@SIZES); - $link = pop(@LINKS); - $MUTEX = 0; - } else { -# pop from 2 arrays takes very small amount of time, -# in practice we do not need this micro-sleep -# select(undef, undef, undef, 0.05); - next; - } - - if (@LINKS > 0) { - if ((defined($size)) and (defined($link))) { - dlfunc($link, $size); - } - } else { -# handle last package in list - if ((defined($size)) and (defined($link))) { - dlfunc($link, $size); - } else { - last; - } - } - } -} - -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) { - dbg(" * Skip $savepath file already exists and on-disk and in-repo sizes are match."); - return; - } else { - dbg(" + Downloading $savepath file exists but on-disk and in-repo sizes are mismatch. $filesize vs $size.") - } - } else { - dbg(" + Downloading $savepath"); - } - - } - - 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; - } - } - - $url = $BASEURL . $url; - $url = urlencode($url); - - my $http = HTTP::Tiny->new(); - $http->mirror($url, $savepath); - undef $http; - - 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; - } - - } - - @array = -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 = - map { $path . '/' . $_ } - grep { !/^\.{1,2}$/ } - readdir (DIR); - @FILES = (@FILES, @localfiles); - - foreach (@localfiles) { - next if(-l $_); - - if(-d $_){ - getfilenames($_); - } - } -} - -sub noslash($) { - my $str = shift; - return if ($str =~ /\/$/); - syswrite STDERR, "Source and destination must have trailing slashes!\n"; - exit 1; -} - -sub dbg($) { - my $msg = shift; - - if ($DEBUG) { - syswrite STDOUT, "$msg\n"; - } -} - -__END__ diff --git a/rrclone.pl b/rrclone.pl deleted file mode 100644 index ee8c481..0000000 --- a/rrclone.pl +++ /dev/null @@ -1,325 +0,0 @@ -#!/usr/bin/perl -# -# simple RPM Repository cloning script - -# looks like some toxic ditribution polices for ill-driven distros like debian|ubuntu or less shitty like centos -# make maintainers split std. perl (and python too) distribution to many-many packages, even meta packages like -# perl-modules for ubuntu contain not full set of default perl source distribution' modules, so you have to install -# some packages in order to work with this script -# -# for ubuntu: libjson-pp-perl, libfile-spec-perl, libxml-parser-perl, libio-compress-perl, liburi-perl -# for slackware - everything is bundled with builtin perl :) - -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($); -sub noslash($); - -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]; -} - -noslash($BASEURL); -noslash($BASEDIR); - -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($_); - } - } - -} - -sub noslash($) { - my $str = shift; - return if ($str =~ /\/$/); - syswrite STDERR, "Source and destination must have trailing slashes!\n"; - exit 1; -} - -__END__