51 lines
2.1 KiB
Scheme
51 lines
2.1 KiB
Scheme
|
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
||
|
|
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
|
||
|
|
|
||
|
|
(define-module (nonguix download)
|
||
|
|
#:use-module (guix derivations)
|
||
|
|
#:use-module (guix monads)
|
||
|
|
#:use-module (guix packages)
|
||
|
|
#:use-module (guix store)
|
||
|
|
#:use-module (ice-9 match)
|
||
|
|
#:export (unredistributable-url-fetch))
|
||
|
|
|
||
|
|
(define* (unredistributable-url-fetch url hash-algo hash
|
||
|
|
#:optional name
|
||
|
|
#:key (system (%current-system))
|
||
|
|
(guile (default-guile)))
|
||
|
|
"Return a fixed-output derivation that fetches URL (a string) which is expected
|
||
|
|
to have HASH of type HASH-ALGO (a symbol). By default, the file name is the base
|
||
|
|
name of URL; optionally, NAME can specify a different file name.
|
||
|
|
|
||
|
|
This is a simpler version of url-fetch from Guix, that doesn't support mirror://
|
||
|
|
or file:// uris. It is specifically designed to prevent substitution of the
|
||
|
|
source, for the purpose of downloading copyrighted content you have access to,
|
||
|
|
but you don't have the right to redistribute. By marking the derivation as non
|
||
|
|
substitutable, this fetch prevents you from giving others access to the source
|
||
|
|
if you run a substitute server on your machine."
|
||
|
|
(define file-name
|
||
|
|
(match url
|
||
|
|
((head _ ...)
|
||
|
|
(basename head))
|
||
|
|
(_
|
||
|
|
(basename url))))
|
||
|
|
|
||
|
|
(mlet %store-monad ()
|
||
|
|
(raw-derivation (or name file-name) "builtin:download" '()
|
||
|
|
#:system system
|
||
|
|
#:hash-algo hash-algo
|
||
|
|
#:hash hash
|
||
|
|
|
||
|
|
;; Honor the user's proxy and locale settings.
|
||
|
|
#:leaked-env-vars '("http_proxy" "https_proxy"
|
||
|
|
"LC_ALL" "LC_MESSAGES" "LANG"
|
||
|
|
"COLUMNS")
|
||
|
|
#:env-vars `(("url" . ,(object->string url)))
|
||
|
|
|
||
|
|
;; Do not offload because the remote daemon may not support
|
||
|
|
;; the 'download' builtin.
|
||
|
|
#:local-build? #t
|
||
|
|
|
||
|
|
;; Do not substitute copyrighted material
|
||
|
|
#:substitutable? #f)))
|