From f3405131b5bab67ec0757eeeb2c0b7f532c9e05e Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Tue, 23 Jul 2019 16:35:01 +0100
Subject: dgit: Use WWW::Curl rather than invoking curl(1) for archive api

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 debian/control |  2 +-
 dgit           | 42 +++++++++++++++++++++++++++---------------
 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/;
-- 
cgit v1.2.3