me/guix
Archived
1
0
Fork 0
Code Activity

download: Export 'maybe-expand-mirrors'.

Browse source 
* guix/build/download.scm (uri-vicinity, maybe-expand-mirrors): New
  procedures.
  (url-fetch): Remove them from here.
This commit is contained in:
Ludovic Courtès 2014-12-29 20:51:12 +01:00
parent 4fbf4ca552
commit dd8ea244f4
1 changed files with 24 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/build/download.scm
View file

@ -29,6 +29,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (open-connection-for-uri #:export (open-connection-for-uri
maybe-expand-mirrors
url-fetch url-fetch
progress-proc progress-proc
uri-abbreviation)) uri-abbreviation))
@ -279,17 +280,15 @@ which is not available during bootstrap."
(lambda (key . args) (lambda (key . args)
(print-exception (current-error-port) #f key args)))) (print-exception (current-error-port) #f key args))))
(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) (define (uri-vicinity dir file)
;; Concatenate DIR, slash, and FILE, keeping only one slash in between. "Concatenate DIR, slash, and FILE, keeping only one slash in between.
;; This is required by some HTTP servers. This is required by some HTTP servers."
(string-append (string-trim-right dir #\/) "/" (string-append (string-trim-right dir #\/) "/"
(string-trim file #\/))) (string-trim file #\/)))
(define (maybe-expand-mirrors uri) (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) (case (uri-scheme uri)
((mirror) ((mirror)
(let ((kind (string->symbol (uri-host uri))) (let ((kind (string->symbol (uri-host uri)))
@ -303,8 +302,12 @@ on success."
(else (else
(list uri)))) (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 (define uri
(append-map maybe-expand-mirrors (append-map (cut maybe-expand-mirrors <> mirrors)
(match url (match url
((_ ...) (map string->uri url)) ((_ ...) (map string->uri url))
(_ (list (string->uri url)))))) (_ (list (string->uri url))))))