Update TODO

--HG--
branch : docs

.hgtags

@@ -0,0 +1,2 @@
+7220aac9615b3ef8f1b26df11d8c5a0c5310dcc0 v1.0
+f30a03756874abf5a09aebcd3d9ab2e236608b60 v1.1

README.md

@@ -1,6 +1,6 @@
 # RPM Repositories Cloning tool
 
-1 to 1 rpm cloning tool
+1 to 1 rpm repository cloning tool
 
 ## Getting Started
 
@@ -21,10 +21,19 @@ in case of Slackware Linux everything is already shipped with single Perl
 package.
 
 ```
-apt install libjson-pp-perl, libfile-spec-perl, libxml-parser-perl, 
+# apt install libjson-pp-perl libfile-spec-perl libxml-parser-perl \
-libio-compress-perl, liburi-perl
+libio-compress-perl liburi-perl
 ```
 
+A correct path to repository. You need a string after "baseurl=" in repo-file
+(one that located in /etc/yum.repos.d, for example), it must end with trailng
+slash. If it does not, just add it.
+
+To check that url is correct you can try to download part of repository xml
+metadata. Put your string into browser address bar and add
+"repodata/repomd.xml" (no quotes) and if you see xml text then - vua-la! -
+your string is correct.
+
 ### Installing
 
 There are no additional effort required for one-shot sync.

TODO

@@ -1,15 +1,14 @@
 Технический долг и планируемые доработки.
 
-* внедрить GetOpt, чтобы корректно парсить аргументы ком.строки стандартными средствами. Для этого нужно будет использовать внешние по отношению к Perl модули, GetOpt и GetOpt::Long
-* XML::Simple умеет работать не только с деревом, но и с потоком xml, в случае с потоком должно потребляться меньше памяти, но работать с ним сложнее
 * добавить возможность работы с sqlite-метаданными и перейти на этот метод по-умолчанию
+* сделать fatpack скрипта
+* запользовать AnyEvent::HTTP для скачивания пакетов
+* задействовать проверку по sha256 хэшу как скачиваемых пакетов так и тех, которые уже были скачаны
+* уточнить список возможных хэшей
 * добавить пример spec-файла
 * добавить пример debian package
 * добавить slackbuild
 * добавить ebuild
-* добавить примеры crontab
-* добавить man page
-* добавить методики работы с https://packagecloud.io/ и сервисами подобными им (без автоиндекса)
 
 Факультативное задание :)
 * добавить возможность клонирования deb-репозиториев

docs/rrclone.1

@@ -0,0 +1,41 @@
+.TH "RRCLONE" "1" "5 December 2019"
+.SH "NAME"
+rrclone \- RPM Repository Cloning tool
+.SH "SYNOPSIS"
+.B rrclone
+[\fI\,OPTION\/\fR]...
+SOURCE
+DESTINATION
+.SH "DESCRIPTION"
+.PP
+Copies all packages and metadata from remote repository to local folder.
+To guess package list it parses metadata. For now only XML metadata is supported.
+.SH "OPTIONS"
+.TP
+\fB\-\-help\fR
+show brief help message
+.TP
+\fB\-\-version\fR
+show version
+.TP
+\fB\-\-verbose\fR
+more verbose output
+.TP
+\fB\-\-noclean\fR
+do not clean packages that are missing in metadata
+.TP
+\fBSOURCE\fR
+is http(s) url that does not include repodata part.
+For example if full (index) metadata path is http://server/repo/Packages/repodata/repomd.xml
+then SOURCE will be http://server/repo/Packages/ with trailing slash.
+.TP
+\fBDESTINATION\fR
+full path to local directory, for example /var/www/repository/ with triling slash.
+.SH "AUTHOR"
+.TP
+Sergei Fedosoff <eleksir@gmail.com> aka eleksir <eleksir@exs-elm.ru>
+.SH "COPYRIGHT"
+Copyright © 2018 Sergei Fedosoff. License 2 clause BSD:
+https://directory.fsf.org/wiki?title=License:FreeBSD
+.SH "SEE ALSO"
+.B rpm (1).

docs/rrclone.crontab

@@ -0,0 +1,2 @@
+# run every sunday at 4.30 in the night
+30 4 * * 0 http://server/repo/packages/ /var/www/repo 1>/dev/null

rrclone

@@ -1,6 +1,5 @@
 #!/usr/bin/perl
