diff options
Diffstat (limited to 'guix/build/download.scm')
| -rw-r--r-- | guix/build/download.scm | 22 |
1 files changed, 20 insertions, 2 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm index c8ddadfdd4..fd8fe69901 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -674,10 +674,23 @@ and write the output to FILE." (match (fetch-specification uris) (#f (format #t "could not find its Disarchive specification~%") #f) - (spec (parameterize ((%disarchive-log-port (current-output-port))) + (spec (parameterize ((%disarchive-log-port (current-output-port)) + (%verify-swh-certificate? verify-certificate?)) (false-if-exception* (disarchive-assemble spec file #:resolver resolve)))))))) +(define (internet-archive-uri uri) + "Return a URI corresponding to an Internet Archive backup of URI, or #f if +URI does not denote a Web URI." + (and (memq (uri-scheme uri) '(http https)) + (let* ((now (time-utc->date (current-time time-utc))) + (date (date->string now "~Y~m~d~H~M~S"))) + ;; Note: the date in the URL can be anything and web.archive.org + ;; automatically redirects to the closest date. + (build-uri 'https #:host "web.archive.org" + #:path (string-append "/web/" date "/" + (uri->string uri)))))) + (define* (url-fetch url file #:key (timeout 10) (verify-certificate? #t) @@ -769,7 +782,12 @@ otherwise simply ignore them." (setvbuf (current-error-port) 'line) - (let try ((uri (append uri content-addressed-uris))) + (let try ((uri (append uri content-addressed-uris + (match uri + ((first . _) + (or (and=> (internet-archive-uri first) list) + '())) + (() '()))))) (match uri ((uri tail ...) (or (fetch uri file) |