diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2021-10-12 16:50:47 +0000 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2021-10-12 17:46:23 +0000 |
commit | a1eca979fb8da842e73c42f4f53be29b169810f2 (patch) | |
tree | 681c7283e412bb8a29c2531c4408b49c3e184764 /guix/build/download.scm | |
parent | 48d86a9ec6d8d2e97da2299ea41a03ef4cdaab83 (diff) | |
parent | 371aa5777a3805a3886f3feea5f1960fe3fe4219 (diff) | |
download | guix-patches-a1eca979fb8da842e73c42f4f53be29b169810f2.tar guix-patches-a1eca979fb8da842e73c42f4f53be29b169810f2.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates-frozen.
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) |