-# simple RPM Repository cloning script
+#
-
 use strict;
 use warnings "all";
 use Fcntl;
@@ -15,44 +14,50 @@ use URI::URL;
 use Data::Dumper;
 use HTTP::Tiny;
 use IO::Socket::SSL; # implicit requirement in order to HTTP::Tiny work with https
+use Getopt::Long;
+use utf8;
 
 sub mythread();
 sub dlfunc(@);
 sub urlencode($);
 sub getmetadata();
 sub help($);
-sub path_normalize_by_string_manipulation($);
+sub path_normalize_by_string_manipulation ($);
 sub getfilenames($);
 sub noslash($);
 sub dbg($);
+sub version();
 
-help(0) unless (defined $ARGV[0]);
+binmode STDOUT, ':utf8';
-help(1) unless (defined $ARGV[1]);
+binmode STDERR, ':utf8';
 
-help(0) if ($ARGV[0] eq '--help');
+my ($help, $verbose, $noclean, $version);
-help(0) if ($ARGV[0] eq '-h');
+
+GetOptions(
+	"help" => \$help,
+	"verbose" => \$verbose,
+	"noclean" => \$noclean,
+	"version" => \$version
+);
+
+version() if ($version);
+help(0) if ($help);
 
-my $noclean = 0;
 my $DEBUG = 0;
+$DEBUG = 1 if ($verbose);
+$noclean = 1 if ($noclean);
 
-if (defined($ARGV[0]) and $ARGV[0] eq '--noclean') {
+my $BASEURL = $ARGV[0] // '';
-	$noclean = 1;
+my $BASEDIR = $ARGV[1] // '';
-}
 
-my $BASEURL = $ARGV[0];
+help(0) unless ($BASEURL);
-my $BASEDIR = $ARGV[1];
+help(1) unless ($BASEDIR);
-
-if ($noclean == 1) {
-	help(1) unless (defined $ARGV[2]);
-	$BASEURL = $ARGV[1];
-	$BASEDIR = $ARGV[2];
-}
 
+# check if there is trailing slash at the end of url and path
 noslash($BASEURL);
 noslash($BASEDIR);
 
 syswrite STDOUT, sprintf("Cloning %s to %s\n", $BASEURL, $BASEDIR);
-
 my @REPOFILES :shared;
 my @FILES;
 my @LINKS :shared;
@@ -64,55 +69,47 @@ 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');
+	syswrite STDERR, sprintf("An error has occured while reading %s.", $BASEDIR . "repodata/primary.xml.gz\n");
 	exit 1;
 }
 
-my $p1 = new XML::Parser(Style => 'Tree');
+my $package;
-my $ref = $p1->parse($xmldata);
+my $location;
-undef $xmldata;
+my $size;
-my @array = @{ $ref->[1] };
+my %list :shared;
-
+my $p = XML::Parser->new( Style => 'Stream' );
-for (my $i = 0; $i < @array; $i++) {
+$p->setHandlers (
-
+	Start   => sub {
-	if (defined($array[$i]) and ($array[$i] eq 'package')) {
+		my($parseinst, $element, %attributes) = @_;
-		$i++;
+		$package = 1 if ($element eq 'package');
-		my @array2 = @{ $array[$i] };
+		$location = $attributes{href} if ($element eq 'location');
-		my $size = -1;
+		$size = $attributes{package} if ($element eq 'size');
-		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'};
-			}
 
+		if ($package and defined($size) and $location) {
+			$list{$location} = $size;
 		}
+	},
+	Char    => sub {},
+	End     => sub {
+		my($parseinst, $element, %attributes) = @_;
 
-		push @LINKS, $link;
+		if ($element eq 'package') {
-		push @SIZES, $size;
+			$package = undef;
-
+			$location = undef;
-		undef $size;
+			$size = undef;
-		undef $link;
+		}
-		@array2 = -1;
 	}
-}
+);
 
-@array = -1;
+$p->parse($xmldata);
-undef $p1;
+undef $xmldata;
+undef $p;
 
 for (my $i = 1; $i < 4; $i++) {
 	threads->create('mythread');
@@ -128,19 +125,18 @@ do {
 	}
 
 	# list of threads can be polled once per second, it delays consecutive polls by one second
-	sleep(3);
+	sleep(1);
 } while ($tcount > 0);
 
 undef $tcount;
 syswrite STDOUT, "Cloning done.\n";
-exit 0 if ($noclean == 1);
+exit 0 if (defined($noclean));
 
 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;
