Hi Florian,
"pelzflorian (Florian Pelz)" <pelzflor...@pelzflorian.de> skribis:
> On Tue, Sep 14, 2021 at 10:38:55AM +0200, Ludovic Courtès wrote:
>> Hi,
>>
>> Maxime Devos <maximede...@telenet.be> skribis:
>>
>> > The Wayback Machine has some copies of software at
>> > https://www.atromatic.net:
>>
>> Thanks, they’re now all in store on berlin.
>>
>> It’s kinda ironic that it’s the Wayback Machine that’s saving us here…
>> I wonder if there’s a way to construct generic web.archive.org URLs that
>> we could use as a fallback in (guix build download)?
>
> AFAIK Just replace the date in
>
> On Mon, Sep 13, 2021 at 03:49:05PM +0200, Maxime Devos wrote:
>> https://web.archive.org/web/20161204140455/https://www.astromatic.net/download/stuff/stuff-1.26.0.tar.gz
>
> by the current time.
Oh nice, that seems to work:
--8<---------------cut here---------------start------------->8---
$ guix download
https://web.archive.org/web/20210911171400/https://www.astromatic.net/download/stuff/stuff-1.26.0.tar.gz
Starting download of /tmp/guix-file.QXTq4V
>From
>https://web.archive.org/web/20210911171400/https://www.astromatic.net/download/stuff/stuff-1.26.0.tar.gz...
following redirection to
`https://web.archive.org/web/20161204140455/http://www.astromatic.net/download/stuff/stuff-1.26.0.tar.gz'...
…6.0.tar.gz
200KiB/s 00:20 | 3.9MiB transferred
/gnu/store/l3r5j8r4f6fh6bxa9va3681n3bclxpdq-stuff-1.26.0.tar.gz
1syibi3b86z9pikhicvkkmgxm916j732fdiw0agw0lq6z13fdcjm
--8<---------------cut here---------------end--------------->8---
How ’bout the attached patch? Works for me.
Thanks,
Ludo’.
diff --git a/guix/build/download.scm b/guix/build/download.scm
index c8ddadfdd4..140e42afec 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -678,6 +678,18 @@ and write the output to FILE."
(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 +781,9 @@ 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
+ (or (and=> (internet-archive-uri (first uri)) list)
+ '()))))
(match uri
((uri tail ...)
(or (fetch uri file)
