From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Subject: bug#28709: [PATCH 2/4] download: Make 'http-fetch' public. Date: Tue, 17 Oct 2017 10:48:05 +0200 Message-ID: <20171017084807.15901-3-ludo@gnu.org> References: <20171017084807.15901-1-ludo@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:35946) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1e4NYh-0001hL-5q for bug-guix@gnu.org; Tue, 17 Oct 2017 04:49:09 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1e4NYd-0003NK-93 for bug-guix@gnu.org; Tue, 17 Oct 2017 04:49:07 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:36152) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1e4NYd-0003NG-5V for bug-guix@gnu.org; Tue, 17 Oct 2017 04:49:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1e4NYc-0001LM-VA for bug-guix@gnu.org; Tue, 17 Oct 2017 04:49:02 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <20171017084807.15901-1-ludo@gnu.org> List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 28709@debbugs.gnu.org * guix/build/download.scm (http-fetch): Remove 'file' parameter. Change to return an input port and the content-length. Make public. (url-fetch): Adjust accordingly. --- guix/build/download.scm | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index e227ae598..3b89f9412 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -39,6 +39,7 @@ #:use-module (ice-9 format) #:export (open-socket-for-uri open-connection-for-uri + http-fetch %x509-certificate-directory close-connection resolve-uri-reference @@ -745,11 +746,11 @@ Return the resulting target URI." #:query (uri-query ref) #:fragment (uri-fragment ref))))) -(define* (http-fetch uri file #:key timeout (verify-certificate? #t)) - "Fetch data from URI and write it to FILE; when TIMEOUT is true, bail out if -the connection could not be established in less than TIMEOUT seconds. Return -FILE on success. When VERIFY-CERTIFICATE? is true, verify HTTPS -certificates; otherwise simply ignore them." +(define* (http-fetch uri #:key timeout (verify-certificate? #t)) + "Return an input port containing the data at URI, and the expected number of +bytes available or #f. When TIMEOUT is true, bail out if the connection could +not be established in less than TIMEOUT seconds. When VERIFY-CERTIFICATE? is +true, verify HTTPS certificates; otherwise simply ignore them." (define headers `(;; Some web sites, such as http://dist.schmorp.de, would block you if @@ -779,20 +780,10 @@ certificates; otherwise simply ignore them." #:streaming? #t #:headers headers)) ((code) - (response-code resp)) - ((size) - (response-content-length resp))) + (response-code resp))) (case code ((200) ; OK - (begin - (call-with-output-file file - (lambda (p) - (dump-port* port p - #:buffer-size %http-receive-buffer-size - #:reporter (progress-reporter/file - (uri-abbreviation uri) size)) - (newline))) - file)) + (values port (response-content-length resp))) ((301 ; moved permanently 302 ; found (redirection) 303 ; see other @@ -802,7 +793,7 @@ certificates; otherwise simply ignore them." (format #t "following redirection to `~a'...~%" (uri->string uri)) (close connection) - (http-fetch uri file + (http-fetch uri #:timeout timeout #:verify-certificate? verify-certificate?))) (else @@ -873,10 +864,19 @@ otherwise simply ignore them." file (uri->string uri)) (case (uri-scheme uri) ((http https) - (false-if-exception* (http-fetch uri file - #:verify-certificate? - verify-certificate? - #:timeout timeout))) + (false-if-exception* + (let-values (((port size) + (http-fetch uri + #:verify-certificate? verify-certificate? + #:timeout timeout))) + (call-with-output-file file + (lambda (output) + (dump-port* port output + #:buffer-size %http-receive-buffer-size + #:reporter (progress-reporter/file + (uri-abbreviation uri) size)) + (newline))) + #t))) ((ftp) (false-if-exception* (ftp-fetch uri file #:timeout timeout))) -- 2.14.2