From 22e92ee731cdc58a315005a7dd7b92fb53c45bd1 Mon Sep 17 00:00:00 2001 From: eleksir Date: Sat, 5 Jan 2019 02:53:27 +0300 Subject: [PATCH] Initial commit --- LICENSE | 22 +++ README.md | 71 ++++++++++ TODO | 19 +++ rrclone | 325 ++++++++++++++++++++++++++++++++++++++++++ rrclone-mt | 403 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 840 insertions(+) create mode 100644 LICENSE create mode 100644 README.md create mode 100644 TODO create mode 100644 rrclone create mode 100644 rrclone-mt diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..21423b1 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright 2010 Sergei Fedosov + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..e478e04 --- /dev/null +++ b/README.md @@ -0,0 +1,71 @@ +# RPM Repositories Cloning tool + +1 to 1 rpm cloning tool + +## Getting Started + +rrclone http://source/repo/ /absolute/path/to/destination/folder/ + +### Prerequisites + +Linux or FreeBSD with recent perl (at least 5.20, on previous versions i didn't +test it). There is no external packages required in order to run this program. +The only thing that required is Perl. But many linux distributions have +ill-minded practice to rip Perl into many sub-packages, in this case you have +to install some perl packages. + +for ubuntu: libjson-pp-perl, libfile-spec-perl, libxml-parser-perl, +libio-compress-perl, liburi-perl + +in case of Slackware Linux everything is already shipped with single Perl +package. + +``` +apt install libjson-pp-perl, libfile-spec-perl, libxml-parser-perl, +libio-compress-perl, liburi-perl +``` + +### Installing + +There are no additional effort required for one-shot sync. + +But if you planning to keep repository in sync with upstream, you should add +cron job, that can be run without any additional privileges, i.e. web server +user is enough for that. + +to add cronjob invoke + +``` +su -s /bin/bash apache +crontab -e +``` + +``` +30 4 * * 0 /path/to/rrclone http://repository/url/ /absolute/path/to/copy/ +``` + +This will run job weekly, at Sunday 4:30. + +## Deployment + +Obviously, before deploy this script on some production environment you should +package it properly :) + +## Contributing + +If you want contribute ideas or code - please feel free to contact me via +email eleksir at exs-elm.ru + +## Authors + +* **Eleksir** - *Initial work* - [exs' corner](https://exs-elm.ru/hg/rrclone) + +## License + +This project is licensed under the BSD License - see the [LICENSE](LICENSE) file for details + +## Acknowledgments + +* Hat tip to anyone whose code was used +* Inspiration +* you diff --git a/TODO b/TODO new file mode 100644 index 0000000..f85ae24 --- /dev/null +++ b/TODO @@ -0,0 +1,19 @@ +Технический долг и планируемые доработки. + +* внедрить GetOpt, чтобы корректно парсить аргументы ком.строки стандартными средствами. Для этого нужно будет использовать внешние по отношению к Perl модули, GetOpt и GetOpt::Long +* XML::Simple умеет работать не только с деревом, но и с потоком xml, в случае с потоком должно потребляться меньше памяти, но работать с ним сложнее +* добавить возможность работы с sqlite-метаданными и перейти на этот метод по-умолчанию +* добавить пример spec-файла +* добавить пример debian package +* добавить slackbuild +* добавить ebuild +* добавить примеры crontab +* добавить man page +* добавить методики работы с https://packagecloud.io/ и сервисами подобными им (без автоиндекса) + +Факультативное задание :) +* добавить возможность клонирования deb-репозиториев +* добавить возможность клонирования ещё каких-нибудь репозиториев, навроде apt-rpm +* добавить возможность исключения пакетов по регулярке (по подстроке, хотябы) +* добавить возможность перегенерации метаданных, по фэн-шую (описать этот фэн-шуй в документации) + diff --git a/rrclone b/rrclone new file mode 100644 index 0000000..ee8c481 --- /dev/null +++ b/rrclone @@ -0,0 +1,325 @@ +#!/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__ diff --git a/rrclone-mt b/rrclone-mt new file mode 100644 index 0000000..f3ec962 --- /dev/null +++ b/rrclone-mt @@ -0,0 +1,403 @@ +#!/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__