diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-11-15 14:08:44 +0100 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-11-15 14:08:44 +0100 |
commit | 6ce44b07152de1873aa40ccf0e7ad39c6412377f (patch) | |
tree | 4bbd2b2ba0e4766a0a3695f69f23a0b5485e8387 | |
parent | e3fea0b091ce7b251b16eed48ece3dd9b36a32d9 (diff) | |
download | slackbuilder-6ce44b07152de1873aa40ccf0e7ad39c6412377f.tar.gz slackbuilder-6ce44b07152de1873aa40ccf0e7ad39c6412377f.tar.bz2 |
Treat archive parameter as an URI
-rw-r--r-- | slackbuilder.pl | 142 |
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); |