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/gnu-maintenance.scm | 45 ++++++---------------------------------------
 1 file changed, 6 insertions(+), 39 deletions(-)

(limited to 'guix/gnu-maintenance.scm')

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 36aad7a987..4c7241fc88 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -28,6 +28,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (system foreign)
+  #:use-module (guix web)
   #:use-module (guix ftp-client)
   #:use-module (guix ui)
   #:use-module (guix utils)
@@ -73,45 +74,11 @@
 ;;; List of GNU packages.
 ;;;
 
-(define (http-fetch uri)
-  "Return an input port containing the textual data at URI, a string."
-  (let*-values (((resp data)
-                 (let ((uri (string->uri uri)))
-                   ;; Try hard to use the API du jour to get an input port.
-                   (if (version>? "2.0.7" (version))
-                       (if (defined? 'http-get*)
-                           (http-get* uri)
-                           (http-get uri))       ; old Guile, returns a string
-                       (http-get uri #:streaming? #t)))) ; 2.0.8 or later
-               ((code)
-                (response-code resp)))
-    (case code
-      ((200)
-       (cond ((not data)
-              (begin
-                ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer
-                ;; encoding, which is required when fetching %PACKAGE-LIST-URL
-                ;; (see <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
-                ;; Since users may still be using these versions, warn them and
-                ;; bail out.
-                (warning (_ "using Guile ~a, ~a ~s encoding~%")
-                         (version)
-                         "which does not support HTTP"
-                         (response-transfer-encoding resp))
-                (leave (_ "download failed; use a newer Guile~%")
-                       uri resp)))
-             ((string? data)                 ; old `http-get' returns a string
-              (open-input-string data))
-             (else                           ; input port
-              data)))
-      (else
-       (error "download failed" uri code
-              (response-reason-phrase resp))))))
-
 (define %package-list-url
-  (string-append "http://cvs.savannah.gnu.org/"
-                 "viewvc/*checkout*/gnumaint/"
-                 "gnupackages.txt?root=womb"))
+  (string->uri
+   (string-append "http://cvs.savannah.gnu.org/"
+                  "viewvc/*checkout*/gnumaint/"
+                  "gnupackages.txt?root=womb")))
 
 (define-record-type* <gnu-package-descriptor>
   gnu-package-descriptor
@@ -197,7 +164,7 @@
                                "savannah" "fsd" "language" "logo"
                                "doc-category" "doc-summary" "doc-urls"
                                "download-url")))
-        (group-package-fields (http-fetch %package-list-url)
+        (group-package-fields (http-fetch %package-list-url #:text? #t)
                               '(())))))
 
 (define (find-packages regexp)
-- 
cgit v1.2.3