* [bug#32759] [PATCH 0/8] Seamless integration of inferior packages
@ 2018-09-18 12:04 Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
2018-09-21 15:05 ` bug#32759: [PATCH 0/8] Seamless integration of inferior packages Ludovic Courtès
0 siblings, 2 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:04 UTC (permalink / raw)
To: 32759
Hello Guix!
Here comes icing for the cake: a facility that allows you to mix inferior
packages 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:
--8<---------------cut here---------------start------------->8---
(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")))
--8<---------------cut here---------------end--------------->8---
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 time
so the last patch, which implements ‘inferior-for-channels’, adds a
cache. That way, if you frequently use a given inferior, it’s
immediately available.
There’s no documentation yet, mostly because I wanted to get it out
the door and wasn’t sure whether we should provide higher-level
interfaces.
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
^ permalink raw reply [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation'.
2018-09-18 12:04 [bug#32759] [PATCH 0/8] Seamless integration of inferior packages Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 2/8] inferior: Add 'lookup-inferior-packages' Ludovic Courtès
` (6 more replies)
2018-09-21 15:05 ` bug#32759: [PATCH 0/8] Seamless integration of inferior packages Ludovic Courtès
1 sibling, 7 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759
* 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(-)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 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))
+
\f
;;;
;;; 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.scm
index 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))
+
\f
(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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 2/8] inferior: Add 'lookup-inferior-packages'.
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 3/8] inferior: Add 'inferior-package-inputs' & co Ludovic Courtès
` (5 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759
* 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(-)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 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.scm
index 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 3/8] inferior: Add 'inferior-package-inputs' & co.
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 2/8] inferior: Add 'lookup-inferior-packages' Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 4/8] inferior: Add 'inferior-package-search-paths' " Ludovic Courtès
` (4 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759
* 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(-)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 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 be
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 4/8] inferior: Add 'inferior-package-search-paths' & co.
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 2/8] inferior: Add 'lookup-inferior-packages' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 3/8] inferior: Add 'inferior-package-inputs' & co Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 5/8] inferior: Add 'inferior-package->manifest-entry' Ludovic Courtès
` (3 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759
* 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(+)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 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 be
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 5/8] inferior: Add 'inferior-package->manifest-entry'.
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
` (2 preceding siblings ...)
2018-09-18 12:06 ` [bug#32759] [PATCH 4/8] inferior: Add 'inferior-package-search-paths' " Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 6/8] profiles: 'packages->manifest' now accepts inferior packages Ludovic Courtès
` (2 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759
* 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(-)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 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))
+
+\f
+;;;
+;;; 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.scm
index 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))))
+
\f
(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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 6/8] profiles: 'packages->manifest' now accepts inferior packages.
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
` (3 preceding siblings ...)
2018-09-18 12:06 ` [bug#32759] [PATCH 5/8] inferior: Add 'inferior-package->manifest-entry' Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 7/8] channels: Add 'channel-instances->derivation' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 8/8] inferior: Add 'inferior-for-channels' Ludovic Courtès
6 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759; +Cc: Ludovic Courtès
From: Ludovic Courtès <ludovic.courtes@inria.fr>
* guix/profiles.scm (packages->manifest)[inferiors-loaded?]: New
variable.
[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(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 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.sh
index 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"<<EOF
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 7/8] channels: Add 'channel-instances->derivation'.
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
` (4 preceding siblings ...)
2018-09-18 12:06 ` [bug#32759] [PATCH 6/8] profiles: 'packages->manifest' now accepts inferior packages Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 8/8] inferior: Add 'inferior-for-channels' Ludovic Courtès
6 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759
* 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(-)
diff --git a/guix/channels.scm b/guix/channels.scm
index 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [bug#32759] [PATCH 8/8] inferior: Add 'inferior-for-channels'.
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
` (5 preceding siblings ...)
2018-09-18 12:06 ` [bug#32759] [PATCH 7/8] channels: Add 'channel-instances->derivation' Ludovic Courtès
@ 2018-09-18 12:06 ` Ludovic Courtès
6 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-18 12:06 UTC (permalink / raw)
To: 32759
* guix/inferior.scm (%inferior-cache-directory): New variable.
(inferior-for-channels): New procedure.
---
guix/inferior.scm | 85 +++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 83 insertions(+), 2 deletions(-)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 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))
+
+\f
+;;;
+;;; 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* bug#32759: [PATCH 0/8] Seamless integration of inferior packages
2018-09-18 12:04 [bug#32759] [PATCH 0/8] Seamless integration of inferior packages Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
@ 2018-09-21 15:05 ` Ludovic Courtès
1 sibling, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2018-09-21 15:05 UTC (permalink / raw)
To: 32759-done
Ludovic Courtès <ludo@gnu.org> skribis:
> 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’.
^ permalink raw reply [flat|nested] 10+ messages in thread
end of thread, other threads:[~2018-09-21 15:06 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-09-18 12:04 [bug#32759] [PATCH 0/8] Seamless integration of inferior packages Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 1/8] inferior: Add 'inferior-package-derivation' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 2/8] inferior: Add 'lookup-inferior-packages' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 3/8] inferior: Add 'inferior-package-inputs' & co Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 4/8] inferior: Add 'inferior-package-search-paths' " Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 5/8] inferior: Add 'inferior-package->manifest-entry' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 6/8] profiles: 'packages->manifest' now accepts inferior packages Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 7/8] channels: Add 'channel-instances->derivation' Ludovic Courtès
2018-09-18 12:06 ` [bug#32759] [PATCH 8/8] inferior: Add 'inferior-for-channels' Ludovic Courtès
2018-09-21 15:05 ` bug#32759: [PATCH 0/8] Seamless integration of inferior packages Ludovic Courtès
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.