[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/05: download: Export 'maybe-expand-mirrors'.
From: |
Ludovic Courtès |
Subject: |
04/05: download: Export 'maybe-expand-mirrors'. |
Date: |
Mon, 29 Dec 2014 20:24:10 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit dd8ea244f4e6cb2c9cb0e926e1303bf4d7b113ae
Author: Ludovic Courtès <address@hidden>
Date: Mon Dec 29 20:51:12 2014 +0100
download: Export 'maybe-expand-mirrors'.
* guix/build/download.scm (uri-vicinity, maybe-expand-mirrors): New
procedures.
(url-fetch): Remove them from here.
---
guix/build/download.scm | 45 ++++++++++++++++++++++++---------------------
1 files changed, 24 insertions(+), 21 deletions(-)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index bb7e460..5928ccd 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -29,6 +29,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (open-connection-for-uri
+ maybe-expand-mirrors
url-fetch
progress-proc
uri-abbreviation))
@@ -279,32 +280,34 @@ which is not available during bootstrap."
(lambda (key . args)
(print-exception (current-error-port) #f key args))))
+(define (uri-vicinity dir file)
+ "Concatenate DIR, slash, and FILE, keeping only one slash in between.
+This is required by some HTTP servers."
+ (string-append (string-trim-right dir #\/) "/"
+ (string-trim file #\/)))
+
+(define (maybe-expand-mirrors uri mirrors)
+ "If URI uses the 'mirror' scheme, expand it according to the MIRRORS alist.
+Return a list of URIs."
+ (case (uri-scheme uri)
+ ((mirror)
+ (let ((kind (string->symbol (uri-host uri)))
+ (path (uri-path uri)))
+ (match (assoc-ref mirrors kind)
+ ((mirrors ..1)
+ (map (compose string->uri (cut uri-vicinity <> path))
+ mirrors))
+ (_
+ (error "unsupported URL mirror kind" kind uri)))))
+ (else
+ (list uri))))
+
(define* (url-fetch url file #:key (mirrors '()))
"Fetch FILE from URL; URL may be either a single string, or a list of
string denoting alternate URLs for FILE. Return #f on failure, and FILE
on success."
- (define (uri-vicinity dir file)
- ;; Concatenate DIR, slash, and FILE, keeping only one slash in between.
- ;; This is required by some HTTP servers.
- (string-append (string-trim-right dir #\/) "/"
- (string-trim file #\/)))
-
- (define (maybe-expand-mirrors uri)
- (case (uri-scheme uri)
- ((mirror)
- (let ((kind (string->symbol (uri-host uri)))
- (path (uri-path uri)))
- (match (assoc-ref mirrors kind)
- ((mirrors ..1)
- (map (compose string->uri (cut uri-vicinity <> path))
- mirrors))
- (_
- (error "unsupported URL mirror kind" kind uri)))))
- (else
- (list uri))))
-
(define uri
- (append-map maybe-expand-mirrors
+ (append-map (cut maybe-expand-mirrors <> mirrors)
(match url
((_ ...) (map string->uri url))
(_ (list (string->uri url))))))