From 1c9e7d65d4ca8674e674b339740f575f8edb5db2 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 25 Apr 2013 22:06:48 +0200
Subject: web: Factorize `http-get' hackery.

This should fix `substitute-binary --query' on Guile 2.0.5.

* guix/web.scm: New file.
* Makefile.am (MODULES): Add it.
* po/POTFILES.in: Add it.
* guix/gnu-maintenance.scm (http-fetch): Remove.
  (%package-list-url): Turn into a URI.
  (official-gnu-packages): Add #:text? #t to `http-fetch' call.
* guix/scripts/substitute-binary.scm (fetch): Remove `http' case, and
  use `http-fetch' instead.
---
 guix/scripts/substitute-binary.scm | 26 ++------------------------
 1 file changed, 2 insertions(+), 24 deletions(-)

(limited to 'guix/scripts')

diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 7e059be596..87561db4b3 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -35,8 +35,7 @@ (define-module (guix scripts substitute-binary)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (web uri)
-  #:use-module (web client)
-  #:use-module (web response)
+  #:use-module (guix web)
   #:export (guix-substitute-binary))
 
 ;;; Comment:
@@ -128,28 +127,7 @@ (define (fetch uri)
      (let ((port (open-input-file (uri-path uri))))
        (values port (stat:size (stat port)))))
     ((http)
-     (let*-values (((resp port)
-                    ;; XXX: `http-get*' was introduced in 2.0.7, and deprecated
-                    ;; in 2.0.8 (!).  Assume it is available here.
-                    (if (version>? "2.0.7" (version))
-                        (http-get* uri #:decode-body? #f)
-                        (http-get uri #:streaming? #t)))
-                   ((code)
-                    (response-code resp))
-                   ((size)
-                    (response-content-length resp)))
-       (case code
-         ((200)                                   ; OK
-          (values port size))
-         ((301                                    ; moved permanently
-           302)                                   ; found (redirection)
-          (let ((uri (response-location resp)))
-            (format #t "following redirection to `~a'...~%"
-                    (uri->string uri))
-            (fetch uri)))
-         (else
-          (error "download failed" (uri->string uri)
-                 code (response-reason-phrase resp))))))))
+     (http-fetch uri #:text? #f))))
 
 (define-record-type <cache>
   (%make-cache url store-directory wants-mass-query?)
-- 
cgit v1.2.3