amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

perform-download: Ensure reading never evaluates code.

Browse source 
Since this is used to implement the "download" and "git-download" builtins,
which are run outside of any chroot, this is trusted code with respect to the
user-supplied strings it reads.

* guix/scripts/perform-download.scm (read/safe): new procedure.
  (perform-download, perform-git-download): use it.
  (guix-perform-download): explicitly set 'read-eval?' to #f and
  'read-hash-procedures' to '().  #f is the default value of 'read-eval?' on
  startup, but set it anyway to be certain.

Change-Id: I93cb8e32607a6f9a559a26c1cbd6b88212ead884
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Reepca Russelstein 2025-07-24 17:35:37 -05:00 • committed by Ludovic Courtès
parent 43bb79fc29
commit 2a333541e8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 19 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

27
guix/scripts/perform-download.scm
View file

@ -43,6 +43,11 @@
(let ((module (make-fresh-user-module))) (let ((module (make-fresh-user-module)))
(module-use! module (resolve-interface '(guix base32))) (module-use! module (resolve-interface '(guix base32)))
module)) module))
(define* (read/safe #:optional (port (current-input-port)))
(with-fluids ((read-eval? #f))
(parameterize ((read-hash-procedures '()))
(read port))))
(define* (perform-download drv output (define* (perform-download drv output
#:key print-build-trace?) #:key print-build-trace?)
@ -60,7 +65,7 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
(unless url (unless url
(leave (G_ "~a: missing URL~%") (derivation-file-name drv))) (leave (G_ "~a: missing URL~%") (derivation-file-name drv)))
(let* ((url (call-with-input-string url read)) (let* ((url (call-with-input-string url read/safe))
(drv-output (assoc-ref (derivation-outputs drv) "out")) (drv-output (assoc-ref (derivation-outputs drv) "out"))
(algo (derivation-output-hash-algo drv-output)) (algo (derivation-output-hash-algo drv-output))
(hash (derivation-output-hash drv-output))) (hash (derivation-output-hash drv-output)))
@ -68,21 +73,21 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
(when (parameterize ((%download-methods (when (parameterize ((%download-methods
(and download-methods (and download-methods
(call-with-input-string download-methods (call-with-input-string download-methods
read)))) read/safe))))
(url-fetch url output (url-fetch url output
#:print-build-trace? print-build-trace? #:print-build-trace? print-build-trace?
#:mirrors (if mirrors #:mirrors (if mirrors
(call-with-input-file mirrors read) (call-with-input-file mirrors read/safe)
'()) '())
#:content-addressed-mirrors #:content-addressed-mirrors
(if content-addressed-mirrors (if content-addressed-mirrors
(call-with-input-file content-addressed-mirrors (call-with-input-file content-addressed-mirrors
(lambda (port) (lambda (port)
(eval (read port) %user-module))) (eval (read/safe port) %user-module)))
'()) '())
#:disarchive-mirrors #:disarchive-mirrors
(if disarchive-mirrors (if disarchive-mirrors
(call-with-input-file disarchive-mirrors read) (call-with-input-file disarchive-mirrors read/safe)
'()) '())
#:hashes `((,algo . ,hash)) #:hashes `((,algo . ,hash))
@ -108,9 +113,9 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
(unless commit (unless commit
(leave (G_ "~a: missing Git commit~%") (derivation-file-name drv))) (leave (G_ "~a: missing Git commit~%") (derivation-file-name drv)))
(let* ((url (call-with-input-string url read)) (let* ((url (call-with-input-string url read/safe))
(recursive? (and recursive? (recursive? (and recursive?
(call-with-input-string recursive? read))) (call-with-input-string recursive? read/safe)))
(drv-output (assoc-ref (derivation-outputs drv) "out")) (drv-output (assoc-ref (derivation-outputs drv) "out"))
(algo (derivation-output-hash-algo drv-output)) (algo (derivation-output-hash-algo drv-output))
(hash (derivation-output-hash drv-output))) (hash (derivation-output-hash drv-output)))
@ -123,7 +128,7 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
(parameterize ((%download-methods (parameterize ((%download-methods
(and download-methods (and download-methods
(call-with-input-string download-methods (call-with-input-string download-methods
read)))) read/safe))))
;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are
;; different, hence the #:item argument below. ;; different, hence the #:item argument below.
(git-fetch-with-fallback url commit output (git-fetch-with-fallback url commit output
@ -153,6 +158,12 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
(#f #f) (#f #f)
(str (string-contains str "print-extended-build-trace=1")))) (str (string-contains str "print-extended-build-trace=1"))))
;; We read untrusted input, best to be sure this is #f!
(fluid-set! read-eval? #f)
;; ... and out of an abundance of caution, remove the ability to use '#.'
;; constructs entirely
(read-hash-procedures '())
;; This program must be invoked by guix-daemon under an unprivileged UID to ;; This program must be invoked by guix-daemon under an unprivileged UID to
;; prevent things downloading from 'file:///etc/shadow' or arbitrary code ;; prevent things downloading from 'file:///etc/shadow' or arbitrary code
;; execution via the content-addressed mirror procedures. (That means we ;; execution via the content-addressed mirror procedures. (That means we