summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-11-15 14:08:44 +0100
committerSergey Poznyakoff <gray@gnu.org.ua>2017-11-15 14:08:44 +0100
commit6ce44b07152de1873aa40ccf0e7ad39c6412377f (patch)
tree4bbd2b2ba0e4766a0a3695f69f23a0b5485e8387
parente3fea0b091ce7b251b16eed48ece3dd9b36a32d9 (diff)
downloadslackbuilder-6ce44b07152de1873aa40ccf0e7ad39c6412377f.tar.gz
slackbuilder-6ce44b07152de1873aa40ccf0e7ad39c6412377f.tar.bz2
Treat archive parameter as an URI
-rw-r--r--slackbuilder.pl142
1 files changed, 86 insertions, 56 deletions
diff --git a/slackbuilder.pl b/slackbuilder.pl
index 6316b07..965ef88 100644
--- a/slackbuilder.pl
+++ b/slackbuilder.pl
@@ -3,6 +3,8 @@ use warnings;
use JSON;
use LWP::UserAgent;
use LWP::Protocol::https;
+use LWP::Protocol::file;
+use LWP::Protocol::ftp;
use Data::Dumper;
use Pod::Usage;
use Pod::Man;
@@ -12,6 +14,7 @@ use File::Temp qw/ tempfile tempdir /;
use File::Copy;
use POSIX::Run::Capture qw(:all);
use POSIX qw(:sys_wait_h strerror);
+use URI;
use constant {
EX_OK => 0,
@@ -89,8 +92,8 @@ sub readfile {
my %kws = (
package => { mandatory => 1 },
version => { mandatory => 1 },
- archive => { mandatory => 1 },
- url => { mandatory => 1, check => \&check_url },
+ archive => { mandatory => 1, check => \&check_slackbuild_url },
+ url => { mandatory => 1, check => \&check_source_url },
prereq => {
mandatory => 0,
check => sub {
@@ -131,7 +134,8 @@ sub check_json {
exit(EX_FAIL);
}
}
-
+
+
sub run_tar {
my $obj = new POSIX::Run::Capture(argv => [ 'tar', @_ ],
timeout => 10);
@@ -191,73 +195,69 @@ sub run_build {
}
}
-sub download_file {
- my $json = shift;
- my $src = $json->{workspace}{url_base};
- my $fname = basename($src);
- my $dst = $json->{workspace}{dir} . '/' . $fname;
- print "copying\n";
- copy($src, $dst)
- or abend(EX_FAIL, "can't copy $src to $dst: $!");
-}
-
sub source_archive_name {
my $json = shift;
my $dst;
if (exists($json->{source_archive})) {
$dst = $json->{source_archive};
} else {
- $dst = $json->{workspace}{url_base};
+ $dst = $json->{workspace}{source_uri}->path;
$dst =~ s{^.*/}{};
}
return $json->{workspace}{dir} . '/' . $dst;
}
-sub download_remote {
+sub slackbuild_name {
my $json = shift;
-
+ my $dst;
+ if (exists($json->{slackbuild_archive})) {
+ $dst = $json->{slackbuild_archive};
+ } else {
+ my (undef,undef,$suffix) =
+ fileparse($json->{workspace}{slackbuild_uri}->path,
+ '.tar', '.tar.gz', '.tar.xz');
+ $dst = $json->{package} . ($suffix||'');
+ }
+ return $json->{workspace}{dir} . '/' . $dst;
+}
+
+sub download {
+ my ($uri, $dst) = @_;
+
my $ua = LWP::UserAgent->new();
- my $response = $ua->get($json->{url},
- ':content_file' => source_archive_name($json));
+
+ print "downloading $uri to $dst\n";
+ my $response = $ua->get($uri->as_string, ':content_file' => $dst);
if (!$response->is_success) {
abend(EX_FAIL,
- "downloading $json->{url} failed: ".$response->status_line);
+ "downloading $uri failed: ".$response->status_line);
}
}
-my %dltab = (
- file => \&download_file,
- http => \&download_remote,
- https => \&download_remote,
- ftp => \&download_remote
-);
-
-sub check_url {
+sub check_source_url {
my ($json, $key, $err) = @_;
- my $url = $json->{$key};
-
- if ($url =~ m{^([^:/]+?)://(.+)}) {
- unless (exists($dltab{$1})) {
- push @$err, "unsupported download scheme";
- return 0;
- }
- $json->{workspace}{scheme} = $1;
- $json->{workspace}{url_base} = $2;
- return 1;
- } else {
- push @$err, "invalid URL";
- return 0;
- }
+ my $uri = new URI($json->{$key});
+ $uri->scheme('file') unless $uri->scheme;
+ # unless (exists($dltab{$uri->scheme})) {
+ # push @$err, $uri->as_string . ": unsupported download scheme";
+ # return 0;
+ # }
+ $json->{workspace}{source_uri} = $uri;
+ return 1;
}
-sub download {
- my $json = shift;
- my $url = $json->{url};
-
- print "downloading $url\n";
- &{$dltab{$json->{workspace}{scheme}}}($json);
-}
+sub check_slackbuild_url {
+ my ($json, $key, $err) = @_;
+ my $uri = new URI($json->{$key});
+ $uri->scheme('file') unless $uri->scheme;
+ # unless (exists($dltab{$uri->scheme})) {
+ # push @$err, $uri->as_string . ": unsupported download scheme";
+ # return 0;
+ # }
+ $json->{workspace}{slackbuild_uri} = $uri;
+ return 1;
+}
sub has_file {
my ($json, $file) = @_;
@@ -266,8 +266,10 @@ sub has_file {
sub check_archive {
my $json = shift;
- my $obj = run_tar('-t', '-f', $json->{archive});
- my $err;
+ my $obj = run_tar('-t', '-f', slackbuild_name($json));
+ my $err;
+ my $rx = qr($json->{package});
+ my $prefix;
while (my $s = $obj->next_line(SD_STDOUT)) {
chomp($s);
$s =~ s{^\./}{};
@@ -275,6 +277,26 @@ sub check_archive {
error("bad file: $s");
$err = 1;
}
+ if ($s =~ s{^$rx/}{}) {
+ if (defined($prefix)) {
+ if (!$prefix) {
+ error("bad file: $s");
+ $err = 1;
+ }
+ } else {
+ $prefix = 1;
+ }
+ } else {
+ if (defined($prefix)) {
+ if ($prefix) {
+ error("bad file: $s");
+ $err = 1;
+ }
+ } else {
+ $prefix = 0;
+ }
+ }
+
push @{$json->{workspace}{files}}, $s;
}
exit(EX_FAIL) if $err;
@@ -282,19 +304,24 @@ sub check_archive {
abend(EX_FAIL, "no ". $json->{workspace}{slackbuild} . " in archive")
unless has_file($json, $json->{workspace}{slackbuild});
abend(EX_FAIL, "no slack-desc in archive")
- unless has_file($json, 'slack-desc')
+ unless has_file($json, 'slack-desc');
+ return $prefix;
}
sub makedir {
my $json = shift;
- check_archive($json);
-
my $dir = tempdir(DIR => $spooldir, CLEANUP => 1);
+ $json->{workspace}{dir} = $dir;
+ download($json->{workspace}{slackbuild_uri},
+ slackbuild_name($json));
+
+ my $prefix = check_archive($json);
+
my $obj = run_tar('-C', $dir,
+ '--strip', $prefix,
'-x',
'-f',
- $json->{archive});
- $json->{workspace}{dir} = $dir;
+ slackbuild_name($json));
}
@@ -318,6 +345,9 @@ my $json = decode_json($text);
check_json($json);
makedir($json);
-download($json);
+
+download($json->{workspace}{source_uri},
+ source_archive_name($json));
+
# FIXME: Prerequisites
run_build($json);

Return to:

Send suggestions and report system problems to the System administrator.