01/17: locate: Ignore unreadable manifests.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit e1c2c2f042e8741c0759e21e634cd2271e078177
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Jul 8 22:16:40 2023 +0200

    locate: Ignore unreadable manifests.
    
    Fixes <https://issues.guix.gnu.org/64187>.
    
    * guix/scripts/locate.scm (profiles->manifest-entries): Wrap
    'profile-manifest' in 'false-if-exception'.
    
    Reported-by: Ricardo Wurmus <rekado@elephly.net>
---
 guix/scripts/locate.scm | 31 ++++++++++++++++++-------------
 1 file changed, 18 insertions(+), 13 deletions(-)

diff --git a/guix/scripts/locate.scm b/guix/scripts/locate.scm
index aeaffa3d34..79af533fd9 100644
--- a/guix/scripts/locate.scm
+++ b/guix/scripts/locate.scm
@@ -418,19 +418,24 @@ for each package to insert."
       (()
        entries)
       ((profile . rest)
-       (let* ((manifest (profile-manifest profile))
-              (entries visited
-                       (fold2 (lambda (entry lst visited)
-                                (let ((item (manifest-entry-item entry)))
-                                  (if (set-contains? visited item)
-                                      (values lst visited)
-                                      (values (cons entry lst)
-                                              (set-insert item
-                                                          visited)))))
-                              entries
-                              visited
-                              (manifest-transitive-entries manifest))))
-         (loop visited rest entries))))))
+       (match (false-if-exception (profile-manifest profile))
+         (#f
+          ;; PROFILE's manifest is unreadable for some reason such as an
+          ;; unsupported version.
+          (loop visited rest entries))
+         (manifest
+          (let ((entries visited
+                         (fold2 (lambda (entry lst visited)
+                                  (let ((item (manifest-entry-item entry)))
+                                    (if (set-contains? visited item)
+                                        (values lst visited)
+                                        (values (cons entry lst)
+                                                (set-insert item
+                                                            visited)))))
+                                entries
+                                visited
+                                (manifest-transitive-entries manifest))))
+            (loop visited rest entries))))))))
 
 (define (insert-manifest-entry db entry)
   "Insert a manifest ENTRY into DB."