[PATCH 0/8] Seamless integration of inferior packages

DoneSubmitted by Ludovic Courtès.
Details
One participant
  • Ludovic Courtès
Owner
unassigned
Severity
normal
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:04
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120408.27737-1-ludo@gnu.org
Hello Guix!
Here comes icing for the cake: a facility that allows you to mix inferiorpackages with “regular” packages in a single profile.
For now you can use it, for instance, by writing a manifest for‘guix package -m’ along these lines:
Toggle snippet (19 lines)(use-modules (guix inferior) (guix channels))
(define channels (list (channel (name 'guix) (url "https://git.savannah.gnu.org/git/guix.git") (commit #;"4ab6a2f23d43f6c7e4a5a7420db613c5ba5b03b6" ;recent "65956ad3526ba09e1f7a40722c96c6ef7c0936fe"))))
(define inferior (inferior-for-channels channels))
(packages->manifest (list (car (lookup-inferior-packages inferior "guile-json")) (specification->package "guile")))
The example above gives you guile-json 1.0.1 with guile 2.2.4.
Inferior packages are “first class”, meaning that their search paths,propagated inputs, etc. are honored, just like for regular packages.
Building Guix or even just computing its derivation takes some timeso the last patch, which implements ‘inferior-for-channels’, adds acache. That way, if you frequently use a given inferior, it’simmediately available.
There’s no documentation yet, mostly because I wanted to get it outthe door and wasn’t sure whether we should provide higher-levelinterfaces.
Anyway, that’s it. Feedback welcome!
Ludo’.
Ludovic Courtès (8): inferior: Add 'inferior-package-derivation'. inferior: Add 'lookup-inferior-packages'. inferior: Add 'inferior-package-inputs' & co. inferior: Add 'inferior-package-search-paths' & co. inferior: Add 'inferior-package->manifest-entry'. profiles: 'packages->manifest' now accepts inferior packages. channels: Add 'channel-instances->derivation'. inferior: Add 'inferior-for-channels'.
guix/channels.scm | 16 +- guix/inferior.scm | 366 ++++++++++++++++++++++++++++++++++++++++-- guix/profiles.scm | 27 +++- tests/guix-package.sh | 15 ++ tests/inferior.scm | 123 +++++++++++++- 5 files changed, 523 insertions(+), 24 deletions(-)
-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 6/8] profiles: 'packages->manifest' now accepts inferior packages.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludovic.courtes@inria.fr)
20180918120640.27863-6-ludo@gnu.org
From: Ludovic Courtès <ludovic.courtes@inria.fr>
* guix/profiles.scm (packages->manifest)[inferiors-loaded?]: Newvariable.[inferior->entry]: New procedure.Accept inferior packages when INFERIORS-LOADED? is true.* tests/guix-package.sh: Add test using a manifest with an inferior.* tests/inferior.scm ("packages->manifest"): New test.--- guix/profiles.scm | 27 +++++++++++++++++++++++---- tests/guix-package.sh | 15 +++++++++++++++ tests/inferior.scm | 11 +++++++++++ 3 files changed, 49 insertions(+), 4 deletions(-)
Toggle diff (88 lines)diff --git a/guix/profiles.scm b/guix/profiles.scmindex 8acfcff8c..669ebe04e 100644--- a/guix/profiles.scm+++ b/guix/profiles.scm@@ -314,12 +314,31 @@ file name." "Return a list of manifest entries, one for each item listed in PACKAGES. Elements of PACKAGES can be either package objects or package/string tuples denoting a specific output of a package."+ (define inferiors-loaded?+ ;; This hack allows us to provide seamless integration for inferior+ ;; packages while not having a hard dependency on (guix inferior).+ (resolve-module '(guix inferior) #f #f #:ensure #f))++ (define (inferior->entry)+ (module-ref (resolve-interface '(guix inferior))+ 'inferior-package->manifest-entry))+ (manifest (map (match-lambda- ((package output)- (package->manifest-entry package output))- ((? package? package)- (package->manifest-entry package)))+ ((package output)+ (package->manifest-entry package output))+ ((? package? package)+ (package->manifest-entry package))+ ((thing output)+ (if inferiors-loaded?+ ((inferior->entry) thing output)+ (throw 'wrong-type-arg 'packages->manifest+ "Wrong package object: ~S" (list thing) (list thing))))+ (thing+ (if inferiors-loaded?+ ((inferior->entry) thing)+ (throw 'wrong-type-arg 'packages->manifest+ "Wrong package object: ~S" (list thing) (list thing))))) packages))) (define (manifest->gexp manifest)diff --git a/tests/guix-package.sh b/tests/guix-package.shindex cef3b3452..f7dfbfad0 100644--- a/tests/guix-package.sh+++ b/tests/guix-package.sh@@ -358,6 +358,21 @@ EOF guix package --bootstrap -m "$module_dir/manifest.scm" guix package -I | grep guile test `guix package -I | wc -l` -eq 1+guix package --rollback --bootstrap++# Applying a manifest file with inferior packages.+cat > "$module_dir/manifest.scm"<<EOF+(use-modules (guix inferior))++(define i+ (open-inferior "$abs_top_srcdir" #:command "scripts/guix"))++(let ((guile (car (lookup-inferior-packages i "guile-bootstrap"))))+ (packages->manifest (list guile)))+EOF+guix package --bootstrap -m "$module_dir/manifest.scm"+guix package -I | grep guile+test `guix package -I | wc -l` -eq 1 # Error reporting. cat > "$module_dir/manifest.scm"<<EOFdiff --git a/tests/inferior.scm b/tests/inferior.scmindex 6f6abd28a..d1d5c00a7 100644--- a/tests/inferior.scm+++ b/tests/inferior.scm@@ -182,4 +182,15 @@ (close-inferior inferior) (manifest-entry->list entry))) +(test-equal "packages->manifest"+ (map manifest-entry->list+ (manifest-entries (packages->manifest+ (find-best-packages-by-name "guile" #f))))+ (let* ((inferior (open-inferior %top-builddir+ #:command "scripts/guix"))+ (guile (first (lookup-inferior-packages inferior "guile")))+ (manifest (packages->manifest (list guile))))+ (close-inferior inferior)+ (map manifest-entry->list (manifest-entries manifest))))+ (test-end "inferior")-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 1/8] inferior: Add 'inferior-package-derivation'.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120640.27863-1-ludo@gnu.org
* guix/inferior.scm (read-inferior-response)(send-inferior-request): New procedures.(inferior-eval): Rewrite in terms of these.(proxy, inferior-package-derivation, inferior-package->derivation)(package-compiler): New procedures.* tests/inferior.scm ("inferior-package-derivation"): New test.--- guix/inferior.scm | 125 ++++++++++++++++++++++++++++++++++++++++++--- tests/inferior.scm | 22 ++++++++ 2 files changed, 141 insertions(+), 6 deletions(-)
Toggle diff (219 lines)diff --git a/guix/inferior.scm b/guix/inferior.scmindex af37233a0..5bef96488 100644--- a/guix/inferior.scm+++ b/guix/inferior.scm@@ -19,9 +19,21 @@ (define-module (guix inferior) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu)- #:use-module ((guix utils) #:select (source-properties->location))+ #:use-module ((guix utils)+ #:select (%current-system+ source-properties->location+ call-with-temporary-directory))+ #:use-module ((guix store)+ #:select (nix-server-socket+ nix-server-major-version+ nix-server-minor-version+ store-lift))+ #:use-module ((guix derivations)+ #:select (read-derivation-from-file))+ #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (ice-9 popen)+ #:use-module (ice-9 binary-ports) #:export (inferior? open-inferior close-inferior@@ -36,7 +48,8 @@ inferior-package-synopsis inferior-package-description inferior-package-home-page- inferior-package-location))+ inferior-package-location+ inferior-package-derivation)) ;;; Commentary: ;;;@@ -123,8 +136,7 @@ equivalent. Return #f if the inferior could not be launched." (set-record-type-printer! <inferior-object> write-inferior-object) -(define (inferior-eval exp inferior)- "Evaluate EXP in INFERIOR."+(define (read-inferior-response inferior) (define sexp->object (match-lambda (('value value)@@ -132,14 +144,21 @@ equivalent. Return #f if the inferior could not be launched." (('non-self-quoting address string) (inferior-object address string)))) - (write exp (inferior-socket inferior))- (newline (inferior-socket inferior)) (match (read (inferior-socket inferior)) (('values objects ...) (apply values (map sexp->object objects))) (('exception key objects ...) (apply throw key (map sexp->object objects))))) +(define (send-inferior-request exp inferior)+ (write exp (inferior-socket inferior))+ (newline (inferior-socket inferior)))++(define (inferior-eval exp inferior)+ "Evaluate EXP in INFERIOR."+ (send-inferior-request exp inferior)+ (read-inferior-response inferior))+ ;;; ;;; Inferior packages.@@ -216,3 +235,97 @@ record." (location->source-properties loc))) package-location))))++(define (proxy client backend) ;adapted from (guix ssh)+ "Proxy communication between CLIENT and BACKEND until CLIENT closes the+connection, at which point CLIENT is closed (both CLIENT and BACKEND must be+input/output ports.)"+ (define (select* read write except)+ ;; This is a workaround for <https://bugs.gnu.org/30365> in Guile < 2.2.4:+ ;; since 'select' sometimes returns non-empty sets for no good reason,+ ;; call 'select' a second time with a zero timeout to filter out incorrect+ ;; replies.+ (match (select read write except)+ ((read write except)+ (select read write except 0))))++ ;; Use buffered ports so that 'get-bytevector-some' returns up to the+ ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.+ (setvbuf client _IOFBF 65536)+ (setvbuf backend _IOFBF 65536)++ (let loop ()+ (match (select* (list client backend) '() '())+ ((reads () ())+ (when (memq client reads)+ (match (get-bytevector-some client)+ ((? eof-object?)+ (close-port client))+ (bv+ (put-bytevector backend bv)+ (force-output backend))))+ (when (memq backend reads)+ (match (get-bytevector-some backend)+ (bv+ (put-bytevector client bv)+ (force-output client))))+ (unless (port-closed? client)+ (loop))))))++(define* (inferior-package-derivation store package+ #:optional+ (system (%current-system))+ #:key target)+ "Return the derivation for PACKAGE, an inferior package, built for SYSTEM+and cross-built for TARGET if TARGET is true. The inferior corresponding to+PACKAGE must be live."+ ;; Create a named socket in /tmp and let the inferior of PACKAGE connect to+ ;; it and use it as its store. This ensures the inferior uses the same+ ;; store, with the same options, the same per-session GC roots, etc.+ (call-with-temporary-directory+ (lambda (directory)+ (chmod directory #o700)+ (let* ((name (string-append directory "/inferior"))+ (socket (socket AF_UNIX SOCK_STREAM 0))+ (inferior (inferior-package-inferior package))+ (major (nix-server-major-version store))+ (minor (nix-server-minor-version store))+ (proto (logior major minor)))+ (bind socket AF_UNIX name)+ (listen socket 1024)+ (send-inferior-request+ `(let ((socket (socket AF_UNIX SOCK_STREAM 0)))+ (connect socket AF_UNIX ,name)++ ;; 'port->connection' appeared in June 2018 and we can hardly+ ;; emulate it on older versions. Thus fall back to+ ;; 'open-connection', at the risk of talking to the wrong daemon or+ ;; having our build result reclaimed (XXX).+ (let* ((store (if (defined? 'port->connection)+ (port->connection socket #:version ,proto)+ (open-connection)))+ (package (hashv-ref %package-table+ ,(inferior-package-id package)))+ (drv ,(if target+ `(package-cross-derivation store package+ ,target+ ,system)+ `(package-derivation store package+ ,system))))+ (close-connection store)+ (close-port socket)+ (derivation-file-name drv)))+ inferior)+ (match (accept socket)+ ((client . address)+ (proxy client (nix-server-socket store))))+ (close-port socket)+ (read-derivation-from-file (read-inferior-response inferior))))))++(define inferior-package->derivation+ (store-lift inferior-package-derivation))++(define-gexp-compiler (package-compiler (package <inferior-package>) system+ target)+ ;; Compile PACKAGE for SYSTEM, optionally cross-building for TARGET.+ (inferior-package->derivation package system #:target target))diff --git a/tests/inferior.scm b/tests/inferior.scmindex ff5cad421..817fcb6c6 100644--- a/tests/inferior.scm+++ b/tests/inferior.scm@@ -17,9 +17,13 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-inferior)+ #:use-module (guix tests) #:use-module (guix inferior) #:use-module (guix packages)+ #:use-module (guix store)+ #:use-module (guix derivations) #:use-module (gnu packages)+ #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64)) @@ -29,6 +33,9 @@ (define %top-builddir (dirname (search-path %load-compiled-path "guix.go"))) +(define %store+ (open-connection-for-tests))+ (test-begin "inferior") @@ -72,4 +79,19 @@ (close-inferior inferior) result)))) +(test-equal "inferior-package-derivation"+ (map derivation-file-name+ (list (package-derivation %store %bootstrap-guile "x86_64-linux")+ (package-derivation %store %bootstrap-guile "armhf-linux")))+ (let* ((inferior (open-inferior %top-builddir+ #:command "scripts/guix"))+ (packages (inferior-packages inferior))+ (guile (find (lambda (package)+ (string=? (package-name %bootstrap-guile)+ (inferior-package-name package)))+ packages)))+ (map derivation-file-name+ (list (inferior-package-derivation %store guile "x86_64-linux")+ (inferior-package-derivation %store guile "armhf-linux")))))+ (test-end "inferior")-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 3/8] inferior: Add 'inferior-package-inputs' & co.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120640.27863-3-ludo@gnu.org
* guix/inferior.scm (open-inferior): Use (ice-9 match).(inferior-package-input-field, inferior-package-inputs):(inferior-package-native-inputs)(inferior-package-propagated-inputs)(inferior-package-transitive-propagated-inputs): New procedures.* tests/inferior.scm ("inferior-package-inputs"): New test.
inputs fixlet--- guix/inferior.scm | 51 ++++++++++++++++++++++++++++++++++++++++++++++ tests/inferior.scm | 34 ++++++++++++++++++++++++++++++- 2 files changed, 84 insertions(+), 1 deletion(-)
Toggle diff (138 lines)diff --git a/guix/inferior.scm b/guix/inferior.scmindex 81b71d0c7..ca819c6ef 100644--- a/guix/inferior.scm+++ b/guix/inferior.scm@@ -33,6 +33,7 @@ #:select (read-derivation-from-file)) #:use-module (guix gexp) #:use-module (srfi srfi-1)+ #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (ice-9 vlist)@@ -53,6 +54,10 @@ inferior-package-description inferior-package-home-page inferior-package-location+ inferior-package-inputs+ inferior-package-native-inputs+ inferior-package-propagated-inputs+ inferior-package-transitive-propagated-inputs inferior-package-derivation)) ;;; Commentary:@@ -120,6 +125,7 @@ equivalent. Return #f if the inferior could not be launched." (delay (%inferior-package-table result))))) (inferior-eval '(use-modules (guix)) result) (inferior-eval '(use-modules (gnu)) result)+ (inferior-eval '(use-modules (ice-9 match)) result) (inferior-eval '(define %package-table (make-hash-table)) result) result))@@ -271,6 +277,51 @@ record." loc))) package-location)))) +(define (inferior-package-input-field package field)+ "Return the input field FIELD (e.g., 'native-inputs') of PACKAGE, an+inferior package."+ (define field*+ `(compose (lambda (inputs)+ (map (match-lambda+ ;; XXX: Origins are not handled.+ ((label (? package? package) rest ...)+ (let ((id (object-address package)))+ (hashv-set! %package-table id package)+ `(,label (package ,id+ ,(package-name package)+ ,(package-version package))+ ,@rest)))+ (x+ x))+ inputs))+ ,field))++ (define inputs+ (inferior-package-field package field*))++ (define inferior+ (inferior-package-inferior package))++ (map (match-lambda+ ((label ('package id name version) . rest)+ ;; XXX: eq?-ness of inferior packages is not preserved here.+ `(,label ,(inferior-package inferior name version id)+ ,@rest))+ (x x))+ inputs))++(define inferior-package-inputs+ (cut inferior-package-input-field <> 'package-inputs))++(define inferior-package-native-inputs+ (cut inferior-package-input-field <> 'package-native-inputs))++(define inferior-package-propagated-inputs+ (cut inferior-package-input-field <> 'package-propagated-inputs))++(define inferior-package-transitive-propagated-inputs+ (cut inferior-package-input-field <> 'package-transitive-propagated-inputs))+ (define (proxy client backend) ;adapted from (guix ssh) "Proxy communication between CLIENT and BACKEND until CLIENT closes the connection, at which point CLIENT is closed (both CLIENT and BACKEND must bediff --git a/tests/inferior.scm b/tests/inferior.scmindex 791e30b17..03170a19c 100644--- a/tests/inferior.scm+++ b/tests/inferior.scm@@ -24,8 +24,10 @@ #:use-module (guix derivations) #:use-module (gnu packages) #:use-module (gnu packages bootstrap)+ #:use-module (gnu packages guile) #:use-module (srfi srfi-1)- #:use-module (srfi srfi-64))+ #:use-module (srfi srfi-64)+ #:use-module (ice-9 match)) (define %top-srcdir (dirname (search-path %load-path "guix.scm")))@@ -108,6 +110,36 @@ (close-inferior inferior) (every eq? lst1 lst2))) +(test-equal "inferior-package-inputs"+ (let ((->list (match-lambda+ ((label (? package? package) . rest)+ `(,label+ (package ,(package-name package)+ ,(package-version package)+ ,(package-location package))+ ,@rest)))))+ (list (map ->list (package-inputs guile-2.2))+ (map ->list (package-native-inputs guile-2.2))+ (map ->list (package-propagated-inputs guile-2.2))))+ (let* ((inferior (open-inferior %top-builddir+ #:command "scripts/guix"))+ (guile (first (lookup-inferior-packages inferior "guile")))+ (->list (match-lambda+ ((label (? inferior-package? package) . rest)+ `(,label+ (package ,(inferior-package-name package)+ ,(inferior-package-version package)+ ,(inferior-package-location package))+ ,@rest))))+ (result (list (map ->list (inferior-package-inputs guile))+ (map ->list+ (inferior-package-native-inputs guile))+ (map ->list+ (inferior-package-propagated-inputs+ guile)))))+ (close-inferior inferior)+ result))+ (test-equal "inferior-package-derivation" (map derivation-file-name (list (package-derivation %store %bootstrap-guile "x86_64-linux")-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 7/8] channels: Add 'channel-instances->derivation'.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120640.27863-7-ludo@gnu.org
* guix/channels.scm (channel-instances->derivation): New procedure.(latest-channel-derivation): Use it.(channel-instance-derivations): Make private.--- guix/channels.scm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-)
Toggle diff (40 lines)diff --git a/guix/channels.scm b/guix/channels.scmindex 2e7bffae9..82389eb58 100644--- a/guix/channels.scm+++ b/guix/channels.scm@@ -47,9 +47,9 @@ channel-instance-checkout latest-channel-instances- channel-instance-derivations latest-channel-derivation- channel-instances->manifest))+ channel-instances->manifest+ channel-instances->derivation)) ;;; Commentary: ;;;@@ -294,13 +294,17 @@ channel instances." (zip instances derivations)))) (return (manifest entries)))) +(define (channel-instances->derivation instances)+ "Return the derivation of the profile containing INSTANCES, a list of+channel instances."+ (mlet %store-monad ((manifest (channel-instances->manifest instances)))+ (profile-derivation manifest)))+ (define latest-channel-instances* (store-lift latest-channel-instances)) (define* (latest-channel-derivation #:optional (channels %default-channels)) "Return as a monadic value the derivation that builds the profile for the latest instances of CHANNELS."- (mlet* %store-monad ((instances ((store-lift latest-channel-instances)- channels))- (manifest (channel-instances->manifest instances)))- (profile-derivation manifest)))+ (mlet %store-monad ((instances (latest-channel-instances* channels)))+ (channel-instances->derivation instances)))-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 4/8] inferior: Add 'inferior-package-search-paths' & co.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120640.27863-4-ludo@gnu.org
* guix/inferior.scm (%inferior-package-search-paths)(inferior-package-native-search-paths)(inferior-package-search-paths)(inferior-package-transitive-native-search-paths): New procedures.* tests/inferior.scm ("inferior-package-search-paths"): New test.--- guix/inferior.scm | 26 ++++++++++++++++++++++++++ tests/inferior.scm | 9 +++++++++ 2 files changed, 35 insertions(+)
Toggle diff (73 lines)diff --git a/guix/inferior.scm b/guix/inferior.scmindex ca819c6ef..3fa493009 100644--- a/guix/inferior.scm+++ b/guix/inferior.scm@@ -32,6 +32,7 @@ #:use-module ((guix derivations) #:select (read-derivation-from-file)) #:use-module (guix gexp)+ #:use-module (guix search-paths) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match)@@ -58,6 +59,9 @@ inferior-package-native-inputs inferior-package-propagated-inputs inferior-package-transitive-propagated-inputs+ inferior-package-native-search-paths+ inferior-package-transitive-native-search-paths+ inferior-package-search-paths inferior-package-derivation)) ;;; Commentary:@@ -322,6 +326,28 @@ inferior package." (define inferior-package-transitive-propagated-inputs (cut inferior-package-input-field <> 'package-transitive-propagated-inputs)) +(define (%inferior-package-search-paths package field)+ "Return the list of search path specificiations of PACKAGE, an inferior+package."+ (define paths+ (inferior-package-field package+ `(compose (lambda (paths)+ (map (@ (guix search-paths)+ search-path-specification->sexp)+ paths))+ ,field)))++ (map sexp->search-path-specification paths))++(define inferior-package-native-search-paths+ (cut %inferior-package-search-paths <> 'package-native-search-paths))++(define inferior-package-search-paths+ (cut %inferior-package-search-paths <> 'package-search-paths))++(define inferior-package-transitive-native-search-paths+ (cut %inferior-package-search-paths <> 'package-transitive-native-search-paths))+ (define (proxy client backend) ;adapted from (guix ssh) "Proxy communication between CLIENT and BACKEND until CLIENT closes the connection, at which point CLIENT is closed (both CLIENT and BACKEND must bediff --git a/tests/inferior.scm b/tests/inferior.scmindex 03170a19c..99d736bd4 100644--- a/tests/inferior.scm+++ b/tests/inferior.scm@@ -140,6 +140,15 @@ (close-inferior inferior) result)) +(test-equal "inferior-package-search-paths"+ (package-native-search-paths guile-2.2)+ (let* ((inferior (open-inferior %top-builddir+ #:command "scripts/guix"))+ (guile (first (lookup-inferior-packages inferior "guile")))+ (result (inferior-package-native-search-paths guile)))+ (close-inferior inferior)+ result))+ (test-equal "inferior-package-derivation" (map derivation-file-name (list (package-derivation %store %bootstrap-guile "x86_64-linux")-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 8/8] inferior: Add 'inferior-for-channels'.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120640.27863-8-ludo@gnu.org
* guix/inferior.scm (%inferior-cache-directory): New variable.(inferior-for-channels): New procedure.--- guix/inferior.scm | 85 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 83 insertions(+), 2 deletions(-)
Toggle diff (122 lines)diff --git a/guix/inferior.scm b/guix/inferior.scmindex c86fdd3ec..1dbb9e169 100644--- a/guix/inferior.scm+++ b/guix/inferior.scm@@ -23,7 +23,8 @@ #:select (%current-system source-properties->location call-with-temporary-directory- version>? version-prefix?))+ version>? version-prefix?+ cache-directory)) #:use-module ((guix store) #:select (nix-server-socket nix-server-major-version@@ -34,12 +35,23 @@ #:use-module (guix gexp) #:use-module (guix search-paths) #:use-module (guix profiles)+ #:use-module (guix channels)+ #:use-module (guix monads)+ #:use-module (guix store)+ #:use-module (guix derivations)+ #:use-module (guix base32)+ #:use-module (gcrypt hash)+ #:autoload (guix cache) (maybe-remove-expired-cache-entries)+ #:autoload (guix ui) (show-what-to-build*)+ #:autoload (guix build utils) (mkdir-p) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26)+ #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (ice-9 vlist) #:use-module (ice-9 binary-ports)+ #:use-module ((rnrs bytevectors) #:select (string->utf8)) #:export (inferior? open-inferior close-inferior@@ -65,7 +77,10 @@ inferior-package-search-paths inferior-package-derivation - inferior-package->manifest-entry))+ inferior-package->manifest-entry++ %inferior-cache-directory+ inferior-for-channels)) ;;; Commentary: ;;;@@ -475,3 +490,69 @@ PACKAGE must be live." (parent parent) (properties properties)))) entry))++ +;;;+;;; Cached inferiors.+;;;++(define %inferior-cache-directory+ ;; Directory for cached inferiors (GC roots).+ (make-parameter (string-append (cache-directory #:ensure? #f)+ "/inferiors")))++(define* (inferior-for-channels channels+ #:key+ (cache-directory (%inferior-cache-directory))+ (ttl (* 3600 24 30)))+ "Return an inferior for CHANNELS, a list of channels. Use the cache at+CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. This+procedure opens a new connection to the build daemon.++This is a convenience procedure that people may use in manifests passed to+'guix package -m', for instance."+ (with-store store+ (let ()+ (define instances+ (latest-channel-instances store channels))++ (define key+ (bytevector->base32-string+ (sha256+ (string->utf8+ (string-concatenate (map channel-instance-commit instances))))))++ (define cached+ (string-append cache-directory "/" key))++ (define (base32-encoded-sha256? str)+ (= (string-length str) 52))++ (define (cache-entries directory)+ (map (lambda (file)+ (string-append directory "/" file))+ (scandir directory base32-encoded-sha256?)))++ (define symlink*+ (lift2 symlink %store-monad))++ (define add-indirect-root*+ (store-lift add-indirect-root))++ (mkdir-p cache-directory)+ (maybe-remove-expired-cache-entries cache-directory+ cache-entries+ #:entry-expiration+ (file-expiration-time ttl))++ (if (file-exists? cached)+ (open-inferior cached)+ (run-with-store store+ (mlet %store-monad ((profile+ (channel-instances->derivation instances)))+ (mbegin %store-monad+ (show-what-to-build* (list profile))+ (built-derivations (list profile))+ (symlink* (derivation->output-path profile) cached)+ (add-indirect-root* cached)+ (return (open-inferior cached)))))))))-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 2/8] inferior: Add 'lookup-inferior-packages'.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120640.27863-2-ludo@gnu.org
* guix/inferior.scm (<inferior>)[packages, table]: New fields.(open-inferior): Initialize these new fields.(inferior-packages): Rename to...(%inferior-packages): ... this.(inferior-packages): New procedure; force the promise.(%inferior-package-table, lookup-inferior-packages): New procedures.* tests/inferior.scm ("lookup-inferior-packages")("lookup-inferior-packages and eq?-ness"): New tests.--- guix/inferior.scm | 47 ++++++++++++++++++++++++++++++++++++++++------ tests/inferior.scm | 29 ++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+), 6 deletions(-)
Toggle diff (147 lines)diff --git a/guix/inferior.scm b/guix/inferior.scmindex 5bef96488..81b71d0c7 100644--- a/guix/inferior.scm+++ b/guix/inferior.scm@@ -22,7 +22,8 @@ #:use-module ((guix utils) #:select (%current-system source-properties->location- call-with-temporary-directory))+ call-with-temporary-directory+ version>? version-prefix?)) #:use-module ((guix store) #:select (nix-server-socket nix-server-major-version@@ -31,8 +32,10 @@ #:use-module ((guix derivations) #:select (read-derivation-from-file)) #:use-module (guix gexp)+ #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:use-module (ice-9 popen)+ #:use-module (ice-9 vlist) #:use-module (ice-9 binary-ports) #:export (inferior? open-inferior@@ -45,6 +48,7 @@ inferior-package-version inferior-packages+ lookup-inferior-packages inferior-package-synopsis inferior-package-description inferior-package-home-page@@ -61,11 +65,13 @@ ;; Inferior Guix process. (define-record-type <inferior>- (inferior pid socket version)+ (inferior pid socket version packages table) inferior? (pid inferior-pid) (socket inferior-socket)- (version inferior-version)) ;REPL protocol version+ (version inferior-version) ;REPL protocol version+ (packages inferior-package-promise) ;promise of inferior packages+ (table inferior-package-table)) ;promise of vhash (define (inferior-pipe directory command) "Return an input/output pipe on the Guix instance in DIRECTORY. This runs@@ -109,7 +115,9 @@ equivalent. Return #f if the inferior could not be launched." (match (read pipe) (('repl-version 0 rest ...)- (let ((result (inferior 'pipe pipe (cons 0 rest))))+ (letrec ((result (inferior 'pipe pipe (cons 0 rest)+ (delay (%inferior-packages result))+ (delay (%inferior-package-table result))))) (inferior-eval '(use-modules (guix)) result) (inferior-eval '(use-modules (gnu)) result) (inferior-eval '(define %package-table (make-hash-table))@@ -181,8 +189,8 @@ equivalent. Return #f if the inferior could not be launched." (set-record-type-printer! <inferior-package> write-inferior-package) -(define (inferior-packages inferior)- "Return the list of packages known to INFERIOR."+(define (%inferior-packages inferior)+ "Compute the list of inferior packages from INFERIOR." (let ((result (inferior-eval '(fold-packages (lambda (package result) (let ((id (object-address package)))@@ -198,6 +206,33 @@ equivalent. Return #f if the inferior could not be launched." (inferior-package inferior name version id))) result))) +(define (inferior-packages inferior)+ "Return the list of packages known to INFERIOR."+ (force (inferior-package-promise inferior)))++(define (%inferior-package-table inferior)+ "Compute a package lookup table for INFERIOR."+ (fold (lambda (package table)+ (vhash-cons (inferior-package-name package) package+ table))+ vlist-null+ (inferior-packages inferior)))++(define* (lookup-inferior-packages inferior name #:optional version)+ "Return the sorted list of inferior packages matching NAME in INFERIOR, with+highest version numbers first. If VERSION is true, return only packages with+a version number prefixed by VERSION."+ ;; This is the counterpart of 'find-packages-by-name'.+ (sort (filter (lambda (package)+ (or (not version)+ (version-prefix? version+ (inferior-package-version package))))+ (vhash-fold* cons '() name+ (force (inferior-package-table inferior))))+ (lambda (p1 p2)+ (version>? (inferior-package-version p1)+ (inferior-package-version p2)))))+ (define (inferior-package-field package getter) "Return the field of PACKAGE, an inferior package, accessed with GETTER." (let ((inferior (inferior-package-inferior package))diff --git a/tests/inferior.scm b/tests/inferior.scmindex 817fcb6c6..791e30b17 100644--- a/tests/inferior.scm+++ b/tests/inferior.scm@@ -79,6 +79,35 @@ (close-inferior inferior) result)))) +(test-equal "lookup-inferior-packages"+ (let ((->list (lambda (package)+ (list (package-name package)+ (package-version package)+ (package-location package)))))+ (list (map ->list (find-packages-by-name "guile" #f))+ (map ->list (find-packages-by-name "guile" "2.2"))))+ (let* ((inferior (open-inferior %top-builddir+ #:command "scripts/guix"))+ (->list (lambda (package)+ (list (inferior-package-name package)+ (inferior-package-version package)+ (inferior-package-location package))))+ (lst1 (map ->list+ (lookup-inferior-packages inferior "guile")))+ (lst2 (map ->list+ (lookup-inferior-packages inferior+ "guile" "2.2"))))+ (close-inferior inferior)+ (list lst1 lst2)))++(test-assert "lookup-inferior-packages and eq?-ness"+ (let* ((inferior (open-inferior %top-builddir+ #:command "scripts/guix"))+ (lst1 (lookup-inferior-packages inferior "guile"))+ (lst2 (lookup-inferior-packages inferior "guile")))+ (close-inferior inferior)+ (every eq? lst1 lst2)))+ (test-equal "inferior-package-derivation" (map derivation-file-name (list (package-derivation %store %bootstrap-guile "x86_64-linux")-- 2.18.0
L
L
Ludovic Courtès wrote on 18 Sep 2018 14:06
[PATCH 5/8] inferior: Add 'inferior-package->manifest-entry'.
(address . 32759@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20180918120640.27863-5-ludo@gnu.org
* guix/inferior.scm (inferior-package->manifest-entry): New procedure.* tests/inferior.scm (manifest-entry->list): New procedure.("inferior-package->manifest-entry"): New test.--- guix/inferior.scm | 42 ++++++++++++++++++++++++++++++++++++++---- tests/inferior.scm | 18 ++++++++++++++++++ 2 files changed, 56 insertions(+), 4 deletions(-)
Toggle diff (117 lines)diff --git a/guix/inferior.scm b/guix/inferior.scmindex 3fa493009..c86fdd3ec 100644--- a/guix/inferior.scm+++ b/guix/inferior.scm@@ -33,6 +33,7 @@ #:select (read-derivation-from-file)) #:use-module (guix gexp) #:use-module (guix search-paths)+ #:use-module (guix profiles) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match)@@ -45,12 +46,12 @@ inferior-eval inferior-object? + inferior-packages+ lookup-inferior-packages+ inferior-package? inferior-package-name inferior-package-version-- inferior-packages- lookup-inferior-packages inferior-package-synopsis inferior-package-description inferior-package-home-page@@ -62,7 +63,9 @@ inferior-package-native-search-paths inferior-package-transitive-native-search-paths inferior-package-search-paths- inferior-package-derivation))+ inferior-package-derivation++ inferior-package->manifest-entry)) ;;; Commentary: ;;;@@ -441,3 +444,34 @@ PACKAGE must be live." target) ;; Compile PACKAGE for SYSTEM, optionally cross-building for TARGET. (inferior-package->derivation package system #:target target))++ +;;;+;;; Manifest entries.+;;;++(define* (inferior-package->manifest-entry package+ #:optional (output "out")+ #:key (parent (delay #f))+ (properties '()))+ "Return a manifest entry for the OUTPUT of package PACKAGE."+ ;; For each dependency, keep a promise pointing to its "parent" entry.+ (letrec* ((deps (map (match-lambda+ ((label package)+ (inferior-package->manifest-entry package+ #:parent (delay entry)))+ ((label package output)+ (inferior-package->manifest-entry package output+ #:parent (delay entry))))+ (inferior-package-propagated-inputs package)))+ (entry (manifest-entry+ (name (inferior-package-name package))+ (version (inferior-package-version package))+ (output output)+ (item package)+ (dependencies (delete-duplicates deps))+ (search-paths+ (inferior-package-transitive-native-search-paths package))+ (parent parent)+ (properties properties))))+ entry))diff --git a/tests/inferior.scm b/tests/inferior.scmindex 99d736bd4..6f6abd28a 100644--- a/tests/inferior.scm+++ b/tests/inferior.scm@@ -21,6 +21,7 @@ #:use-module (guix inferior) #:use-module (guix packages) #:use-module (guix store)+ #:use-module (guix profiles) #:use-module (guix derivations) #:use-module (gnu packages) #:use-module (gnu packages bootstrap)@@ -38,6 +39,13 @@ (define %store (open-connection-for-tests)) +(define (manifest-entry->list entry)+ (list (manifest-entry-name entry)+ (manifest-entry-version entry)+ (manifest-entry-output entry)+ (manifest-entry-search-paths entry)+ (map manifest-entry->list (manifest-entry-dependencies entry))))+ (test-begin "inferior") @@ -164,4 +172,14 @@ (list (inferior-package-derivation %store guile "x86_64-linux") (inferior-package-derivation %store guile "armhf-linux"))))) +(test-equal "inferior-package->manifest-entry"+ (manifest-entry->list (package->manifest-entry+ (first (find-best-packages-by-name "guile" #f))))+ (let* ((inferior (open-inferior %top-builddir+ #:command "scripts/guix"))+ (guile (first (lookup-inferior-packages inferior "guile")))+ (entry (inferior-package->manifest-entry guile)))+ (close-inferior inferior)+ (manifest-entry->list entry)))+ (test-end "inferior")-- 2.18.0
L
L
Ludovic Courtès wrote on 21 Sep 2018 17:05
Re: [bug#32759] [PATCH 0/8] Seamless integration of inferior packages
(address . 32759-done@debbugs.gnu.org)
87d0t628n3.fsf@gnu.org
Ludovic Courtès <ludo@gnu.org> skribis:
Toggle quote (10 lines)> Ludovic Courtès (8):> inferior: Add 'inferior-package-derivation'.> inferior: Add 'lookup-inferior-packages'.> inferior: Add 'inferior-package-inputs' & co.> inferior: Add 'inferior-package-search-paths' & co.> inferior: Add 'inferior-package->manifest-entry'.> profiles: 'packages->manifest' now accepts inferior packages.> channels: Add 'channel-instances->derivation'.> inferior: Add 'inferior-for-channels'.
Pushed along with some documentation!
Ludo’.
Closed
?
Your comment

This issue is archived.

To comment on this conversation send email to 32759@debbugs.gnu.org