Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 82 lines (76 sloc) 2.05 KB
#!/usr/bin/env perl
use 5.010;
use strict;
use warnings;
use LWP::UserAgent;
use File::Path 'make_path', 'remove_tree';
use File::Basename;
use Getopt::Long;
my $destdir = 'ports';
my $list = 'gmpup.lst';
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
sub porturl {
my ($overlay, $port) = @_;
return "http://data.gpo.zugaina.org/$overlay/$port/"
}
sub filelist {
my $url = shift;
my @files;
my $resp = $ua->get($url);
my $html;
unless ($resp->is_success) {
warn "Failed fetching $url, retrying\n";
$resp = $ua->get($url);
unless ($resp->is_success) {
warn $resp->status_line;
return;
}
} else {
$html = $resp->decoded_content;
}
for my $href ($html =~ /href="([^"]+)"/g) {
# skip links to upper directories
# and the zugaina.org specific urls
if (index($url, $href) != -1 or $href =~ /^\?/) {
#say "Skipping $href";
next;
}
# probably a directory
if ($href =~ m[/$]) {
push @files, map { "$href$_" } filelist("$url/$href");
} else {
push @files, $href;
}
}
return @files;
}
sub MAIN {
GetOptions(
"list=s" => \$list,
"destdir=s" => \$destdir,
);
open(my $fh, '<', $list) or die $!;
while (<$fh>) {
my ($overlay, $port) = split /\s+/, $_;
next unless $port ne "";
my $baseurl = porturl($overlay, $port);
my @targets = filelist($baseurl);
my $where = "$destdir/$port";
remove_tree $where;
for (@targets) {
make_path dirname "$where/$_";
my $resp = $ua->mirror("$baseurl/$_", "$where/$_");
unless ($resp->is_success) {
warn "Failed fetching $baseurl/$_, retrying\n";
$resp = $ua->mirror("$baseurl/$_", "$where/$_");
unless ($resp->is_success) {
warn $resp->status_line;
}
}
say "$where/$_";
}
}
close $fh;
}
MAIN();