* [bug#46800] [PATCH] Allow defining multiple substituters
@ 2021-02-26 17:41 Maxime Devos
2021-03-02 20:37 ` Ludovic Courtès
2021-06-06 17:52 ` Tony Olagbaiye
0 siblings, 2 replies; 6+ messages in thread
From: Maxime Devos @ 2021-02-26 17:41 UTC (permalink / raw)
To: 46800; +Cc: Ludovic Courtès
[-- Attachment #1.1: Type: text/plain, Size: 428 bytes --]
Hi Guix,
This patch series is my suggestion for allowing
multiple "substitution methods" or "substituters"
as I call them. Currently, only a method for HTTP/S
is defined, though I hope it will be a good basis
for a common framework for substitutes over GNUnet
and IPFS.
Extending "guix-service-type" to allow configuration
of substitution method is left for later.
Any questions, remarks?
Greetings,
Maxime
[-- Attachment #1.2: 0001-substitute-implement-a-hook-mechanism-for-defining-s.patch --]
[-- Type: text/x-patch, Size: 55655 bytes --]
From 00f9b0119d3e071f9debbbf1019518f57485b623 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 26 Feb 2021 18:15:56 +0100
Subject: [PATCH 1/4] substitute: implement a 'hook' mechanism for defining
substituters
A new substituter named X can be defined in (guix scripts substitute X).
This substituter will be queried for additional narinfos and will be
used for downloading the substitute. Substituters are tried in-order,
according to the substitute-methods daemon option.
* guix/scripts/substitute.scm
(%narinfo-transient-error-ttl, cache-narinfo!): export
for use in the HTTP substituter.
(make-substituter, substituter?): define a record type for
substituters.
(default-substituters, resolve-substituter)
(%substituters, substituters): automatically
determine which substituters to use.
(fetch-narinfos): split off HTTP code to
guix/scripts/substitute/http.scm and ask each
substituter for narinfos.
(verify-hash): split off procedure from process-substition.
(verifiy-hash/unknown): stub procedure.
(process-substitution): split off HTTP code to
guix/scripts/substitute.scm and ask each substituter
for a substitute.
(%fetch-timeout, %random-state, with-timeout)
(fetch, narinfo-request, at-most, http-multiple-get)
(read-to-eof, narinfo-from-file, %unreachable-hosts)
(%max-cached-connections)
(open-connection-for-uri/cached, call-with-cached-connection)
(call-with-connection-error-handling): move HTTP code to
guix/scripts/substitute/http.scm.
* guix/scripts/substitute/http.scm
(process-substitution/http, fetch-narinfo/narinfo)
(http-substituter): define the HTTP substituter.
---
Makefile.am | 1 +
guix/scripts/substitute.scm | 521 +++++++++++--------------------
guix/scripts/substitute/http.scm | 462 +++++++++++++++++++++++++++
tests/substitute.scm | 154 +++++++++
4 files changed, 794 insertions(+), 344 deletions(-)
create mode 100644 guix/scripts/substitute/http.scm
diff --git a/Makefile.am b/Makefile.am
index 394d2ef75e..54bee3653c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -279,6 +279,7 @@ MODULES = \
guix/scripts/pull.scm \
guix/scripts/processes.scm \
guix/scripts/substitute.scm \
+ guix/scripts/substitute/http.scm \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
guix/scripts/repl.scm \
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index fcb462b47b..78345dce8f 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -33,20 +34,18 @@
#:use-module ((guix serialization) #:select (restore-file dump-file))
#:autoload (guix store deduplication) (dump-file/deduplicate)
#:autoload (guix scripts discover) (read-substitute-urls)
+ #:autoload (guix scripts substitute http) (open-connection-for-uri/cached)
#:use-module (gcrypt hash)
#:use-module (guix base32)
#:use-module (guix base64)
#:use-module (guix cache)
+ #:use-module (guix progress)
#:use-module (gcrypt pk-crypto)
#:use-module (guix pki)
- #:use-module ((guix build utils) #:select (mkdir-p dump-port))
+ #:use-module ((guix build utils) #:select (mkdir-p))
#:use-module ((guix build download)
- #:select (uri-abbreviation nar-uri-abbreviation
- (open-connection-for-uri
- . guix:open-connection-for-uri)
- store-path-abbreviation byte-count->string))
- #:autoload (gnutls) (error/invalid-session)
- #:use-module (guix progress)
+ #:select ((open-connection-for-uri
+ . guix:open-connection-for-uri)))
#:use-module ((guix build syscalls)
#:select (set-thread-name))
#:use-module (ice-9 rdelim)
@@ -57,26 +56,31 @@
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 vlist)
#:use-module (rnrs bytevectors)
+ #:use-module (web uri)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-2)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (web uri)
- #:use-module (web http)
- #:use-module (web request)
- #:use-module (web response)
- #:use-module (guix http-client)
#:export (lookup-narinfos
lookup-narinfos/diverse
%allow-unauthenticated-substitutes?
%error-to-file-descriptor-4?
+ %narinfo-transient-error-ttl
+ cache-narinfo!
+
substitute-urls
- guix-substitute))
+ guix-substitute
+
+ make-substituter substituter?
+ substituters
+ default-substituters
+ resolve-substituter))
;;; Comment:
;;;
@@ -87,8 +91,91 @@
;;; If possible, substitute a binary for the requested store path, using a Nix
;;; "binary cache". This program implements the Nix "substituter" protocol.
;;;
+;;; Currently, only substitutes over HTTP, HTTPS, and from the file system
+;;; are supported. At some point in the future, substitutes over IPFS and
+;;; GNUnet will be implemented, however. To prepare for this future,
+;;; the HTTP-specific code has been split-off to (guix scripts substitute http)
+;;; and a ‘hook’ mechanism has been defined.
+;;;
;;; Code:
+\f
+
+;; Defining / using hooks
+;;
+;; A substituter named NAME must be defined in (guix scripts substitute NAME),
+;; bound to a variable NAME-subtituter to be automatically found,
+;; presuming it is in the present in the substitute-methods daemon option.
+
+(define-record-type <substituter>
+ (make-substituter name nar-downloader fetch-narinfos recognised-uri-schemes)
+ substituter?
+ ;; The name of this substituter as a symbol.
+ (name substituter-name)
+ ;; If not #f, this is a procedure that downloads a nar.
+ ;;
+ ;; Arguments: (DESTINATION NARINFO IN-KWARG ...).
+ ;; Result: (PORT KWARG ...).
+ ;;
+ ;; PORT can be 'unpacked if the substituter has successfully
+ ;; unpacked the nar into DESTINATION. It can be #f if the
+ ;; substituter cannot be used for this narinfo. Alternatively,
+ ;; it can be an input port from which a nar can be read.
+ ;;
+ ;; KWARG ... are keyword arguments. Currently, the following
+ ;; are recognised:
+ ;; #:after-input-close (when PORT is a port): thunk to
+ ;; call after PORT has been closed. The HTTP substituter
+ ;; uses this to wait for the reporter to finish.
+ (nar-downloader substituter-nar-downloader)
+ ;; If not #f, this is a produce that attempts to download narinfos.
+ ;; This is only called if the URL has an URI scheme
+ ;; in recognised-uri-schemes.
+ ;;
+ ;; Arguments: (URL PATHS).
+ ;; Result: a list of narinfos.
+ ;;
+ ;; Currently, this procedure must handle caching by itself.
+ (fetch-narinfos substituter-narinfo-fetcher)
+ ;; A list of the URI schemes supported by this method.
+ (recognised-uri-schemes substituter-uri-schemes))
+
+(define (resolve-substituter name)
+ "Find the substituter named NAME and return it.
+If the substituter doesn't exit, return #f instead."
+ (and-let* ((module (resolve-module `(guix scripts substitute ,name)
+ #:ensure #f))
+ (variable (module-variable module
+ (symbol-append name '-substituter)))
+ (substituter
+ (and (variable-bound? variable)
+ (variable-ref variable))))
+ (unless (substituter? substituter)
+ (leave (G_ "'~a-substituter' is not a substituter~%") name))
+ substituter))
+
+(define (default-substituters)
+ "Look in the daemon options for which substituters should be used,
+and returns these substituters as a list. In case not all requested
+substituters could be found, emit a warning for each missing
+substituter."
+ (define (resolve-substituter/warning name)
+ (or (resolve-substituter name)
+ (begin
+ (warning (G_ "~a: unknown substituter~%") name)
+ #f)))
+ (filter-map resolve-substituter/warning
+ (or (and=> (find-daemon-option "substitute-methods")
+ (compose (cut map string->symbol <>) string-tokenize))
+ '(http))))
+
+;; The creation of the substituters is delayed
+;; to avoid cyclic dependencies.
+(define %substituters (delay (make-parameter (default-substituters))))
+(define-syntax substituters (identifier-syntax (force %substituters)))
+
+\f
+
(define %narinfo-cache-directory
;; A local cache of narinfos, to avoid going to the network. Most of the
;; time, 'guix substitute' is called by guix-daemon as root and stores its
@@ -130,45 +217,6 @@ disabled!~%"))
;; How often we want to remove files corresponding to expired cache entries.
(* 7 24 3600))
-(define %fetch-timeout
- ;; Number of seconds after which networking is considered "slow".
- 5)
-
-(define %random-state
- (seed->random-state (+ (ash (cdr (gettimeofday)) 32) (getpid))))
-
-(define-syntax-rule (with-timeout duration handler body ...)
- "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY
-again."
- (begin
- (sigaction SIGALRM
- (lambda (signum)
- (sigaction SIGALRM SIG_DFL)
- handler))
- (alarm duration)
- (call-with-values
- (lambda ()
- (let try ()
- (catch 'system-error
- (lambda ()
- body ...)
- (lambda args
- ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR
- ;; because of the bug at
- ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>.
- ;; When that happens, try again. Note: SA_RESTART cannot be
- ;; used because of <http://bugs.gnu.org/14640>.
- (if (= EINTR (system-error-errno args))
- (begin
- ;; Wait a little to avoid bursts.
- (usleep (random 3000000 %random-state))
- (try))
- (apply throw args))))))
- (lambda result
- (alarm 0)
- (sigaction SIGALRM SIG_DFL)
- (apply values result)))))
-
(define (narinfo-cache-file cache-url path)
"Return the name of the local file that contains an entry for PATH. The
entry is stored in a sub-directory specific to CACHE-URL."
@@ -240,155 +288,18 @@ indicates that PATH is unavailable at CACHE-URL."
narinfo)
-(define (narinfo-request cache-url path)
- "Return an HTTP request for the narinfo of PATH at CACHE-URL."
- (let ((url (string-append cache-url "/" (store-path-hash-part path)
- ".narinfo"))
- (headers '((User-Agent . "GNU Guile"))))
- (build-request (string->uri url) #:method 'GET #:headers headers)))
-
-(define (at-most max-length lst)
- "If LST is shorter than MAX-LENGTH, return it and the empty list; otherwise
-return its MAX-LENGTH first elements and its tail."
- (let loop ((len 0)
- (lst lst)
- (result '()))
- (match lst
- (()
- (values (reverse result) '()))
- ((head . tail)
- (if (>= len max-length)
- (values (reverse result) lst)
- (loop (+ 1 len) tail (cons head result)))))))
-
-(define (read-to-eof port)
- "Read from PORT until EOF is reached. The data are discarded."
- (dump-port port (%make-void-port "w")))
-
-(define (narinfo-from-file file url)
- "Attempt to read a narinfo from FILE, using URL as the cache URL. Return #f
-if file doesn't exist, and the narinfo otherwise."
- (catch 'system-error
- (lambda ()
- (call-with-input-file file
- (cut read-narinfo <> url)))
- (lambda args
- (if (= ENOENT (system-error-errno args))
- #f
- (apply throw args)))))
-
-(define %unreachable-hosts
- ;; Set of names of unreachable hosts.
- (make-hash-table))
-
-(define* (call-with-connection-error-handling uri proc)
- "Call PROC, and catch if a connection fails, print a warning and return #f."
- (define host
- (uri-host uri))
-
- (catch #t
- proc
- (match-lambda*
- (('getaddrinfo-error error)
- (unless (hash-ref %unreachable-hosts host)
- (hash-set! %unreachable-hosts host #t) ;warn only once
- (warning (G_ "~a: host not found: ~a~%")
- host (gai-strerror error)))
- #f)
- (('system-error . args)
- (unless (hash-ref %unreachable-hosts host)
- (hash-set! %unreachable-hosts host #t)
- (warning (G_ "~a: connection failed: ~a~%") host
- (strerror
- (system-error-errno `(system-error ,@args)))))
- #f)
- (args
- (apply throw args)))))
-
(define* (fetch-narinfos url paths
#:key (open-connection guix:open-connection-for-uri))
"Retrieve all the narinfos for PATHS from the cache at URL and return them."
- (define update-progress!
- (let ((done 0)
- (total (length paths)))
- (lambda ()
- (display "\r\x1b[K" (current-error-port)) ;erase current line
- (force-output (current-error-port))
- (format (current-error-port)
- (G_ "updating substitutes from '~a'... ~5,1f%")
- url (* 100. (/ done total)))
- (set! done (+ 1 done)))))
-
- (define hash-part->path
- (let ((mapping (fold (lambda (path result)
- (vhash-cons (store-path-hash-part path) path
- result))
- vlist-null
- paths)))
- (lambda (hash)
- (match (vhash-assoc hash mapping)
- (#f #f)
- ((_ . path) path)))))
-
- (define (handle-narinfo-response request response port result)
- (let* ((code (response-code response))
- (len (response-content-length response))
- (cache (response-cache-control response))
- (ttl (and cache (assoc-ref cache 'max-age))))
- (update-progress!)
-
- ;; Make sure to read no more than LEN bytes since subsequent bytes may
- ;; belong to the next response.
- (if (= code 200) ; hit
- (let ((narinfo (read-narinfo port url #:size len)))
- (if (string=? (dirname (narinfo-path narinfo))
- (%store-prefix))
- (begin
- (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
- (cons narinfo result))
- result))
- (let* ((path (uri-path (request-uri request)))
- (hash-part (basename
- (string-drop-right path 8)))) ;drop ".narinfo"
- (if len
- (get-bytevector-n port len)
- (read-to-eof port))
- (cache-narinfo! url (hash-part->path hash-part) #f
- (if (or (= 404 code) (= 202 code))
- ttl
- %narinfo-transient-error-ttl))
- result))))
-
- (define (do-fetch uri)
- (case (and=> uri uri-scheme)
- ((http https)
- ;; Note: Do not check HTTPS server certificates to avoid depending
- ;; on the X.509 PKI. We can do it because we authenticate
- ;; narinfos, which provides a much stronger guarantee.
- (let* ((requests (map (cut narinfo-request url <>) paths))
- (result (begin
- (update-progress!)
- (call-with-connection-error-handling
- uri
- (lambda ()
- (http-multiple-get uri
- handle-narinfo-response '()
- requests
- #:open-connection open-connection
- #:verify-certificate? #f))))))
- (newline (current-error-port))
- result))
- ((file #f)
- (let* ((base (string-append (uri-path uri) "/"))
- (files (map (compose (cut string-append base <> ".narinfo")
- store-path-hash-part)
- paths)))
- (filter-map (cut narinfo-from-file <> url) files)))
- (else
- (leave (G_ "~s: unsupported server URI scheme~%")
- (if uri (uri-scheme uri) url)))))
-
- (do-fetch (string->uri url)))
+ (define scheme (uri-scheme (string->uri url)))
+ (define usable-substituter?
+ (compose (cute memq scheme <>) substituter-uri-schemes))
+ (define fetch-narinfo/substituter
+ (compose (cute <> url paths #:open-connection open-connection)
+ substituter-narinfo-fetcher))
+ (define found
+ (map fetch-narinfo/substituter (filter usable-substituter? (substituters))))
+ (concatenate found))
(define* (lookup-narinfos cache paths
#:key (open-connection guix:open-connection-for-uri))
@@ -606,55 +517,29 @@ authorized substitutes."
(wtf
(error "unknown `--query' command" wtf))))
-(define %max-cached-connections
- ;; Maximum number of connections kept in cache by
- ;; 'open-connection-for-uri/cached'.
- 16)
-
-(define open-connection-for-uri/cached
- (let ((cache '()))
- (lambda* (uri #:key fresh? (timeout %fetch-timeout) verify-certificate?)
- "Return a connection for URI, possibly reusing a cached connection.
-When FRESH? is true, delete any cached connections for URI and open a new one.
-Return #f if URI's scheme is 'file' or #f.
-
-When true, TIMEOUT is the maximum number of milliseconds to wait for
-connection establishment. When VERIFY-CERTIFICATE? is true, verify HTTPS
-server certificates."
- (define host (uri-host uri))
- (define scheme (uri-scheme uri))
- (define key (list host scheme (uri-port uri)))
-
- (and (not (memq scheme '(file #f)))
- (match (assoc-ref cache key)
- (#f
- ;; Open a new connection to URI and evict old entries from
- ;; CACHE, if any.
- (let-values (((socket)
- (guix:open-connection-for-uri
- uri
- #:verify-certificate? verify-certificate?
- #:timeout timeout))
- ((new-cache evicted)
- (at-most (- %max-cached-connections 1) cache)))
- (for-each (match-lambda
- ((_ . port)
- (false-if-exception (close-port port))))
- evicted)
- (set! cache (alist-cons key socket new-cache))
- socket))
- (socket
- (if (or fresh? (port-closed? socket))
- (begin
- (false-if-exception (close-port socket))
- (set! cache (alist-delete key cache))
- (open-connection-for-uri/cached uri #:timeout timeout
- #:verify-certificate?
- verify-certificate?))
- (begin
- ;; Drain input left from the previous use.
- (drain-input socket)
- socket))))))))
+(define (verify-hash actual expected algorithm narinfo)
+ "Check whether we got the data announced in the narinfo NARINFO.
+ACTUAL is the actual hash, and EXPECTED is the hash according
+to the narinfo."
+ (if (bytevector=? actual expected)
+ ;; Tell the daemon that we're done.
+ (format (current-output-port) "success ~a ~a~%"
+ (narinfo-hash narinfo) (narinfo-size narinfo))
+ ;; The actual data has a different hash than that in NARINFO.
+ (format (current-output-port) "hash-mismatch ~a ~a ~a~%"
+ (hash-algorithm-name algorithm)
+ (bytevector->nix-base32-string expected)
+ (bytevector->nix-base32-string actual))))
+
+(define (verify-hash/unknown . rest)
+ ;; Variant of verify-hash where the hash hasn't yet been computed.
+ ;; TODO: this will be implemented later in the patch series!
+ ;; (To be used by the IPFS and GNUnet substituter)
+ (leave (G_ "TODO verify-hash/unknown is unimplemented~%")))
+
+(define-syntax-rule (receive* kwargs exp exp* exp** ...)
+ (call-with-values (lambda () exp)
+ (lambda* kwargs exp* exp** ...)))
(define* (process-substitution store-item destination
#:key cache-urls acl
@@ -680,107 +565,54 @@ the current output port."
(apply dump-file/deduplicate
(append args (list #:store (%store-prefix)))))
- (define (fetch uri)
- (case (uri-scheme uri)
- ((file)
- (let ((port (open-file (uri-path uri) "r0b")))
- (values port (stat:size (stat port)))))
- ((http https)
- (guard (c ((http-get-error? c)
- (leave (G_ "download from '~a' failed: ~a, ~s~%")
- (uri->string (http-get-error-uri c))
- (http-get-error-code c)
- (http-get-error-reason c))))
- ;; Test this with:
- ;; sudo tc qdisc add dev eth0 root netem delay 1500ms
- ;; and then cancel with:
- ;; sudo tc qdisc del dev eth0 root
- (with-timeout %fetch-timeout
- (begin
- (warning (G_ "while fetching ~a: server is somewhat slow~%")
- (uri->string uri))
- (warning (G_ "try `--no-substitutes' if the problem persists~%")))
- (call-with-connection-error-handling
- uri
- (lambda ()
- (http-fetch uri #:text? #f
- #:open-connection open-connection-for-uri/cached
- #:keep-alive? #t
- #:buffered? #f
- #:verify-certificate? #f))))))
- (else
- (leave (G_ "unsupported substitute URI scheme: ~a~%")
- (uri->string uri)))))
-
(unless narinfo
(leave (G_ "no valid substitute for '~a'~%")
store-item))
- (let-values (((uri compression file-size)
- (narinfo-best-uri narinfo)))
- (unless print-build-trace?
- (format (current-error-port)
- (G_ "Downloading ~a...~%") (uri->string uri)))
-
- (let*-values (((raw download-size)
- ;; 'guix publish' without '--cache' doesn't specify a
- ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
- (fetch uri))
- ((progress)
- (let* ((dl-size (or download-size
- (and (equal? compression "none")
- (narinfo-size narinfo))))
- (reporter (if print-build-trace?
- (progress-reporter/trace
- destination
- (uri->string uri) dl-size
- (current-error-port))
- (progress-reporter/file
- (uri->string uri) dl-size
- (current-error-port)
- #:abbreviation nar-uri-abbreviation))))
- ;; Keep RAW open upon completion so we can later reuse
- ;; the underlying connection.
- (progress-report-port reporter raw #:close? #f)))
- ((input pids)
- ;; NOTE: This 'progress' port of current process will be
- ;; closed here, while the child process doing the
- ;; reporting will close it upon exit.
- (decompressed-port (string->symbol compression)
- progress))
-
- ;; Compute the actual nar hash as we read it.
- ((algorithm expected)
- (narinfo-hash-algorithm+value narinfo))
- ((hashed get-hash)
- (open-hash-input-port algorithm input)))
- ;; Unpack the Nar at INPUT into DESTINATION.
- (restore-file hashed destination
- #:dump-file (if (and destination-in-store?
- deduplicate?)
- dump-file/deduplicate*
- dump-file))
- (close-port hashed)
- (close-port input)
-
- ;; Wait for the reporter to finish.
- (every (compose zero? cdr waitpid) pids)
-
- ;; Skip a line after what 'progress-reporter/file' printed, and another
- ;; one to visually separate substitutions.
- (display "\n\n" (current-error-port))
-
- ;; Check whether we got the data announced in NARINFO.
- (let ((actual (get-hash)))
- (if (bytevector=? actual expected)
- ;; Tell the daemon that we're done.
- (format (current-output-port) "success ~a ~a~%"
- (narinfo-hash narinfo) (narinfo-size narinfo))
- ;; The actual data has a different hash than that in NARINFO.
- (format (current-output-port) "hash-mismatch ~a ~a ~a~%"
- (hash-algorithm-name algorithm)
- (bytevector->nix-base32-string expected)
- (bytevector->nix-base32-string actual)))))))
+ ;; Try each hook in-order, until a hook is successful.
+ (let loop ((hooks (filter substituter-nar-downloader (substituters))))
+ (unless (pair? hooks)
+ (leave (G_ "no substituter for 'a'~%")
+ store-item))
+ (receive* (input #:key after-input-close)
+ ((substituter-nar-downloader (car hooks)) destination narinfo
+ #:print-build-trace? print-build-trace?)
+ (cond ((not input)
+ (format (current-error-port)
+ (G_ "Substituter '~a' not applicable for '~a'.~%")
+ (substituter-name (car hooks))
+ store-item)
+ ;; This hook was unusable, try the next hook.
+ (loop (cdr hooks)))
+ ((input-port? input)
+ ;; Compute the actual nar hash as we read it.
+ (let*-values (((algorithm expected)
+ (narinfo-hash-algorithm+value narinfo))
+ ((hashed get-hash)
+ (open-hash-input-port algorithm input)))
+ ;; Unpack the Nar at INPUT into DESTINATION.
+ (restore-file hashed destination
+ #:dump-file (if (and destination-in-store?
+ deduplicate?)
+ dump-file/deduplicate*
+ dump-file))
+ (close-port hashed)
+ (close-port input)
+ (when after-input-close
+ (after-input-close))
+ ;; Check whether we got the data announced in NARINFO.
+ (verify-hash (get-hash) expected algorithm narinfo)))
+ ((eq? input 'unpacked)
+ (when after-input-close
+ (after-input-close))
+ ;; Check whether we got the data announced in the NARINFO.
+ (verify-hash/unknown destination narinfo))
+ (else
+ (format (current-error-port) "~s~%" input)
+ (leave
+ (G_ "Substituter '~a' did not produce usable output for '~a'.")
+ (substituter-name (car hooks))
+ store-item))))))
\f
;;;
@@ -992,6 +824,7 @@ if needed, as expected by the daemon's agent."
(leave (G_ "~a: unrecognized options~%") opts)))))))
;;; Local Variables:
+;;; eval: (put 'receive* 'scheme-indent-function 2)
;;; eval: (put 'with-timeout 'scheme-indent-function 1)
;;; eval: (put 'with-redirected-error-port 'scheme-indent-function 0)
;;; End:
diff --git a/guix/scripts/substitute/http.scm b/guix/scripts/substitute/http.scm
new file mode 100644
index 0000000000..d5dd1e4a8e
--- /dev/null
+++ b/guix/scripts/substitute/http.scm
@@ -0,0 +1,462 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://
+
+;;; Comment:
+;;;
+;;; This is the implementation of the binary substituter for
+;;; substitutes over HTTP and HTTPS (and perhaps technical similar
+;;; systems in the future).
+;;;
+;;; Code:
+
+(define-module (guix scripts substitute http)
+ #:export (http-substituter open-connection-for-uri/cached)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix scripts substitute)
+ #:use-module (guix narinfo)
+ #:use-module (guix i18n)
+ #:use-module ((guix build utils) #:select (dump-port))
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (web uri)
+ #:use-module (web http)
+ #:use-module (web request)
+ #:use-module (web response)
+ #:use-module (guix http-client)
+ #:use-module ((guix build download)
+ #:select (uri-abbreviation nar-uri-abbreviation
+ (open-connection-for-uri
+ . guix:open-connection-for-uri)
+ store-path-abbreviation byte-count->string))
+ #:use-module (guix progress)
+ #:use-module (guix store)
+ #:use-module (guix scripts substitute)
+ #:autoload (gnutls) (error/invalid-session)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 vlist)
+ #:use-module (ice-9 format))
+
+(define %fetch-timeout
+ ;; Number of seconds after which networking is considered "slow".
+ 5)
+
+(define %random-state
+ (seed->random-state (+ (ash (cdr (gettimeofday)) 32) (getpid))))
+
+(define-syntax-rule (with-timeout duration handler body ...)
+ "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY
+again."
+ (begin
+ (sigaction SIGALRM
+ (lambda (signum)
+ (sigaction SIGALRM SIG_DFL)
+ handler))
+ (alarm duration)
+ (call-with-values
+ (lambda ()
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ body ...)
+ (lambda args
+ ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR
+ ;; because of the bug at
+ ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>.
+ ;; When that happens, try again. Note: SA_RESTART cannot be
+ ;; used because of <http://bugs.gnu.org/14640>.
+ (if (= EINTR (system-error-errno args))
+ (begin
+ ;; Wait a little to avoid bursts.
+ (usleep (random 3000000 %random-state))
+ (try))
+ (apply throw args))))))
+ (lambda result
+ (alarm 0)
+ (sigaction SIGALRM SIG_DFL)
+ (apply values result)))))
+
+(define* (fetch uri #:key (buffered? #t) (timeout? #t)
+ (keep-alive? #f) (port #f))
+ "Return a binary input port to URI and the number of bytes it's expected to
+provide.
+
+When PORT is true, use it as the underlying I/O port for HTTP transfers; when
+PORT is false, open a new connection for URI. When KEEP-ALIVE? is true, the
+connection (typically PORT) is kept open once data has been fetched from URI."
+ (case (uri-scheme uri)
+ ((file)
+ (let ((port (open-file (uri-path uri)
+ (if buffered? "rb" "r0b"))))
+ (values port (stat:size (stat port)))))
+ ((http https)
+ (guard (c ((http-get-error? c)
+ (leave (G_ "download from '~a' failed: ~a, ~s~%")
+ (uri->string (http-get-error-uri c))
+ (http-get-error-code c)
+ (http-get-error-reason c))))
+ ;; Test this with:
+ ;; sudo tc qdisc add dev eth0 root netem delay 1500ms
+ ;; and then cancel with:
+ ;; sudo tc qdisc del dev eth0 root
+ (let ((port port))
+ (with-timeout (if timeout?
+ %fetch-timeout
+ 0)
+ (begin
+ (warning (G_ "while fetching ~a: server is somewhat slow~%")
+ (uri->string uri))
+ (warning (G_ "try `--no-substitutes' if the problem persists~%")))
+ (call-with-connection-error-handling
+ uri
+ (lambda ()
+ (http-fetch uri #:text? #f
+ #:open-connection open-connection-for-uri/cached
+ #:keep-alive? #t
+ #:buffered? #f
+ #:verify-certificate? #f)))))))
+ (else
+ (leave (G_ "unsupported substitute URI scheme: ~a~%")
+ (uri->string uri)))))
+
+(define (narinfo-request cache-url path)
+ "Return an HTTP request for the narinfo of PATH at CACHE-URL."
+ (let ((url (string-append cache-url "/" (store-path-hash-part path)
+ ".narinfo"))
+ (headers '((User-Agent . "GNU Guile"))))
+ (build-request (string->uri url) #:method 'GET #:headers headers)))
+
+(define (at-most max-length lst)
+ "If LST is shorter than MAX-LENGTH, return it and the empty list; otherwise
+return its MAX-LENGTH first elements and its tail."
+ (let loop ((len 0)
+ (lst lst)
+ (result '()))
+ (match lst
+ (()
+ (values (reverse result) '()))
+ ((head . tail)
+ (if (>= len max-length)
+ (values (reverse result) lst)
+ (loop (+ 1 len) tail (cons head result)))))))
+
+(define* (http-multiple-get base-uri proc seed requests
+ #:key port (verify-certificate? #t)
+ (open-connection guix:open-connection-for-uri)
+ (keep-alive? #t)
+ (batch-size 1000))
+ "Send all of REQUESTS to the server at BASE-URI. Call PROC for each
+response, passing it the request object, the response, a port from which to
+read the response body, and the previous result, starting with SEED, à la
+'fold'. Return the final result.
+
+When PORT is specified, use it as the initial connection on which HTTP
+requests are sent; otherwise call OPEN-CONNECTION to open a new connection for
+a URI. When KEEP-ALIVE? is false, close the connection port before
+returning."
+ (let connect ((port port)
+ (requests requests)
+ (result seed))
+ (define batch
+ (at-most batch-size requests))
+
+ ;; (format (current-error-port) "connecting (~a requests left)..."
+ ;; (length requests))
+ (let ((p (or port (open-connection base-uri
+ #:verify-certificate?
+ verify-certificate?))))
+ ;; For HTTPS, P is not a file port and does not support 'setvbuf'.
+ (when (file-port? p)
+ (setvbuf p 'block (expt 2 16)))
+
+ ;; Send BATCH in a row.
+ ;; XXX: Do our own caching to work around inefficiencies when
+ ;; communicating over TLS: <http://bugs.gnu.org/22966>.
+ (let-values (((buffer get) (open-bytevector-output-port)))
+ ;; Inherit the HTTP proxying property from P.
+ (set-http-proxy-port?! buffer (http-proxy-port? p))
+
+ (for-each (cut write-request <> buffer)
+ batch)
+ (put-bytevector p (get))
+ (force-output p))
+
+ ;; Now start processing responses.
+ (let loop ((sent batch)
+ (processed 0)
+ (result result))
+ (match sent
+ (()
+ (match (drop requests processed)
+ (()
+ (unless keep-alive?
+ (close-port p))
+ (reverse result))
+ (remainder
+ (connect p remainder result))))
+ ((head tail ...)
+ (let* ((resp (read-response p))
+ (body (response-body-port resp))
+ (result (proc head resp body result)))
+ ;; The server can choose to stop responding at any time, in which
+ ;; case we have to try again. Check whether that is the case.
+ ;; Note that even upon "Connection: close", we can read from BODY.
+ (match (assq 'connection (response-headers resp))
+ (('connection 'close)
+ (close-port p)
+ (connect #f ;try again
+ (drop requests (+ 1 processed))
+ result))
+ (_
+ (loop tail (+ 1 processed) result)))))))))) ;keep going
+
+(define (read-to-eof port)
+ "Read from PORT until EOF is reached. The data are discarded."
+ (dump-port port (%make-void-port "w")))
+
+(define (narinfo-from-file file url)
+ "Attempt to read a narinfo from FILE, using URL as the cache URL. Return #f
+if file doesn't exist, and the narinfo otherwise."
+ (catch 'system-error
+ (lambda ()
+ (call-with-input-file file
+ (cut read-narinfo <> url)))
+ (lambda args
+ (if (= ENOENT (system-error-errno args))
+ #f
+ (apply throw args)))))
+
+(define %unreachable-hosts
+ ;; Set of names of unreachable hosts.
+ (make-hash-table))
+
+(define %max-cached-connections
+ ;; Maximum number of connections kept in cache by
+ ;; 'open-connection-for-uri/cached'.
+ 16)
+
+(define open-connection-for-uri/cached
+ (let ((cache '()))
+ (lambda* (uri #:key fresh? (timeout %fetch-timeout) verify-certificate?)
+ "Return a connection for URI, possibly reusing a cached connection.
+When FRESH? is true, delete any cached connections for URI and open a new one.
+Return #f if URI's scheme is 'file' or #f.
+
+When true, TIMEOUT is the maximum number of milliseconds to wait for
+connection establishment. When VERIFY-CERTIFICATE? is true, verify HTTPS
+server certificates."
+ (define host (uri-host uri))
+ (define scheme (uri-scheme uri))
+ (define key (list host scheme (uri-port uri)))
+
+ (and (not (memq scheme '(file #f)))
+ (match (assoc-ref cache key)
+ (#f
+ ;; Open a new connection to URI and evict old entries from
+ ;; CACHE, if any.
+ (let-values (((socket)
+ (guix:open-connection-for-uri
+ uri
+ #:verify-certificate? verify-certificate?
+ #:timeout timeout))
+ ((new-cache evicted)
+ (at-most (- %max-cached-connections 1) cache)))
+ (for-each (match-lambda
+ ((_ . port)
+ (false-if-exception (close-port port))))
+ evicted)
+ (set! cache (alist-cons key socket new-cache))
+ socket))
+ (socket
+ (if (or fresh? (port-closed? socket))
+ (begin
+ (false-if-exception (close-port socket))
+ (set! cache (alist-delete key cache))
+ (open-connection-for-uri/cached uri #:timeout timeout
+ #:verify-certificate?
+ verify-certificate?))
+ (begin
+ ;; Drain input left from the previous use.
+ (drain-input socket)
+ socket))))))))
+
+(define* (process-substitution/http destination narinfo #:key print-build-trace?)
+ (let-values (((uri compression file-size)
+ (narinfo-best-uri narinfo)))
+ (unless print-build-trace?
+ (format (current-error-port)
+ (G_ "Downloading ~a...~%") (uri->string uri)))
+
+ (let*-values (((raw download-size)
+ ;; 'guix publish' without '--cache' doesn't specify a
+ ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
+ (fetch uri))
+ ((progress)
+ (let* ((dl-size (or download-size
+ (and (equal? compression "none")
+ (narinfo-size narinfo))))
+ (reporter (if print-build-trace?
+ (progress-reporter/trace
+ destination
+ (uri->string uri) dl-size
+ (current-error-port))
+ (progress-reporter/file
+ (uri->string uri) dl-size
+ (current-error-port)
+ #:abbreviation nar-uri-abbreviation))))
+ ;; Keep RAW open upon completion so we can later reuse
+ ;; the underlying connection.
+ (progress-report-port reporter raw #:close? #f)))
+ ((input pids)
+ ;; NOTE: This 'progress' port of current process will be
+ ;; closed here, while the child process doing the
+ ;; reporting will close it upon exit.
+ (decompressed-port (string->symbol compression)
+ progress)))
+ (values input
+ #:after-input-close
+ (lambda ()
+ ;; Wait for the reporter to finish.
+ (every (compose zero? cdr waitpid) pids)
+
+ ;; Skip a line after what 'progress-reporter/file' printed,
+ ;; and another one to visually separate substitutions.
+ (display "\n\n" (current-error-port)))))))
+
+(define* (call-with-connection-error-handling uri proc)
+ "Call PROC, and catch if a connection fails, print a warning and return #f."
+ (define host
+ (uri-host uri))
+
+ (catch #t
+ proc
+ (match-lambda*
+ (('getaddrinfo-error error)
+ (unless (hash-ref %unreachable-hosts host)
+ (hash-set! %unreachable-hosts host #t) ;warn only once
+ (warning (G_ "~a: host not found: ~a~%")
+ host (gai-strerror error)))
+ #f)
+ (('system-error . args)
+ (unless (hash-ref %unreachable-hosts host)
+ (hash-set! %unreachable-hosts host #t)
+ (warning (G_ "~a: connection failed: ~a~%") host
+ (strerror
+ (system-error-errno `(system-error ,@args)))))
+ #f)
+ (args
+ (apply throw args)))))
+
+(define* (fetch-narinfos/http url paths
+ #:key (open-connection
+ guix:open-connection-for-uri))
+ "Retrieve all the narinfos for PATHS from the cache at URL and return them.
+The URI scheme of URL must currently be http, https or file."
+ (define update-progress!
+ (let ((done 0)
+ (total (length paths)))
+ (lambda ()
+ (display "\r\x1b[K" (current-error-port)) ;erase current line
+ (force-output (current-error-port))
+ (format (current-error-port)
+ (G_ "updating substitutes from '~a'... ~5,1f%")
+ url (* 100. (/ done total)))
+ (set! done (+ 1 done)))))
+
+ (define hash-part->path
+ (let ((mapping (fold (lambda (path result)
+ (vhash-cons (store-path-hash-part path) path
+ result))
+ vlist-null
+ paths)))
+ (lambda (hash)
+ (match (vhash-assoc hash mapping)
+ (#f #f)
+ ((_ . path) path)))))
+
+ (define (handle-narinfo-response request response port result)
+ (let* ((code (response-code response))
+ (len (response-content-length response))
+ (cache (response-cache-control response))
+ (ttl (and cache (assoc-ref cache 'max-age))))
+ (update-progress!)
+
+ ;; Make sure to read no more than LEN bytes since subsequent bytes may
+ ;; belong to the next response.
+ (if (= code 200) ; hit
+ (let ((narinfo (read-narinfo port url #:size len)))
+ (if (string=? (dirname (narinfo-path narinfo))
+ (%store-prefix))
+ (begin
+ (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
+ (cons narinfo result))
+ result))
+ (let* ((path (uri-path (request-uri request)))
+ (hash-part (basename
+ (string-drop-right path 8)))) ;drop ".narinfo"
+ (if len
+ (get-bytevector-n port len)
+ (read-to-eof port))
+ (cache-narinfo! url (hash-part->path hash-part) #f
+ (if (or (= 404 code) (= 202 code))
+ ttl
+ %narinfo-transient-error-ttl))
+ result))))
+
+ (define (do-fetch uri)
+ (case (and=> uri uri-scheme)
+ ((http https)
+ ;; Note: Do not check HTTPS server certificates to avoid depending
+ ;; on the X.509 PKI. We can do it because we authenticate
+ ;; narinfos, which provides a much stronger guarantee.
+ (let* ((requests (map (cut narinfo-request url <>) paths))
+ (result (begin
+ (update-progress!)
+ (call-with-connection-error-handling
+ uri
+ (lambda ()
+ (http-multiple-get uri
+ handle-narinfo-response '()
+ requests
+ #:open-connection open-connection
+ #:verify-certificate? #f))))))
+ (newline (current-error-port))
+ result))
+ ((file #f)
+ (let* ((base (string-append (uri-path uri) "/"))
+ (files (map (compose (cut string-append base <> ".narinfo")
+ store-path-hash-part)
+ paths)))
+ (filter-map (cut narinfo-from-file <> url) files)))
+ (else
+ (leave (G_ "~s: unsupported server URI scheme~%")
+ (if uri (uri-scheme uri) url)))))
+
+ (do-fetch (string->uri url)))
+
+(define http-substituter
+ (make-substituter 'http
+ process-substitution/http fetch-narinfos/http
+ '(http https file)))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 697abc4684..6c754f774d 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -38,7 +39,9 @@
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (web uri)
+ #:use-module (ice-9 receive)
#:use-module (ice-9 regex)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@@ -585,6 +588,157 @@ System: mips64el-linux\n")))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))
+\f
+
+;; Test substituter hooks.
+
+(test-quit "no substituters, no substitutes"
+ "no valid substitute"
+ ;; This substitute should be ignored
+ (with-narinfo (string-append %narinfo "Signature: "
+ (signature-field %narinfo))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (parameterize ((substituters '()))
+ (request-substitution
+ (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved")))
+ (lambda ()
+ (false-if-exception (delete-file "substitute-retrieved"))))))
+
+(define (call-with-output-bytevector proc)
+ (receive (port get-bytevector)
+ (open-bytevector-output-port)
+ (proc port)
+ (get-bytevector)))
+
+(define (string->nar-port string)
+ (define narinfo-directory %main-substitute-directory)
+ ;; Prepare the nar.
+ (call-with-output-file
+ (string-append narinfo-directory "/example.out")
+ (cut display string <>))
+ (open-bytevector-input-port
+ (call-with-output-bytevector
+ (cut write-file (string-append narinfo-directory "/example.out") <>))))
+
+;; Make a substituter looking up narinfos
+;; and nars in an association list of
+;; (URL PATH) -> narinfo
+;; NARINFO-CONTENTS -> string
+(define (alist->substituter narinfos nars)
+ (define (fetch-narinfos url paths . rest)
+ (define (fetch-narinfo path)
+ (filter-map (lambda (entry)
+ (and (equal? (car entry) (cons url path))
+ (string->narinfo (cdr entry) url)))
+ narinfos))
+ (concatenate (map fetch-narinfo paths)))
+ (define (nar-downloader destination narinfo . rest)
+ (string->nar-port
+ (assoc-ref nars (narinfo-contents narinfo))))
+ (make-substituter 'test nar-downloader fetch-narinfos '(test)))
+
+(test-equal "query, fetch-narinfos is used"
+ (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ (string-trim-both
+ (with-output-to-string
+ (lambda ()
+ (define item
+ (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"))
+ (define substituter
+ (alist->substituter `((("test://x/y" . ,item) . ,%narinfo))
+ '()))
+ (parameterize ((substituters (list substituter))
+ (substitute-urls '("test://x/y"))
+ (%allow-unauthenticated-substitutes? #t))
+ (with-input-from-string (string-append "have " item)
+ (lambda ()
+ (guix-substitute "--query"))))))))
+
+;; XXX why does this result in "hash-mismatch sha256 ... ..."?
+(test-equal "substitute, nar-downloader is used"
+ "Substitutable data."
+ (let* ((url "test://x/y")
+ (item (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"))
+ (narinfo-alist `(((,url . ,item) . ,%narinfo)))
+ (nar-alist `((,%narinfo . "Substitutable data.")))
+ (substituter (alist->substituter narinfo-alist nar-alist)))
+ (parameterize ((substituters
+ (list (alist->substituter narinfo-alist nar-alist)))
+ (substitute-urls '("test://x/y"))
+ (%allow-unauthenticated-substitutes? #t))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved")
+ (call-with-input-file "substitute-retrieved" get-string-all))
+ (lambda ()
+ (false-if-exception (delete-file "substitute-retrieved")))))))
+
+(test-equal "substitute, only supported URI schemes are passed to fetch-narinfos"
+ "Substitutable data."
+ (let ()
+ (define (substituter-expecting protocol)
+ (make-substituter
+ (symbol-append 'test/ protocol)
+ (lambda (destination narinfo . rest)
+ (and (eq? protocol (uri-scheme (string->uri
+ (narinfo-uri-base narinfo))))
+ (string->nar-port "Substitutable data.")))
+ (lambda (url paths . rest)
+ (unless (eq? protocol (uri-scheme (string->uri url)))
+ (error "what? I can't use that."))
+ (list (string->narinfo %narinfo url)))
+ (list protocol)))
+ (parameterize ((substituters
+ (list (substituter-expecting 'x)
+ (substituter-expecting 'y)))
+ (substitute-urls '("x:///" "y:///"))
+ (%allow-unauthenticated-substitutes? #t))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved")
+ (call-with-input-file "substitute-retrieved" get-string-all))
+ (lambda ()
+ (false-if-exception (delete-file "substitute-retrieved")))))))
+
+;; Define a few substituters for testing purposes.
+(define-module (guix scripts substitute test-x)
+ #:export (test-x-substituter)
+ #:use-module (guix scripts substitute))
+
+(define test-x-substituter (make-substituter 'x #f #f '(x)))
+
+(define-module (guix scripts substitute test-y)
+ #:export (test-y-substituter)
+ #:use-module (guix scripts substitute))
+
+(define test-y-substituter (make-substituter 'y #f #f '(x)))
+
+;; And we're back!
+(define-module (test-substitute))
+
+(test-equal "substitute, substituters are found in-order"
+ (list (@ (guix scripts substitute http) http-substituter)
+ (@ (guix scripts substitute test-x) test-x-substituter)
+ (@ (guix scripts substitute test-y) test-y-substituter))
+ (let ((old-options #f))
+ (dynamic-wind
+ (lambda ()
+ (set! old-options (getenv "_NIX_OPTIONS"))
+ (setenv "_NIX_OPTIONS" "substitute-methods=http test-x test-y"))
+ (lambda ()
+ ((@@ (guix scripts substitute) default-substituters)))
+ (lambda ()
+ (setenv "_NIX_OPTIONS" old-options)))))
+
(test-end "substitute")
;;; Local Variables:
--
2.30.0
[-- Attachment #1.3: 0002-doc-Document-how-to-define-new-substituters.patch --]
[-- Type: text/x-patch, Size: 5101 bytes --]
From e74ca543b1b782d36f4283716d0e20bb877aa67d Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Thu, 25 Feb 2021 18:15:06 +0100
Subject: [PATCH 2/4] doc: Document how to define new substituters.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
TODO the makefile should probably be adjusted,
to allow translation of doc/substituters.texi
and to include it in the release archive.
* doc/guix.texi: Include the new section ‘Defining Substituters’
from ‘doc/substituters.texi’.
* doc/substituters.texi: New file, documenting how to define new
substituters.
---
doc/guix.texi | 5 ++++
doc/substituters.texi | 56 +++++++++++++++++++++++++++++++++++++++++++
2 files changed, 61 insertions(+)
create mode 100644 doc/substituters.texi
diff --git a/doc/guix.texi b/doc/guix.texi
index 27083f1ae6..591dc320d8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -86,6 +86,7 @@ Copyright @copyright{} 2020 raingloom@*
Copyright @copyright{} 2020 Daniel Brooks@*
Copyright @copyright{} 2020 John Soo@*
Copyright @copyright{} 2020 Jonathan Brielmaier@*
+Copyright @copyright{} 2021 Maxime Devos@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -267,6 +268,7 @@ Programming Interface
* The Store Monad:: Purely functional interface to the store.
* G-Expressions:: Manipulating build expressions.
* Invoking guix repl:: Programming Guix in Guile.
+* Defining Substituters:: Defining new substitution methods.
Defining Packages
@@ -6361,6 +6363,7 @@ package definitions.
* The Store Monad:: Purely functional interface to the store.
* G-Expressions:: Manipulating build expressions.
* Invoking guix repl:: Programming Guix in Guile
+* Defining Substituters:: Defining new substitution methods.
@end menu
@node Package Modules
@@ -10022,6 +10025,8 @@ Inhibit loading of the @file{~/.guile} file. By default, that
configuration file is loaded when spawning a @code{guile} REPL.
@end table
+@include substituters.texi
+
@c *********************************************************************
@node Utilities
@chapter Utilities
diff --git a/doc/substituters.texi b/doc/substituters.texi
new file mode 100644
index 0000000000..f86a1cb26c
--- /dev/null
+++ b/doc/substituters.texi
@@ -0,0 +1,56 @@
+@node Defining Substituters
+@section Defining Substituters
+
+@cindex substitutes, implementation
+Guix currently only supports downloading substitutes via the HTTP and
+HTTPS protocols, and substitutes over IPFS and GNUnet are planned.
+An implementation of substitutes over some protocol is called a
+‘substituter’.
+
+The API described here is implemented by the @code{(guix scripts substitute)}
+module. In order to let the daemon actually find the substituter, the
+substituter should be defined in a module @code{(guix scripts substitute name)},
+as a variable @var{name}-substituter.
+
+@c TODO currently unimplemented
+@c
+@c The @code{substitute-methods} daemon option must also be set to a
+@c space-separated list of the names of the substituters to use. This is
+@c currently unimplemented.
+
+@deffn {Scheme Procedure} make-substituter @var{name} @var{nar-downloader} @
+ @var{fetch-narinfos} @var{recognised-uri-schemes}
+Return a substituter for the protocols in @var{recognised-uri-schemes},
+a list of URI schemes. @var{fetch-narinfos} will be used finding narinfos
+and @var{nar-downloader} to download a substitute.
+
+The procedure @var{nar-downloader} must be a keyword procedure
+(@pxref{Optional Arguments, keyword arguments in Guile,, guile, GNU
+Guile Reference Manual}). It accepts two positional arguments
+@var{destination} and @var{narinfo}. @var{destination} is the location
+in the file system where the store item should be written to,
+and @var{narinfo} is the narinfo describing the substitute to download.
+
+It should return @code{#f} if the substitute is not available
+via this method. If the substitute was available, it should either
+return an input port to read the nar from.
+
+@c TODO currently unimplemented, but will be used by the IPFS substituter:
+@c or the symbol @code{unpacked}
+@c if the substituter wrote the store item to @var{destination} by itself.
+
+The procedure @var{fetch-narinfos} must accept two arguments
+@var{url} and @var{paths}, where @var{url} is the URL (as a string)
+of a substitute server and @var{paths} is a list of store item names
+for which to find a narinfo.
+
+This procedure should return a list of narinfos pertaining to
+@var{paths} (possibly empty). It can be assumed @var{url}
+has an URI scheme in @var{recognised-uri-schemes}.
+
+A substituter does not have to verify whether the narinfo and nar
+are correctly signed and have a correct hash; this is handled
+by @code{(guix scripts substitute)}. @var{nar-downloader} and
+@var{fetch-narinfos} can be @code{#f} if unimplemented by this
+substituter.
+@end deffn
--
2.30.0
[-- Attachment #1.4: 0003-daemon-Set-the-substitute-methods-option.patch --]
[-- Type: text/x-patch, Size: 7521 bytes --]
From 6b09bef83bdf1882457d4ec91a761a2603f2c1d4 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Thu, 25 Feb 2021 21:03:19 +0100
Subject: [PATCH 3/4] daemon: Set the 'substitute-methods' option.
This option is used by 'guix substitute' to determine
which substitution methods to use.
* doc/guix.texi (Invoking guix-daemon): Document the new daemon option
"--substitute-methods".
(Getting Substitutes from Other Protocols): Document how to use
non-HTTP and non-HTTPS substituters.
* doc/substituters.texi: Remove TODO fixed by this commit.
* nix/nix-daemon/guix-daemon.cc
(GUIX_OPT_SUBSTITUTE_METHODS, options, parse_opt): Define a new
option "--substitute-methods" and include its value in the
"substitute-methods" daemon option.
---
doc/guix.texi | 48 +++++++++++++++++++++++++++++++++++
doc/substituters.texi | 6 -----
nix/nix-daemon/guix-daemon.cc | 7 +++++
3 files changed, 55 insertions(+), 6 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 591dc320d8..c811eb1025 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -229,6 +229,7 @@ Substitutes
* Official Substitute Server:: One particular source of substitutes.
* Substitute Server Authorization:: How to enable or disable substitutes.
* Getting Substitutes from Other Servers:: Substitute diversity.
+* Getting Substitutes from Other Protocols:: Different sources of substitutes.
* Substitute Authentication:: How Guix verifies substitutes.
* Proxy Settings:: How to get substitutes via proxy.
* Substitution Failure:: What happens when substitution fails.
@@ -1531,6 +1532,19 @@ as they are signed by a trusted signature (@pxref{Substitutes}).
@xref{Getting Substitutes from Other Servers}, for more information on
how to configure the daemon to get substitutes from other servers.
+@item --substitute-methods=@var{methods}
+Consider @var{methods} the whitespace-separated list of substitution
+methods (‘substituters’) to use. When this option is omitted, @code{http}
+is used. The @code{http} substituter supports both the HTTP and HTTPS
+protocol.
+
+@xref{Defining Substituters} for information on how to define new
+substituters, and @pxref{Getting Substitutes from Other Protocols}
+on how to use non-HTTP and non-HTTPS substituters.
+
+@c TODO: see <section> for information on how to configure the
+@c IPFS and GNUnet substituters
+
@cindex offloading
@item --no-offload
Do not use offload builds to other machines (@pxref{Daemon Offload
@@ -3679,6 +3693,7 @@ also result from derivation builds, can be available as substitutes.
* Official Substitute Server:: One particular source of substitutes.
* Substitute Server Authorization:: How to enable or disable substitutes.
* Getting Substitutes from Other Servers:: Substitute diversity.
+* Getting Substitutes from Other Protocols:: Different sources of substitutes.
* Substitute Authentication:: How Guix verifies substitutes.
* Proxy Settings:: How to get substitutes via proxy.
* Substitution Failure:: What happens when substitution fails.
@@ -3885,6 +3900,39 @@ Note that there are also situations where one may want to add the URL of
a substitute server @emph{without} authorizing its key.
@xref{Substitute Authentication}, to understand this fine point.
+@node Getting Substitutes from Other Protocols
+@subsection Getting Substitutes from Other Protocols
+
+@cindex substitute servers, alternative protocols
+This subsection probably won't make much sense yet,
+as currently only the HTTP and HTTPS protocols are supported
+for substitution. Consider what follows as a peek into the future!
+
+Guix will support multiple substitution methods -- currently only
+a substituter for HTTP and HTTPS is defined, but a substituter for
+the P2P networks IPFS and GNUnet will be defined in the future.
+
+@c The IPFS substituter has actually already been implemented,
+@c see http://issues.guix.gnu.org/33899, but it requires some changes
+@c and is not yet available to the end-user.
+In order to use a substition method, it must first be enabled in the
+guix daemon
+(@pxref{Invoking guix-daemon, @option{--substitute-methods}}).
+For example, to enable the HTTP/S and the yet-to-be-written IPFS
+substituter, pass @code{--substitute-methods='http ipfs'}.
+This must be set in the daemon, and cannot be done from a user process.
+@c XXX ^ is this sentence clear? I mean ``guix build --substitute-methods``
+@c won't work, as substitution happens in the daemon (well, in a process
+@c started by the daemon to be precise).
+
+Also include an URL supported by the substituter in the list of
+substitute server URLs. That's all there is to it!
+
+@c TODO ^ when using the IPFS substituter, the daemon also needs -
+@c to know the IPFS gateway, and when using the GNUnet substituter,
+@c GNUnet needs to be running. But let's first actually implement
+@c & merge these substituters ...
+
@node Substitute Authentication
@subsection Substitute Authentication
diff --git a/doc/substituters.texi b/doc/substituters.texi
index f86a1cb26c..516e2c1eea 100644
--- a/doc/substituters.texi
+++ b/doc/substituters.texi
@@ -12,12 +12,6 @@ module. In order to let the daemon actually find the substituter, the
substituter should be defined in a module @code{(guix scripts substitute name)},
as a variable @var{name}-substituter.
-@c TODO currently unimplemented
-@c
-@c The @code{substitute-methods} daemon option must also be set to a
-@c space-separated list of the names of the substituters to use. This is
-@c currently unimplemented.
-
@deffn {Scheme Procedure} make-substituter @var{name} @var{nar-downloader} @
@var{fetch-narinfos} @var{recognised-uri-schemes}
Return a substituter for the protocols in @var{recognised-uri-schemes},
diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc
index 30d0e5d11d..5545226a20 100644
--- a/nix/nix-daemon/guix-daemon.cc
+++ b/nix/nix-daemon/guix-daemon.cc
@@ -1,6 +1,7 @@
/* GNU Guix --- Functional package management for GNU
Copyright (C) 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
Copyright (C) 2006, 2010, 2012, 2014 Eelco Dolstra <e.dolstra@tudelft.nl>
+ Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
This file is part of GNU Guix.
@@ -90,6 +91,7 @@ builds derivations on behalf of its clients.");
#define GUIX_OPT_MAX_SILENT_TIME 19
#define GUIX_OPT_LOG_COMPRESSION 20
#define GUIX_OPT_DISCOVER 21
+#define GUIX_OPT_SUBSTITUTE_METHODS 22
static const struct argp_option options[] =
{
@@ -114,6 +116,8 @@ static const struct argp_option options[] =
n_("do not use substitutes") },
{ "substitute-urls", GUIX_OPT_SUBSTITUTE_URLS, n_("URLS"), 0,
n_("use URLS as the default list of substitute providers") },
+ { "substitute-methods", GUIX_OPT_SUBSTITUTE_METHODS, n_("METHODS"), 0,
+ n_("use METHODS as the list of substitute methods") },
{ "no-offload", GUIX_OPT_NO_BUILD_HOOK, 0, 0,
n_("do not attempt to offload builds") },
{ "no-build-hook", GUIX_OPT_NO_BUILD_HOOK, 0,
@@ -263,6 +267,9 @@ parse_opt (int key, char *arg, struct argp_state *state)
case GUIX_OPT_NO_SUBSTITUTES:
settings.set ("build-use-substitutes", "false");
break;
+ case GUIX_OPT_SUBSTITUTE_METHODS:
+ settings.set ("substitute-methods", arg);
+ break;
case GUIX_OPT_NO_BUILD_HOOK:
settings.useBuildHook = false;
break;
--
2.30.0
[-- Attachment #1.5: 0004-substitute-Unstub-verify-hash-unknown.patch --]
[-- Type: text/x-patch, Size: 9427 bytes --]
From b0b3f3e339ff834fd973f2f0f0bc7ad9be6ffd04 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 26 Feb 2021 15:30:04 +0100
Subject: [PATCH 4/4] =?UTF-8?q?substitute:=20Unstub=20=E2=80=98verify-hash?=
=?UTF-8?q?/unknown=E2=80=99.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This procedure is called if a substitution method
returns 'unpacked'. While no method does that yet,
it is expected the IPFS and GNUnet substituter will.
* guix/scripts/substitute.scm
(verify-hash/unknown): Unstub procedure.
(process-substitution): When the substituter
returns ‘unpacked’, verify whether we got the right
substitute and canonicalize permissions and timestamps.
* doc/substituters.texi (Defining Substituters): Document the
absence of a requirement for substituters to normalize timestamps
and file permissions.
* tests/substitute.scm (write-string-as-nar): Define procedure,
and use in test cases. Also test that the hash is verified
when a substituter returns 'unpacked'.
---
doc/substituters.texi | 4 +++
guix/scripts/substitute.scm | 43 +++++++++++++++++++----
tests/substitute.scm | 70 ++++++++++++++++++++++++++++++++-----
3 files changed, 102 insertions(+), 15 deletions(-)
diff --git a/doc/substituters.texi b/doc/substituters.texi
index 516e2c1eea..65b1a929b0 100644
--- a/doc/substituters.texi
+++ b/doc/substituters.texi
@@ -47,4 +47,8 @@ are correctly signed and have a correct hash; this is handled
by @code{(guix scripts substitute)}. @var{nar-downloader} and
@var{fetch-narinfos} can be @code{#f} if unimplemented by this
substituter.
+
+Likewise, when returning @code{unpacked}, @var{nar-downloader}
+does not need to normalize timestamps and file permissions.
+
@end deffn
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 78345dce8f..90fd7dd021 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -31,8 +31,10 @@
#:use-module (guix records)
#:use-module (guix diagnostics)
#:use-module (guix i18n)
- #:use-module ((guix serialization) #:select (restore-file dump-file))
+ #:use-module ((guix serialization)
+ #:select (restore-file write-file dump-file))
#:autoload (guix store deduplication) (dump-file/deduplicate)
+ #:autoload (guix store database) (reset-timestamps)
#:autoload (guix scripts discover) (read-substitute-urls)
#:autoload (guix scripts substitute http) (open-connection-for-uri/cached)
#:use-module (gcrypt hash)
@@ -49,6 +51,7 @@
#:use-module ((guix build syscalls)
#:select (set-thread-name))
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 receive)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
@@ -531,11 +534,20 @@ to the narinfo."
(bytevector->nix-base32-string expected)
(bytevector->nix-base32-string actual))))
-(define (verify-hash/unknown . rest)
- ;; Variant of verify-hash where the hash hasn't yet been computed.
- ;; TODO: this will be implemented later in the patch series!
- ;; (To be used by the IPFS and GNUnet substituter)
- (leave (G_ "TODO verify-hash/unknown is unimplemented~%")))
+(define* (verify-hash/unknown file expected algorithm narinfo
+ #:key thunk)
+ "Check whether we got the data announced in the narinfo NARINFO.
+FILE is the actual file we got and EXPECTED is the hash according
+to the narinfo. Call THUNK after FILE was read, but before
+the daemon is informed."
+ ;; Recreate the nar, hash it, and let verify-hash
+ ;; produce the 'success' or 'hash-mismatch' output.
+ (receive (hashed get-hash)
+ (open-hash-port algorithm)
+ (write-file file hashed)
+ (close hashed)
+ (thunk)
+ (verify-hash (get-hash) expected algorithm narinfo)))
(define-syntax-rule (receive* kwargs exp exp* exp** ...)
(call-with-values (lambda () exp)
@@ -606,7 +618,24 @@ the current output port."
(when after-input-close
(after-input-close))
;; Check whether we got the data announced in the NARINFO.
- (verify-hash/unknown destination narinfo))
+ (receive (algorithm expected)
+ (narinfo-hash-algorithm+value narinfo)
+ (verify-hash/unknown
+ destination expected algorithm narinfo
+ ;; Make sure the permissions and timestamps are canonical.
+ ;;
+ ;; This could theoretically be done somewhat more
+ ;; cache-friendly if done in the substitution method,
+ ;; by canonicalising a file right after it has been
+ ;; downloaded, but let's try for correctness first
+ ;; before efficiency.
+ ;;
+ ;; Also, this must be done *after* verifying the hash,
+ ;; in order to make the access time is set correctly.
+ ;;
+ ;; TODO it would be nice to deduplicate DESTINATION.
+ #:thunk
+ (lambda () (reset-timestamps destination)))))
(else
(format (current-error-port) "~s~%" input)
(leave
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 6c754f774d..1cb1a10402 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -324,6 +324,16 @@ System: mips64el-linux\n")
(lambda ()
(guix-substitute "--substitute")))))
+(define (write-string-as-nar port content)
+ (write-file-tree "foo" port
+ #:file-type+size
+ (lambda _
+ (values 'regular
+ (string-length content)))
+ #:file-port
+ (lambda _
+ (open-input-string content))))
+
(test-equal "substitute, invalid hash"
(string-append "hash-mismatch sha256 "
(bytevector->nix-base32-string (sha256 #vu8())) " "
@@ -331,14 +341,7 @@ System: mips64el-linux\n")
(open-hash-port (hash-algorithm sha256)))
((content)
"Substitutable data."))
- (write-file-tree "foo" port
- #:file-type+size
- (lambda _
- (values 'regular
- (string-length content)))
- #:file-port
- (lambda _
- (open-input-string content)))
+ (write-string-as-nar port content)
(close-port port)
(bytevector->nix-base32-string (get-hash)))
"\n")
@@ -367,6 +370,57 @@ System: mips64el-linux\n")))
(lambda ()
(guix-substitute "--substitute"))))))))))
+(test-equal "substitute (unpacked), invalid hash"
+ (string-append "hash-mismatch sha256 "
+ (bytevector->nix-base32-string (sha256 #vu8())) " "
+ (let-values (((port get-hash)
+ (open-hash-port (hash-algorithm sha256)))
+ ((content) "Wrong data!"))
+ (write-string-as-nar port content)
+ (close-port port)
+ (bytevector->nix-base32-string (get-hash)))
+ "\n")
+ (with-output-to-string
+ (lambda ()
+ ;; Arrange so the actual data hash does not match the 'NarHash' field in the
+ ;; narinfo. Use a substituter that does not produce a nar, but rather
+ ;; writes the item to the store by itself.
+ (define narinfo
+ ;; Pretend this hash and size actually correspond to
+ ;; some nar.
+ (string-append "StorePath: " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash
+URL: irrelevant
+Compression: none
+NarHash: sha256:" (bytevector->nix-base32-string (sha256 #vu8())) "
+NarSize: 123
+References:
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n"))
+ (parameterize ((substituters
+ (list
+ (make-substituter
+ 'test
+ (lambda (destination . rest)
+ (call-with-output-file destination
+ (cut display "Wrong data!" <>))
+ 'unpacked)
+ (const
+ (list
+ (string->narinfo
+ (string-append narinfo "Signature: "
+ (signature-field narinfo)
+ "\n")
+ "test://")))
+ '(test))))
+ (substitute-urls '("test://")))
+ (call-with-temporary-directory
+ (lambda (directory)
+ (request-substitution
+ (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ (string-append directory "/wrong-hash"))))))))
+
(test-quit "substitute, unauthorized key"
"no valid substitute"
(with-narinfo (string-append %narinfo "Signature: "
--
2.30.0
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#46800] [PATCH] Allow defining multiple substituters
2021-02-26 17:41 [bug#46800] [PATCH] Allow defining multiple substituters Maxime Devos
@ 2021-03-02 20:37 ` Ludovic Courtès
2021-03-04 7:48 ` Maxime Devos
2021-03-05 20:05 ` Maxime Devos
2021-06-06 17:52 ` Tony Olagbaiye
1 sibling, 2 replies; 6+ messages in thread
From: Ludovic Courtès @ 2021-03-02 20:37 UTC (permalink / raw)
To: Maxime Devos; +Cc: 46800
Hi Maxime,
Maxime Devos <maximedevos@telenet.be> skribis:
> This patch series is my suggestion for allowing
> multiple "substitution methods" or "substituters"
> as I call them. Currently, only a method for HTTP/S
> is defined, though I hope it will be a good basis
> for a common framework for substitutes over GNUnet
> and IPFS.
Thanks for working on this!
As discussed on IRC, the daemon used to have support for multiple
substituters, but as a built-in C++ interface, which I removed in
f6919ebdc6b0ce0286814cc6ab0564b1a4c67f5f.
The Scheme interface you propose is of course nicer :-), but I’m still
not sure it’s necessary. For example, in the IPFS prototype at
<https://issues.guix.gnu.org/33899>, IPFS support goes hand in hand with
HTTP support: narinfos are retrieved over HTTP and nars can be retrieved
over IPFS, or HTTP. Likewise with “digests”:
<https://lists.gnu.org/archive/html/guix-devel/2021-01/msg00080.html>.
Another issue is that it may be that, instead of letting users choose
one method and stick to it, we’d rather let them choose a policy that
can automatically pick the “best” method, dynamically adjusting choices.
All in all, I would prefer to wait until there’s a clear need for this
abstraction.
WDYT?
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#46800] [PATCH] Allow defining multiple substituters
2021-03-02 20:37 ` Ludovic Courtès
@ 2021-03-04 7:48 ` Maxime Devos
2021-03-12 17:37 ` Ludovic Courtès
2021-03-05 20:05 ` Maxime Devos
1 sibling, 1 reply; 6+ messages in thread
From: Maxime Devos @ 2021-03-04 7:48 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 46800
[-- Attachment #1: Type: text/plain, Size: 6402 bytes --]
On Tue, 2021-03-02 at 21:37 +0100, Ludovic Courtès wrote:
> Hi Maxime,
>
> Maxime Devos <maximedevos@telenet.be> skribis:
>
> > This patch series is my suggestion for allowing
> > multiple "substitution methods" or "substituters"
> > as I call them. Currently, only a method for HTTP/S
> > is defined, though I hope it will be a good basis
> > for a common framework for substitutes over GNUnet
> > and IPFS.
>
> Thanks for working on this!
>
> As discussed on IRC, the daemon used to have support for multiple
> substituters, but as a built-in C++ interface, which I removed in
> f6919ebdc6b0ce0286814cc6ab0564b1a4c67f5f.
Was there any particular reason this support was removed, beyond
moving from C++ to Scheme and the absence of any alternative substituters?
> The Scheme interface you propose is of course nicer :-), but I’m still
> not sure it’s necessary. For example, in the IPFS prototype at
> <https://issues.guix.gnu.org/33899>;, IPFS support goes hand in hand with
> HTTP support: narinfos are retrieved over HTTP and nars can be retrieved
> over IPFS, or HTTP.
About X going hand-in-hand with Y:
Note that fetching narinfos, or fetching the nar itself are separated
A method can support both procedures, or just one of them (or none,
but that's rather useless.)
Users (well, the system administrator) can choose multiple methods, which
will be each fetch narinfos after each other & combine the
results into
one large list (or maybe some other data structure, I don't recall the
details), and each substituter will be asked to produce
a nar until a substituter
succeeds or all have said "sorry, I don't have that nar".
(That's different from C++ interface for multiple substituters I think, where
the methods are only tried sequentialy, they aren't combined.)
In case of IPFS, the idea is that *both* the IPFS and HTTP substituter are
enabled, in that order: "--substitute-methods=ipfs http". The IPFS substituter
won't be able to produce any narinfos by itself, but that's no problem as
the HTTP substituter can find some. Then, the IPFS substituter will be asked
first to download a substitute, as it's first in the "--substitute-methods" list.
And what if the narinfo doesn't have a IPFS URI, as the substitute server doesn't
support that? Then "guix substitute" automatically fall-backs to HTTP.
Summary: some substitution methods can't do everything on their own, but that's ok,
as "guix substitute" will just ask them to try what they can and will see if some
combination of methods works.
About ‘not sure it's necessary’: there presumably will be a GNUnet substituter
at some point. I suppose it would be possible to define all substitute methods
in (guix scripts substitute), but then you would still end up with a procedure
that tries all methods (e.g. in wip-ipfs-substitutes, process-substitution has
an "if" structures that tries downloading via IPFS with fall-back to HTTP; this
would become a (cond (ipfs? ipfs-code) (gnunet? gnunet-code) (#t http-code?))
Note that there's (guix scripts import X) and (guix build-system X).
> Likewise with “digests”: <https://lists.gnu.org/archive/html/guix-devel/2021-01/msg00080.html>;.
I haven't taken a close look at this yet before (I haven't been around guix
development for long). To me, this seems compatible with this patch actually.
The HTTP substituter's procedure for downloading the substitute itself
(process-substitution/http in my patch) could be split in two, and look
at the narinfo to see whether the 'digest' or the usual mechanism should be used.
Alternatively, one could define *two* substituters: the ‘standard’ http substituter
‘http’, and the ‘http-digest’ substituter that can't fetch narinfo's, but rather
is an alternative method for downloading the substitute. The daemon can be started
with "--substitute-methods http-digest http" to prefer downloading via the ‘http-digest’
method when possible, but uses ‘http’ for the narinfos and as a fallback for when the
narinfo does not have a digest.
But what if a non-HTTP substituter wants to use digests? Well, I don't know any such
substituters (-:. But for the (hypothetical) GNUnet substituter & the wip IPFS
substituter, I don't think they will use the digests code.
> Another issue is that it may be that, instead of letting users choose
> one method and stick to it,
They (at least the system administrator) can choose a list of substituters,
see above.
> we’d rather let them choose a policy that
> can automatically pick the “best” method, dynamically adjusting choices.
Who's the user here?
(a) the system administrator, who configuring the daemon to use a certain
list of substituters and defines a default list of substitute uris.
(b) the ‘user’, that doesn't directly have the capability to modify
the system's guix daemon (or possibly an administrator that wants to
to test some things out without the possibility of accidentally messing
up the ‘real’ system).
If (b), I think it would be ideal to give the (unprivileged) user the
possibility of using their own substituter(s) (under their own capabilities,
not root), albeit at the cost of the guix daemon having to verify the narhash
& narinfo signature.
That could be implemented as a separate patch (though this patch would need
to be rebased then). WDYT? Would be useful for developing new substituters
and testing them, I think.
About *automatically* dynamically adjusting choices: would be nice, but how is
this supposed to work? Any ideas? The only thing I could think of is a
allowing the user to choose which narinfo to use (e.g. from the list of found
narinfos try to choose a narinfo that has an IPFS URI).
Also, for (a) the shepherd service could use a "set-substitute-methods" option,
and perhaps the user (b) could be allowed to select a subset of these substitute
methods to use when running "guix build PACKAGE" and the like (but only a subset,
as "guix substitute" when invoked by the daemon runs as root and therefore the
potential attack surface shouldn't be increased beyond what the administrator
allows).
> All in all, I would prefer to wait until there’s a clear need for this
> abstraction.
See above responses.
WDYT?
Thanks,
Maxime.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#46800] [PATCH] Allow defining multiple substituters
2021-03-02 20:37 ` Ludovic Courtès
2021-03-04 7:48 ` Maxime Devos
@ 2021-03-05 20:05 ` Maxime Devos
1 sibling, 0 replies; 6+ messages in thread
From: Maxime Devos @ 2021-03-05 20:05 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 46800
[-- Attachment #1: Type: text/plain, Size: 1374 bytes --]
On Tue, 2021-03-02 at 21:37 +0100, Ludovic Courtès wrote:
> Hi Maxime,
>
> Maxime Devos <maximedevos@telenet.be> skribis:
>
> > This patch series is my suggestion for allowing
> > multiple "substitution methods" or "substituters"
> > as I call them. Currently, only a method for HTTP/S
> > is defined, though I hope it will be a good basis
> > for a common framework for substitutes over GNUnet
> > and IPFS.
>
> [Ludovic's reply]
(See previous mail for my responses)
FYI: I've implemented a GNUnet substituter using this patch series
and the "publish hooks" patch (+ an unsubmitted patch that passes
some extra information to the publish hook) here:
https://notabug.org/mdevos/guix-gnunet/src/download-hooks3
(Warning: it does some questionable things with add-to-load-path.
Will hopefully be fixed eventually. Also requires
<https://notabug.org/mdevos/scheme-gnunet> in a special location.)
Also, there's a bug in fetch-narinfos that causes an error if
the "fetch-narinfos" field of a subtituter is #f. Also,
recognised-uri-scheme should be removed or reworked, as otherwise
the IPFS and GNUnet substituter won't be used for downloading a
substitute if http and https are not in the list.
I've worked around that for now by setting the latter '(http https file),
and setting the former to (const '()).
Greetings,
Maxime.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#46800] [PATCH] Allow defining multiple substituters
2021-03-04 7:48 ` Maxime Devos
@ 2021-03-12 17:37 ` Ludovic Courtès
0 siblings, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2021-03-12 17:37 UTC (permalink / raw)
To: Maxime Devos; +Cc: 46800
Hi Maxime,
Maxime Devos <maximedevos@telenet.be> skribis:
> On Tue, 2021-03-02 at 21:37 +0100, Ludovic Courtès wrote:
[...]
>> As discussed on IRC, the daemon used to have support for multiple
>> substituters, but as a built-in C++ interface, which I removed in
>> f6919ebdc6b0ce0286814cc6ab0564b1a4c67f5f.
>
> Was there any particular reason this support was removed, beyond
> moving from C++ to Scheme and the absence of any alternative substituters?
These were the main reasons, yes.
>> The Scheme interface you propose is of course nicer :-), but I’m still
>> not sure it’s necessary. For example, in the IPFS prototype at
>> <https://issues.guix.gnu.org/33899>;, IPFS support goes hand in hand with
>> HTTP support: narinfos are retrieved over HTTP and nars can be retrieved
>> over IPFS, or HTTP.
>
> About X going hand-in-hand with Y:
>
> Note that fetching narinfos, or fetching the nar itself are separated
> A method can support both procedures, or just one of them (or none,
> but that's rather useless.)
>
> Users (well, the system administrator) can choose multiple methods, which
> will be each fetch narinfos after each other & combine the
> results into
> one large list (or maybe some other data structure, I don't recall the
> details), and each substituter will be asked to produce
> a nar until a substituter
> succeeds or all have said "sorry, I don't have that nar".
OK.
> (That's different from C++ interface for multiple substituters I think, where
> the methods are only tried sequentialy, they aren't combined.)
>
> In case of IPFS, the idea is that *both* the IPFS and HTTP substituter are
> enabled, in that order: "--substitute-methods=ipfs http". The IPFS substituter
> won't be able to produce any narinfos by itself, but that's no problem as
> the HTTP substituter can find some. Then, the IPFS substituter will be asked
> first to download a substitute, as it's first in the "--substitute-methods" list.
>
> And what if the narinfo doesn't have a IPFS URI, as the substitute server doesn't
> support that? Then "guix substitute" automatically fall-backs to HTTP.
>
> Summary: some substitution methods can't do everything on their own, but that's ok,
> as "guix substitute" will just ask them to try what they can and will see if some
> combination of methods works.
Alright.
> About ‘not sure it's necessary’: there presumably will be a GNUnet substituter
> at some point. I suppose it would be possible to define all substitute methods
> in (guix scripts substitute), but then you would still end up with a procedure
> that tries all methods (e.g. in wip-ipfs-substitutes, process-substitution has
> an "if" structures that tries downloading via IPFS with fall-back to HTTP; this
> would become a (cond (ipfs? ipfs-code) (gnunet? gnunet-code) (#t http-code?))
I guess considerations that are more important to me (and to users, I
suppose) now than a few years back are maintainability and robustness.
Concretely, I wouldn’t want Guix to offer out of the box 4 methods, 3 of
which perform poorly or are downright buggy. I think it would be more
fruitful if, as a project, we would focus on one or two methods or
method combinations that we have battle-tested, perform well, and a nice
long-term maintenance story, and so on.
[...]
>> we’d rather let them choose a policy that
>> can automatically pick the “best” method, dynamically adjusting choices.
>
> Who's the user here?
> (a) the system administrator, who configuring the daemon to use a certain
> list of substituters and defines a default list of substitute uris.
> (b) the ‘user’, that doesn't directly have the capability to modify
> the system's guix daemon (or possibly an administrator that wants to
> to test some things out without the possibility of accidentally messing
> up the ‘real’ system).
I think (b) should be possible, just like users can pass
‘--substitute-urls’.
[...]
> About *automatically* dynamically adjusting choices: would be nice, but how is
> this supposed to work? Any ideas? The only thing I could think of is a
> allowing the user to choose which narinfo to use (e.g. from the list of found
> narinfos try to choose a narinfo that has an IPFS URI).
I think it’ll have to be fine-tuned once we have several stable
substitute methods. After all, we have yet to figure out how to choose
between zstd and lzip for the current substitution mechanism; the
tradeoffs when very different methods are in use may be more complex!
>> All in all, I would prefer to wait until there’s a clear need for this
>> abstraction.
>
> See above responses.
I don’t think my concerns are really addressed :-), but at the same time
I think we need a playground for these things so we can actually grow
new substitute methods like those you’ve been looking at. Hmmm tricky!
Ludo’.
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#46800] [PATCH] Allow defining multiple substituters
2021-02-26 17:41 [bug#46800] [PATCH] Allow defining multiple substituters Maxime Devos
2021-03-02 20:37 ` Ludovic Courtès
@ 2021-06-06 17:52 ` Tony Olagbaiye
1 sibling, 0 replies; 6+ messages in thread
From: Tony Olagbaiye @ 2021-06-06 17:52 UTC (permalink / raw)
To: 46800@debbugs.gnu.org
[-- Attachment #1.1.1: Type: text/plain, Size: 42 bytes --]
Hi, any news on this patch?
Thanks,
ix
[-- Attachment #1.1.2.1: Type: text/html, Size: 92 bytes --]
[-- Attachment #1.2: publickey - me@fron.io - 0x3026807C.asc --]
[-- Type: application/pgp-keys, Size: 637 bytes --]
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 249 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2021-06-06 18:43 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-02-26 17:41 [bug#46800] [PATCH] Allow defining multiple substituters Maxime Devos
2021-03-02 20:37 ` Ludovic Courtès
2021-03-04 7:48 ` Maxime Devos
2021-03-12 17:37 ` Ludovic Courtès
2021-03-05 20:05 ` Maxime Devos
2021-06-06 17:52 ` Tony Olagbaiye
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).