eleksir/rrclone
1
Fork 0
Code Activity

move to stream xml parsing to save memory

Browse Source
This commit is contained in:
eleksir
2019-12-25 15:50:19 +03:00
parent 7a5df1a97b
commit f07d301441
1 changed files with 77 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

187
rrclone
View File

@@ -1,6 +1,5 @@
#!/usr/bin/perl #!/usr/bin/perl
# simple RPM Repository cloning script #
use strict; use strict;
use warnings "all"; use warnings "all";
use Fcntl; use Fcntl;
@@ -16,18 +15,22 @@ use Data::Dumper;
use HTTP::Tiny; use HTTP::Tiny;
use IO::Socket::SSL; # implicit requirement in order to HTTP::Tiny work with https use IO::Socket::SSL; # implicit requirement in order to HTTP::Tiny work with https
use Getopt::Long; use Getopt::Long;
use utf8;
sub mythread(); sub mythread();
sub dlfunc(@); sub dlfunc(@);
sub urlencode($); sub urlencode($);
sub getmetadata(); sub getmetadata();
sub help($); sub help($);
sub path_normalize_by_string_manipulation($); sub path_normalize_by_string_manipulation ($);
sub getfilenames($); sub getfilenames($);
sub noslash($); sub noslash($);
sub dbg($); sub dbg($);
sub version(); sub version();
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';
my ($help, $verbose, $noclean, $version); my ($help, $verbose, $noclean, $version);
GetOptions( GetOptions(
@@ -55,7 +58,6 @@ noslash($BASEURL);
noslash($BASEDIR); noslash($BASEDIR);
syswrite STDOUT, sprintf("Cloning %s to %s\n", $BASEURL, $BASEDIR); syswrite STDOUT, sprintf("Cloning %s to %s\n", $BASEURL, $BASEDIR);
my @REPOFILES :shared; my @REPOFILES :shared;
my @FILES; my @FILES;
my @LINKS :shared; my @LINKS :shared;
@@ -67,55 +69,47 @@ my $fh = new IO::Zlib;
my $xmldata = ''; my $xmldata = '';
if ($fh->open($BASEDIR . $primaryxmlgz, "rb")) { if ($fh->open($BASEDIR . $primaryxmlgz, "rb")) {
while (<$fh>) { while (<$fh>) {
$xmldata .= $_; $xmldata .= $_;
} }
$fh->close; $fh->close;
} else { } 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; exit 1;
} }
my $p1 = new XML::Parser(Style => 'Tree'); my $package;
my $ref = $p1->parse($xmldata); my $location;
my $size;
my %list :shared;
my $p = XML::Parser->new( Style => 'Stream' );
$p->setHandlers (
Start => sub {
my($parseinst, $element, %attributes) = @_;
$package = 1 if ($element eq 'package');
$location = $attributes{href} if ($element eq 'location');
$size = $attributes{package} if ($element eq 'size');
if ($package and defined($size) and $location) {
$list{$location} = $size;
}
},
Char => sub {},
End => sub {
my($parseinst, $element, %attributes) = @_;
if ($element eq 'package') {
$package = undef;
$location = undef;
$size = undef;
}
}
);
$p->parse($xmldata);
undef $xmldata; undef $xmldata;
my @array = @{ $ref->[1] }; undef $p;
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++) { for (my $i = 1; $i < 4; $i++) {
threads->create('mythread'); threads->create('mythread');
@@ -131,19 +125,18 @@ do {
} }
# list of threads can be polled once per second, it delays consecutive polls by one second # list of threads can be polled once per second, it delays consecutive polls by one second
sleep(3); sleep(1);
} while ($tcount > 0); } while ($tcount > 0);
undef $tcount; undef $tcount;
syswrite STDOUT, "Cloning done.\n"; 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); syswrite STDOUT, sprintf("Cleaning old files in %s\n", $BASEDIR);
my $searchpath = $BASEDIR; my $searchpath = $BASEDIR;
chop $searchpath; chop $searchpath;
getfilenames($searchpath); getfilenames($searchpath);
my @filesToDelete;
foreach my $fileOnDisk (@FILES) { foreach my $fileOnDisk (@FILES) {
my $flag = 0; my $flag = 0;
@@ -156,17 +149,10 @@ foreach my $fileOnDisk (@FILES) {
} }
if ($flag == 0) { 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;
} }
} }
@@ -207,38 +193,23 @@ sub mythread() {
my $size; my $size;
my $link; 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) {
if ((defined($size)) and (defined($link))) {
dlfunc($link, $size); dlfunc($link, $size);
} }
} else {
# handle last package in list
if ((defined($size)) and (defined($link))) {
dlfunc($link, $size);
} else {
last;
}
}
}
} }
sub dlfunc(@) { sub dlfunc(@) {
my $url = shift; # short (relative) URL without BASE part my $url = shift; # short (relative) URL without BASE part
my $size = shift; my $size = shift;
my $wgetpath; 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) { 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); syswrite STDERR, sprintf("Skipping package %s, because it out of destdir %s, looks like quirky metadata.\n", $savepath, $BASEDIR);
@@ -282,7 +253,6 @@ sub dlfunc(@) {
my $http = HTTP::Tiny->new(); my $http = HTTP::Tiny->new();
$http->mirror($url, $savepath); $http->mirror($url, $savepath);
undef $http; undef $http;
undef $savepath; undef $savepath;
undef $url; undef $url;
} }
@@ -296,46 +266,37 @@ sub urlencode($) {
} }
sub getmetadata() { sub getmetadata() {
my @metafiles;
dlfunc('repodata/repomd.xml', -1); 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 {}
);
$p->parsefile($BASEDIR . 'repodata/repomd.xml');
foreach (@metafiles) {
dlfunc($_, -1);
} }
@array2 = -1; foreach (@metafiles) {
return $_ if ($_ =~ /primary\.xml\.gz$/);
} }
} die "No primary.xml metadata found.\n";
@array = -1;
return $primaryxmlgz;
} }
sub path_normalize_by_string_manipulation ($) { sub path_normalize_by_string_manipulation($) {
my $path = shift; my $path = shift;
# canonpath does string manipulation, but does not remove "..". # canonpath does string manipulation, but does not remove "..".
@@ -372,12 +333,13 @@ sub getfilenames($) {
map { $path . '/' . $_ } map { $path . '/' . $_ }
grep { !/^\.{1,2}$/ } grep { !/^\.{1,2}$/ }
readdir (DIR); readdir (DIR);
@FILES = (@FILES, @localfiles); @FILES = (@FILES, @localfiles);
foreach (@localfiles) { foreach (@localfiles) {
next if(-l $_); next if (-l $_);
if(-d $_){ if (-d $_) {
getfilenames($_); getfilenames($_);
} }
} }
@@ -399,7 +361,8 @@ sub dbg($) {
} }
sub version() { sub version() {
syswrite STDOUT, "rrclone 1.1\n"; syswrite STDOUT, "rrclone 1.2\n";
exit 0; exit 0;
} }
__END__
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: