~ruther/guix-local: perform-download: Ensure reading never evaluates code.

2a333541e8f1907ae0bc80cf500a99567ca46d08 — Reepca Russelstein 8 months ago 43bb79f

perform-download: Ensure reading never evaluates code.

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>

patch browse .tar.gz

1 files changed, 19 insertions(+), 8 deletions(-)

M guix/scripts/perform-download.scm

M guix/scripts/perform-download.scm => guix/scripts/perform-download.scm +19 -8

@@ 43,6 43,11 @@
   (let ((module (make-fresh-user-module)))
     (module-use! module (resolve-interface '(guix base32)))
     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
                            #:key print-build-trace?)


@@ 60,7 65,7 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
     (unless url
       (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"))
            (algo       (derivation-output-hash-algo 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
                             (and download-methods
                                  (call-with-input-string download-methods
-                                   read))))
+                                   read/safe))))
               (url-fetch url output
                          #:print-build-trace? print-build-trace?
                          #:mirrors (if mirrors
-                                       (call-with-input-file mirrors read)
+                                       (call-with-input-file mirrors read/safe)
                                        '())
                          #:content-addressed-mirrors
                          (if content-addressed-mirrors
                              (call-with-input-file content-addressed-mirrors
                                (lambda (port)
-                                 (eval (read port) %user-module)))
+                                 (eval (read/safe port) %user-module)))
                              '())
                          #:disarchive-mirrors
                          (if disarchive-mirrors
-                             (call-with-input-file disarchive-mirrors read)
+                             (call-with-input-file disarchive-mirrors read/safe)
                              '())
                          #:hashes `((,algo . ,hash))
 


@@ 108,9 113,9 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
     (unless commit
       (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?
-                            (call-with-input-string recursive? read)))
+                            (call-with-input-string recursive? read/safe)))
            (drv-output (assoc-ref (derivation-outputs drv) "out"))
            (algo       (derivation-output-hash-algo 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
                       (and download-methods
                            (call-with-input-string download-methods
-                             read))))
+                             read/safe))))
         ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are
         ;; different, hence the #:item argument below.
         (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)
       (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
   ;; prevent things downloading from 'file:///etc/shadow' or arbitrary code
   ;; execution via the content-addressed mirror procedures.  (That means we