store: Add 'find-roots' RPC.

* guix/serialization.scm (read-string-pairs): New procedure.
* guix/store.scm (read-arg): Add support for 'string-pairs'.
(find-roots): New procedure.
* tests/store.scm ("add-indirect-root and find-roots"): New test.

guix/serialization.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,7 +34,7 @@ (define-module (guix serialization)
             write-bytevector write-string
             read-string read-latin1-string read-maybe-utf8-string
             write-string-list read-string-list
-            write-string-pairs
+            write-string-pairs read-string-pairs
             write-store-path read-store-path
             write-store-path-list read-store-path-list
             (dump . dump-port*)
@@ -166,6 +166,14 @@ (define (write-string-list l p)
   (write-int (length l) p)
   (for-each (cut write-string <> p) l))
 
+(define (read-string-list p)
+  (let ((len (read-int p)))
+    (unfold (cut >= <> len)
+            (lambda (i)
+              (read-string p))
+            1+
+            0)))
+
 (define (write-string-pairs l p)
   (write-int (length l) p)
   (for-each (match-lambda
@@ -174,11 +182,11 @@ (define (write-string-pairs l p)
               (write-string second p)))
             l))
 
-(define (read-string-list p)
+(define (read-string-pairs p)
   (let ((len (read-int p)))
     (unfold (cut >= <> len)
             (lambda (i)
-              (read-string p))
+              (cons (read-string p) (read-string p)))
             1+
             0)))
 

guix/store.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
@@ -114,6 +114,7 @@ (define-module (guix store)
             query-failed-paths
             clear-failed-paths
             ensure-path
+            find-roots
             add-temp-root
             add-indirect-root
             add-permanent-root
@@ -340,7 +341,8 @@ (define-syntax write-arg
      (write-string (bytevector->base16-string arg) p))))
 
 (define-syntax read-arg
-  (syntax-rules (integer boolean string store-path store-path-list string-list
+  (syntax-rules (integer boolean string store-path
+                 store-path-list string-list string-pairs
                  substitutable-path-list path-info base16)
     ((_ integer p)
      (read-int p))
@@ -354,6 +356,8 @@ (define-syntax read-arg
      (read-store-path-list p))
     ((_ string-list p)
      (read-string-list p))
+    ((_ string-pairs p)
+     (read-string-pairs p))
     ((_ substitutable-path-list p)
      (read-substitutable-path-list p))
     ((_ path-info p)
@@ -1404,6 +1408,15 @@ (define-operation (ensure-path (store-path path))
 to call ADD-TEMP-ROOT on that store path."
   boolean)
 
+(define-operation (find-roots)
+  "Return a list of root/target pairs: for each pair, the first element is the
+GC root file name and the second element is its target in the store.
+
+When talking to a local daemon, this operation is equivalent to the 'gc-roots'
+procedure in (guix store roots), except that the 'find-roots' excludes
+potential roots that do not point to store items."
+  string-pairs)
+
 (define-operation (add-temp-root (store-path path))
   "Make PATH a temporary root for the duration of the current session.
 Return #t."

tests/store.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -201,6 +201,17 @@ (define %shell
 ;;          (valid-path? %store p1)
 ;;          (member (pk p2) (live-paths %store)))))
 
+(test-assert "add-indirect-root and find-roots"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let* ((item (add-text-to-store %store "something" (random-text)))
+            (root (string-append directory "/gc-root")))
+       (symlink item root)
+       (add-indirect-root %store root)
+       (let ((result (member (cons root item) (find-roots %store))))
+         (delete-file root)
+         result)))))
+
 (test-assert "permanent root"
   (let* ((p  (with-store store
                (let ((p (add-text-to-store store "random-text"