95 lines
2.3 KiB
Perl
Executable File
95 lines
2.3 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
BEGIN {
|
|
my ($wd) = $0 =~ m-(.*)/- ;
|
|
$wd ||= '.';
|
|
unshift @INC, "$wd/bs_copy";
|
|
}
|
|
|
|
use lib 'bs_copy';
|
|
use BSUtil;
|
|
use BSRPC ':https';
|
|
use BSXML;
|
|
use BSHTTP;
|
|
use Fcntl qw/:flock/;
|
|
use File::Path qw/make_path/;
|
|
|
|
use strict;
|
|
|
|
my $nodebug;
|
|
|
|
while (@ARGV) {
|
|
if ($ARGV[0] eq '--nodebug') {
|
|
$nodebug = 1;
|
|
} elsif ($ARGV[0] eq '--') {
|
|
shift @ARGV;
|
|
last;
|
|
} elsif ($ARGV[0] =~ /^-/) {
|
|
die("unknown option $ARGV[0]\n");
|
|
} else {
|
|
last;
|
|
}
|
|
shift @ARGV;
|
|
}
|
|
|
|
die("uasge: bs_mirrorfull url dir\n") unless @ARGV == 2;
|
|
my ($url, $dir) = @ARGV;
|
|
$url =~ s/\/$//;
|
|
|
|
unless (-d $dir) {
|
|
make_path($dir);
|
|
}
|
|
|
|
open(my $fh, '>', $dir.'/.lock') or die "failed to open lock file: $!\n";
|
|
unless(flock($fh, LOCK_EX|LOCK_NB)) {
|
|
print "$dir is locked, waiting ...\n";
|
|
flock($fh, LOCK_EX) or die "failed to lock: $!\n";
|
|
print "... lock released\n";
|
|
}
|
|
|
|
#print "receiving tree state\n";
|
|
my $bvl = BSRPC::rpc("$url/_repository", $BSXML::binaryversionlist, "view=binaryversions", "nometa=1");
|
|
my @localbins = grep {/^[0-9a-f]{32}-.+\.rpm$/} ls($dir);
|
|
my %localbins = map {$_ => 1} @localbins;
|
|
my %remotebins;
|
|
for my $bv (@{$bvl->{'binary'} || []}) {
|
|
next unless $bv->{'name'} =~ /\.rpm$/;
|
|
next if $nodebug && $bv->{'name'} =~ /-debug(?:info|source|info-32bit)\.rpm$/;
|
|
$remotebins{"$bv->{'hdrmd5'}-$bv->{'name'}"} = $bv;
|
|
}
|
|
my @todelete = grep {!$remotebins{$_}} sort keys %localbins;
|
|
my @todownload = grep {!$localbins{$_}} sort keys %remotebins;
|
|
if (@todelete) {
|
|
print "deleting ".@todelete." old packages\n";
|
|
for my $bin (@todelete) {
|
|
unlink("$dir/$bin") || die("unlink: $!\n");
|
|
}
|
|
}
|
|
if (@todownload) {
|
|
print "downloading ".@todownload." new packages\n";
|
|
my $todo = @todownload;
|
|
my $did = 0;
|
|
while (@todownload) {
|
|
my @fetch = splice(@todownload, 0, 50);
|
|
my @args;
|
|
for (@fetch) {
|
|
die unless /^[0-9a-f]{32}-(.+)\.rpm$/;
|
|
push @args, "binary=$1";
|
|
}
|
|
my $param = {
|
|
'uri' => "$url/_repository",
|
|
'directory' => $dir,
|
|
'map' => sub {
|
|
my ($param, $name) = @_;
|
|
return undef unless $name =~ /^(.+)-([0-9a-f]{32})$/;
|
|
return "$2-$1.rpm";
|
|
},
|
|
'receiver' => \&BSHTTP::cpio_receiver,
|
|
};
|
|
BSRPC::rpc($param, undef, 'view=cpioheaders', @args);
|
|
$did += @fetch;
|
|
#print "$did/$todo\n";
|
|
}
|
|
}
|
|
#print "done, we now have ".(keys %remotebins)." packages.\n";
|