3 files changed, 71 insertions, 33 deletions

diff --git a/guix/narinfo.scm b/guix/narinfo.scm
index a149d9a9017..49f7c14bb37 100644
--- a/guix/narinfo.scm
+++ b/guix/narinfo.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022, 2026 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
 ;;;
@@ -25,6 +25,8 @@
   #:use-module (guix base64)
   #:use-module (guix records)
   #:use-module (guix diagnostics)
+  #:autoload   (guix store) (valid-path-syntax?
+                             valid-path-basename-syntax?)
   #:use-module (gcrypt hash)
   #:use-module (gcrypt pk-crypto)
   #:use-module (rnrs bytevectors)
@@ -140,32 +142,39 @@ must contain the original contents of a narinfo file."
                 signature)
     "Return a new <narinfo> object."
     (define len (length urls))
-    (%make-narinfo path cache-url
-                   ;; Handle the case where URL is a relative URL.
-                   (map (lambda (url)
-                          (or (string->uri url)
-                              (string->uri
-                               (if (string-suffix? "/" cache-url)
-                                   (string-append cache-url url)
-                                   (string-append cache-url "/" url)))))
-                        urls)
-                   compressions
-                   (match file-sizes
-                     (()        (make-list len #f))
-                     ((lst ...) (map string->number lst)))
-                   (match file-hashes
-                     (()        (make-list len #f))
-                     ((lst ...) (map string->number lst)))
-                   nar-hash
-                   (and=> nar-size string->number)
-                   (string-tokenize references)
-                   (match deriver
+    (let ((references (string-tokenize references))
+          (deriver (match deriver
                      ((or #f "") #f)
-                     (_ deriver))
-                   system
-                   (false-if-exception
-                    (and=> signature narinfo-signature->canonical-sexp))
-                   str)))
+                     (_ deriver))))
+      ;; Return #f if PATH, REFERENCES, or DERIVER is malformed.
+      (and (valid-path-syntax? path)
+           (every valid-path-basename-syntax? references)
+           (or (not deriver)
+               (valid-path-basename-syntax? deriver))
+           (%make-narinfo path cache-url
+                          ;; Handle the case where URL is a relative URL.
+                          (map (lambda (url)
+                                 (or (string->uri url)
+                                     (string->uri
+                                      (if (string-suffix? "/" cache-url)
+                                          (string-append cache-url url)
+                                          (string-append cache-url "/" url)))))
+                               urls)
+                          compressions
+                          (match file-sizes
+                            (()        (make-list len #f))
+                            ((lst ...) (map string->number lst)))
+                          (match file-hashes
+                            (()        (make-list len #f))
+                            ((lst ...) (map string->number lst)))
+                          nar-hash
+                          (and=> nar-size string->number)
+                          references
+                          deriver
+                          system
+                          (false-if-exception
+                           (and=> signature narinfo-signature->canonical-sexp))
+                          str)))))
 
 (define fields->alist
   ;; The narinfo format is really just like recutils.
@@ -176,6 +185,8 @@ must contain the original contents of a narinfo file."
   "Read a narinfo from PORT.  If URL is true, it must be a string used to
 build full URIs from relative URIs found while reading PORT.  When SIZE is
 true, read at most SIZE bytes from PORT; otherwise, read as much as possible.
+Return #f if the narinfo that was read is not syntactically valid, for
+instance if it contains invalid store file names.
 
 No authentication and authorization checks are performed here!"
   (let ((str (utf8->string (if size
@@ -253,8 +264,8 @@ unauthorized party~%"
   (call-with-output-string (cut write-narinfo narinfo <>)))
 
 (define (string->narinfo str cache-uri)
-  "Return the narinfo represented by STR.  Assume CACHE-URI as the base URI of
-the cache STR originates form."
+  "Return the narinfo represented by STR or #f if it is not syntactically
+valid.  Assume CACHE-URI as the base URI of the cache STR originates form."
   (call-with-input-string str (cut read-narinfo <> cache-uri)))
 
 (define (equivalent-narinfo? narinfo1 narinfo2)
diff --git a/guix/substitutes.scm b/guix/substitutes.scm
index df4677ab7d4..b2a79c2a48d 100644
--- a/guix/substitutes.scm
+++ b/guix/substitutes.scm
@@ -193,7 +193,8 @@ indicates that PATH is unavailable at CACHE-URL."
 
 (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."
+if file doesn't exist or if the narinfo read is not syntactically valid--e.g.,
+it contains invalid store file names--and return the narinfo otherwise."
   (catch 'system-error
     (lambda ()
       (call-with-input-file file
@@ -239,8 +240,7 @@ if file doesn't exist, and the narinfo otherwise."
       ;; 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))
+            (if narinfo
                 (begin
                   (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
                   (cons narinfo result))
@@ -324,7 +324,10 @@ for PATH."
              ;; A cached positive lookup
              (if (obsolete? date now ttl)
                  (values #f #f)
-                 (values #t (string->narinfo value cache-uri))))
+                 (let ((narinfo (string->narinfo value cache-uri)))
+                   (if narinfo
+                       (values #t narinfo)
+                       (values #f #f)))))
             (('narinfo ('version v) _ ...)
              (values #f #f))
             ((? eof-object?)                      ;corrupt file
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 6837e7e868e..8f32bfa7281 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014-2015, 2017-2019, 2021-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2015, 2017-2019, 2021-2023, 2026 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -333,6 +333,30 @@ Deriver: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo.drv")
              (lambda ()
                (guix-substitute "--query")))))))))
 
+(test-equal "query narinfo that contains invalid store path"
+  ;; The signature covers the StorePath/NarHash/References tuple, so it is
+  ;; valid, but the 'StorePath' field is invalid (contains forbidden
+  ;; characters).
+  ""
+
+  (let ((prefix (string-append "StorePath: " (%store-prefix)
+                               "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo/../../../etc/passwd
+NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+References: bar baz\n")))
+    (with-narinfo (string-append prefix
+                                 "Signature: " (signature-field prefix) "
+URL: example.nar
+Compression: none
+NarSize: 42
+Deriver: foo.drv")
+      (string-trim-both
+       (with-output-to-string
+         (lambda ()
+           (with-input-from-string (string-append "have " (%store-prefix)
+                                                  "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+             (lambda ()
+               (guix-substitute "--query")))))))))
+
 (test-equal "query narinfo signed with authorized key"
   (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")