summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Jackson <ijackson@chiark.greenend.org.uk>2019-07-23 16:35:01 +0100
committerIan Jackson <ijackson@chiark.greenend.org.uk>2019-07-23 16:36:05 +0100
commitf3405131b5bab67ec0757eeeb2c0b7f532c9e05e (patch)
tree33e4d9044a64c1012cb0f3dbda4be74b99920695
parenta1ecf6c5a6d87ed85f89a63c8ed2c591f496a3c4 (diff)
dgit: Use WWW::Curl rather than invoking curl(1) for archive api
Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
-rw-r--r--debian/control2
-rwxr-xr-xdgit42
2 files changed, 28 insertions, 16 deletions
diff --git a/debian/control b/debian/control
index 3395984..6fa937b 100644
--- a/debian/control
+++ b/debian/control
@@ -15,7 +15,7 @@ Depends: perl, libwww-perl, libdpkg-perl, git-core, devscripts, dpkg-dev,
coreutils (>= 8.23-1~),
libdigest-sha-perl, dput, curl, apt,
libjson-perl, ca-certificates,
- libtext-iconv-perl, libtext-glob-perl
+ libtext-iconv-perl, libtext-glob-perl, libwww-curl-perl
Recommends: ssh-client
Suggests: sbuild | pbuilder | cowbuilder
Architecture: all
diff --git a/dgit b/dgit
index 00f86c6..4a5cae1 100755
--- a/dgit
+++ b/dgit
@@ -1192,10 +1192,23 @@ sub cfg_apply_map ($$$) {
#---------- `ftpmasterapi' archive query method (nascent) ----------
-sub archive_api_query_cmd ($) {
- my ($subpath) = @_;
- my @cmd = (@curl, qw(-sS));
- my $url = access_cfg('archive-query-url');
+sub archive_api_query_curl ($) {
+ my ($url) = @_;
+
+ use WWW::Curl::Easy;
+
+ my $curl = WWW::Curl::Easy->new;
+ my $setopt = sub {
+ my ($k,$v) = @_;
+ my $x = $curl->setopt($k, $v);
+ confess "$k $v ".$curl->strerror($x)." ?" if $x;
+ };
+
+ my $response_body;
+ $setopt->(CURLOPT_REDIR_PROTOCOLS, CURLPROTO_HTTPS|CURLPROTO_HTTP);
+ $setopt->(CURLOPT_URL, $url);
+ $setopt->(CURLOPT_WRITEDATA, \$response_body);
+
if ($url =~ m#^https://([-.0-9a-z]+)/#) {
foreach my $k (qw(archive-query-tls-key
archive-query-tls-curl-ca-args)) {
@@ -1203,21 +1216,20 @@ sub archive_api_query_cmd ($) {
if defined access_cfg($k, 'RETURN-UNDEF');
}
}
- push @cmd, $url.$subpath;
- return @cmd;
+
+ my $x = $curl->perform();
+ fail f_ "fetch of %s failed (%s): %s",
+ $url, $curl->strerror($x), $curl->errbuf
+ if $x;
+
+ return $curl->getinfo(CURLINFO_HTTP_CODE), $response_body;
}
sub api_query_raw ($;$) {
my ($subpath, $ok404) = @_;
- my @cmd = archive_api_query_cmd($subpath);
- my $url = $cmd[$#cmd];
- push @cmd, qw(-w %{http_code});
- my $json = cmdoutput @cmd;
- unless ($json =~ s/\d+\d+\d$//) {
- failedcmd_report_cmd undef, @cmd;
- fail __ "curl failed to print 3-digit HTTP code";
- }
- my $code = $&;
+ my $url = access_cfg('archive-query-url');
+ $url .= $subpath;
+ my ($code,$json) = archive_api_query_curl($url);
return undef if $code eq '404' && $ok404;
fail f_ "fetch of %s gave HTTP code %s", $url, $code
unless $url =~ m#^file://# or $code =~ m/^2/;