[bug#54723] [PATCH] Check URI when verifying narinfo validity.

[Guillaume Le Vaillant <glv@posteo.net>]

[-- Attachment #1.1: Type: text/plain, Size: 2981 bytes --]

When trying to upgrade a machine using a substitute server on the same
LAN, I get this crash a lot:

--8<---------------cut here---------------start------------->8---
# guix system reconfigure --substitute-urls="http://192.168.0.22:8080 https://ci.guix.gnu.org" /etc/guix/config.scm
substitute: mise à jour des substituts depuis « http://192.168.0.22:8080 »... 100.0 %
substitute: Backtrace:
substitute: In ice-9/boot-9.scm:
substitute:   1752:10 17 (with-exception-handler _ _ #:unwind? _ # _)
substitute: In unknown file:
substitute:           16 (apply-smob/0 #<thunk 7fe08afb72e0>)
substitute: In ice-9/boot-9.scm:
substitute:     724:2 15 (call-with-prompt _ _ #<procedure default-prompt-handle…>)
substitute: In ice-9/eval.scm:
substitute:     619:8 14 (_ #(#(#<directory (guile-user) 7fe08afbcc80>)))
substitute: In guix/ui.scm:
substitute:    2209:7 13 (run-guix . _)
substitute:   2172:10 12 (run-guix-command _ . _)
substitute: In ice-9/boot-9.scm:
substitute:   1752:10 11 (with-exception-handler _ _ #:unwind? _ # _)
substitute:   1752:10 10 (with-exception-handler _ _ #:unwind? _ # _)
substitute: In guix/scripts/substitute.scm:
substitute:    757:18  9 (_)
substitute:    348:26  8 (process-query #<output: file 4> _ #:cache-urls _ #:acl _)
substitute: In guix/substitutes.scm:
substitute:    369:45  7 (lookup-narinfos/diverse _ _ #<procedure 7fe088c9cbc0 …> …)
substitute: In unknown file:
substitute:            6 (filter #<procedure 7fe088c9cbc0 at guix/scripts/subst…> …)
substitute: In guix/narinfo.scm:
substitute:    215:32  5 (valid-narinfo? _ _ #:verbose? _)
substitute: In ice-9/boot-9.scm:
substitute:   1685:16  4 (raise-exception _ #:continuable? _)
substitute:   1685:16  3 (raise-exception _ #:continuable? _)
substitute:   1780:13  2 (_ #<&compound-exception components: (#<&assertion-fail…>)
substitute:   1685:16  1 (raise-exception _ #:continuable? _)
substitute:   1685:16  0 (raise-exception _ #:continuable? _)
substitute: 
substitute: ice-9/boot-9.scm:1685:16: In procedure raise-exception:
substitute: In procedure car: Wrong type argument in position 1 (expecting pair): ()
guix system: erreur : `/gnu/store/wgygsxcdy1z3pfvwhpgyl5vjp4xvwhhh-guix-1.3.0-23.a27e47f/bin/guix substitute' died unexpectedly
--8<---------------cut here---------------end--------------->8---

It looks like the 'narinfo-uri' field is an empty list instead of a list
of URIs. Is that supposed to be possible?
Does the the attached patch adding a check for the validity of
this field in the 'valid-narinfo?' function make sense?


The substitute server configuration is:

--8<---------------cut here---------------start------------->8---
(service guix-publish-service-type
         (guix-publish-configuration
          (host "0.0.0.0")
          (port 8080)
          (compression '(("zstd" 3)))
          (advertise? #t)))
--8<---------------cut here---------------end--------------->8---

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-narinfo-Check-URI-when-verifying-narinfo-validity.patch --]
[-- Type: text/x-patch, Size: 1295 bytes --]

From 8d9a45b2f38809fb3acfacf6f83532b7b556e78c Mon Sep 17 00:00:00 2001
From: Guillaume Le Vaillant <glv@posteo.net>
Date: Tue, 5 Apr 2022 11:50:48 +0200
Subject: [PATCH] narinfo: Check URI when verifying narinfo validity.

* guix/narinfo.scm (valid-narinfo?): Check if the 'uri' field is valid.
---
 guix/narinfo.scm | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/guix/narinfo.scm b/guix/narinfo.scm
index 4fc550aa6c..466ce20deb 100644
--- a/guix/narinfo.scm
+++ b/guix/narinfo.scm
@@ -209,11 +209,13 @@ (define %mandatory-fields
 
 (define* (valid-narinfo? narinfo #:optional (acl (current-acl))
                          #:key verbose?)
-  "Return #t if NARINFO's signature is not valid."
+  "Return #t if NARINFO's signature is valid."
   (let ((hash      (narinfo-sha256 narinfo))
         (signature (narinfo-signature narinfo))
-        (uri       (uri->string (first (narinfo-uris narinfo)))))
-    (and hash signature
+        (uri       (if (null? (narinfo-uris narinfo))
+                       #f
+                       (uri->string (first (narinfo-uris narinfo))))))
+    (and hash signature uri
          (signature-case (signature hash acl)
            (valid-signature #t)
            (invalid-signature
-- 
2.35.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]