@@ -153,17 +149,10 @@ foreach my $fileOnDisk (@FILES) {
 	}
 
 	if ($flag == 0) {
-		push @filesToDelete, $fileOnDisk;
+		unless (-d $fileOnDisk) {
-	}
+			dbg("  - Unlinking $fileOnDisk");
-}
+			unlink $fileOnDisk;
-
+		}
-
-while (@filesToDelete > 0) {
-	my $file = pop(@filesToDelete);
-
-	unless (-d $file) {
-		dbg("  - Unlinking $file");
-		unlink $file;
 	}
 }
 
@@ -173,7 +162,7 @@ exit 0;
 sub help($) {
 	my $rc = shift;
 	my $help = <<'HELP';
-Usage: cr.pl [--noclean] http://source/url/ /destination/dir/
+Usage: rrclone.pl [--noclean] http://source/url/ /destination/dir/
 
 Where
 --noclean is optional argument, if it specified, no cleanup operation will
@@ -188,6 +177,11 @@ 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/
+
+Other options:
+--help    - show this message
+--verbose - increases output verbosity
+--version - show version number and quit
 HELP
 
 	syswrite STDOUT, $help;
@@ -199,30 +193,15 @@ sub mythread() {
 		my $size;
 		my $link;
 
-		if ($MUTEX == 0) {
+		if ( 1 ) { # to properly remove lock
-			$MUTEX = 1;
+			lock %list;
-			$size = pop(@SIZES);
+			my @l = keys(%list);
-			$link = pop(@LINKS);
+			last if (@l == 0);
-			$MUTEX = 0;
+			$link = $l[0];
-		} else {
+			$size = delete($list{$link});
-# 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) {
+		dlfunc($link, $size);
-			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;
-			}
-		}
 	}
 }
 
@@ -230,7 +209,7 @@ 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);
+	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);
@@ -274,7 +253,6 @@ sub dlfunc(@) {
 	my $http = HTTP::Tiny->new();
 	$http->mirror($url, $savepath);
 	undef $http;
-
 	undef $savepath;
 	undef $url;
 }
@@ -288,46 +266,37 @@ sub urlencode($) {
 }
 
 sub getmetadata() {
+	my @metafiles;
 	dlfunc('repodata/repomd.xml', -1);
+	my $p = XML::Parser->new( Style => 'Stream' );
+	$p->setHandlers (
+		Start   => sub {
+			my($parseinst, $element, %attributes) = @_;
 
-	my $p1 = new XML::Parser(Style => 'Tree');
+			foreach (keys(%attributes)) {
-	my $ref = $p1->parsefile($BASEDIR . 'repodata/repomd.xml');
+				if ($_ eq 'href') {
-
+					push @metafiles, $attributes{$_};
-	#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'};
-					}
 				}
-
 			}
+		},
+		Char    => sub {},
+		End     => sub {}
+	);
 
-			@array2 = -1;
+	$p->parsefile($BASEDIR . 'repodata/repomd.xml');
-		}
 
+	foreach (@metafiles) {
+		dlfunc($_, -1);
 	}
 
-	@array = -1;
+	foreach (@metafiles) {
-	return $primaryxmlgz;
+		return $_ if ($_ =~ /primary\.xml\.gz$/);
+	}
+
+	die "No primary.xml metadata found.\n";
 }
 
-sub path_normalize_by_string_manipulation ($) {
+sub path_normalize_by_string_manipulation($) {
 	my $path = shift;
 
 	# canonpath does string manipulation, but does not remove "..".
@@ -361,15 +330,16 @@ sub getfilenames($) {
 
 	opendir (DIR, $path) or return "";
 	my @localfiles =
-	map { $path . '/' . $_ }
+		map { $path . '/' . $_ }
-	grep { !/^\.{1,2}$/ }
+		grep { !/^\.{1,2}$/ }
-	readdir (DIR);
+		readdir (DIR);
+
 	@FILES = (@FILES, @localfiles);
 
 	foreach (@localfiles) {
-		next if(-l $_);
+		next if (-l $_);
 
-		if(-d $_){
+		if (-d $_) {
 			getfilenames($_);
 		}
 	}
@@ -390,4 +360,9 @@ sub dbg($) {
 	}
 }
 
-__END__
+sub version() {
+	syswrite STDOUT, "rrclone 1.2\n";
+	exit 0;
+}
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4: