diff options
Diffstat (limited to 'dgit')
-rwxr-xr-x | dgit | 42 |
1 files changed, 27 insertions, 15 deletions
@@ -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/; |