[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#54997] [PATCH 01/12] gexp: Add 'references-file'.
From: |
Ludovic Courtès |
Subject: |
[bug#54997] [PATCH 01/12] gexp: Add 'references-file'. |
Date: |
Sun, 17 Apr 2022 23:04:42 +0200 |
* gnu/services/base.scm (references-file): Remove.
* guix/gexp.scm (references-file): New procedure.
* tests/gexp.scm ("references-file"): New test.
---
gnu/services/base.scm | 22 ----------------------
guix/gexp.scm | 43 +++++++++++++++++++++++++++++++++++++++++++
tests/gexp.scm | 18 ++++++++++++++++++
3 files changed, 61 insertions(+), 22 deletions(-)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 5d7c69a9cd..182badd97f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -219,8 +219,6 @@ (define-module (gnu services base)
pam-limits-service-type
pam-limits-service
- references-file
-
%base-services))
;;; Commentary:
@@ -1768,26 +1766,6 @@ (define (guix-activation config)
(substitute-key-authorization authorized-keys guix)
#~#f))))
-(define* (references-file item #:optional (name "references"))
- "Return a file that contains the list of references of ITEM."
- (if (struct? item) ;lowerable object
- (computed-file name
- (with-extensions (list guile-gcrypt) ;for store-copy
- (with-imported-modules (source-module-closure
- '((guix build store-copy)))
- #~(begin
- (use-modules (guix build store-copy))
-
- (call-with-output-file #$output
- (lambda (port)
- (write (map store-info-item
- (call-with-input-file "graph"
- read-reference-graph))
- port))))))
- #:options `(#:local-build? #f
- #:references-graphs (("graph" ,item))))
- (plain-file name "()")))
-
(define guix-service-type
(service-type
(name 'guix)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 9fdb7a30be..9ef7622062 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -118,6 +118,7 @@ (define-module (guix gexp)
mixed-text-file
file-union
directory-union
+ references-file
imported-files
imported-modules
@@ -2173,6 +2174,48 @@ (define log-port
#:resolve-collision
(ungexp resolve-collision)))))))))
+(define* (references-file item #:optional (name "references")
+ #:key guile)
+ "Return a file that contains the list of direct and indirect references (the
+closure) of ITEM."
+ (if (struct? item) ;lowerable object
+ (computed-file name
+ (gexp (begin
+ (use-modules (ice-9 rdelim)
+ (ice-9 match))
+
+ (define (drop-lines port n)
+ ;; Drop N lines read from PORT.
+ (let loop ((n n))
+ (unless (zero? n)
+ (read-line port)
+ (loop (- n 1)))))
+
+ (define (read-graph port)
+ ;; Return the list of references read from
+ ;; PORT. This is a stripped-down version of
+ ;; 'read-reference-graph'.
+ (let loop ((items '()))
+ (match (read-line port)
+ ((? eof-object?)
+ items)
+ ((? string? item)
+ (let ((deriver (read-line port))
+ (count
+ (string->number (read-line port))))
+ (drop-lines port count)
+ (loop (cons item items)))))))
+
+ (call-with-output-file (ungexp output)
+ (lambda (port)
+ (write (call-with-input-file "graph"
+ read-graph)
+ port)))))
+ #:guile guile
+ #:options `(#:local-build? #t
+ #:references-graphs (("graph" ,item))))
+ (plain-file name "()")))
+
;;;
;;; Syntactic sugar.
diff --git a/tests/gexp.scm b/tests/gexp.scm
index c80ca13fab..35bd99e6d4 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1606,6 +1606,24 @@ (define (contents=? file str)
(not (member (derivation-file-name native) refs))
(member (derivation-file-name cross) refs))))))
+(test-assertm "references-file"
+ (let* ((exp #~(symlink #$%bootstrap-guile #$output))
+ (computed (computed-file "computed" exp
+ #:guile %bootstrap-guile))
+ (refs (references-file computed "refs"
+ #:guile %bootstrap-guile)))
+ (mlet* %store-monad ((drv0 (lower-object %bootstrap-guile))
+ (drv1 (lower-object computed))
+ (drv2 (lower-object refs)))
+ (mbegin %store-monad
+ (built-derivations (list drv2))
+ (mlet %store-monad ((refs ((store-lift requisites)
+ (list (derivation->output-path drv1)))))
+ (return (lset= string=?
+ (call-with-input-file (derivation->output-path drv2)
+ read)
+ refs)))))))
+
(test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c)))
--
2.35.1
- [bug#54997] [PATCH 00/12] Add "least authority" program wrapper, Ludovic Courtès, 2022/04/17
- [bug#54997] [PATCH 01/12] gexp: Add 'references-file'.,
Ludovic Courtès <=
- [bug#54997] [PATCH 02/12] file-systems: Avoid load-time warnings when attempting to load (guix store)., Ludovic Courtès, 2022/04/17
- [bug#54997] [PATCH 03/12] linux-container: 'call-with-container' relays SIGTERM and SIGINT., Ludovic Courtès, 2022/04/17
- [bug#54997] [PATCH 04/12] Add (guix least-authority)., Ludovic Courtès, 2022/04/17
- [bug#54997] [PATCH 04/12] Add (guix least-authority)., Maxime Devos, 2022/04/18
- [bug#54997] [PATCH 00/12] Add "least authority" program wrapper, Ludovic Courtès, 2022/04/19
- [bug#54997] [PATCH 04/12] Add (guix least-authority)., Maxime Devos, 2022/04/18
- [bug#54997] [PATCH 00/12] Add "least authority" program wrapper, Ludovic Courtès, 2022/04/19
- [bug#54997] [PATCH 04/12] Add (guix least-authority)., Thiago Jung Bauermann, 2022/04/22
- [bug#54997] [PATCH 00/12] Add "least authority" program wrapper, Ludovic Courtès, 2022/04/26
- [bug#54997] [PATCH 00/12] Add "least authority" program wrapper, Thiago Jung Bauermann, 2022/04/28