aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-01-21 16:06:10 +0100
committerLudovic Courtès <ludo@gnu.org>2021-01-22 08:36:03 +0100
commit7df3ab0f0d21e6414a22b113c832dc18475f34a7 (patch)
treef2fca01646ad86d7ca943dbd3f9c8e6cf1976a62
parent211a50352227ef8fa98bc45b2248937ab602fff1 (diff)
downloadguix-7df3ab0f0d21e6414a22b113c832dc18475f34a7.tar
guix-7df3ab0f0d21e6414a22b113c832dc18475f34a7.tar.gz
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.
-rw-r--r--guix/serialization.scm16
-rw-r--r--guix/store.scm17
-rw-r--r--tests/store.scm13
3 files changed, 39 insertions, 7 deletions
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 59cd93fb18..9d0739f6c5 100644
--- a/guix/serialization.scm
+++ b/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 @@
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 @@ substitute invalid byte sequences with question marks. This is a
(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 @@ substitute invalid byte sequences with question marks. This is a
(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)))
diff --git a/guix/store.scm b/guix/store.scm
index 4da39971b5..e0b15abce3 100644
--- a/guix/store.scm
+++ b/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 @@
query-failed-paths
clear-failed-paths
ensure-path
+ find-roots
add-temp-root
add-indirect-root
add-permanent-root
@@ -340,7 +341,8 @@
(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 @@
(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 @@ running a substitute. As a GC root is not created by the daemon, you may want
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."
diff --git a/tests/store.scm b/tests/store.scm
index c9a08ac690..cda0e0302f 100644
--- a/tests/store.scm
+++ b/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 @@
;; (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"