From 2ca41030d5189d83ea2a28ea64cf0e19efed5fd7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Jun 2019 14:34:36 +0200 Subject: gexp: Add 'lower-gexp' and express 'gexp->derivation' in terms of it. * guix/gexp.scm (gexp-input-thing, gexp-input-output) (gexp-input-native?): Export. (lower-inputs): Return records instead of tuples. (lower-reference-graphs): Adjust accordingly. (): New record type. (lower-gexp, gexp-input->tuple): New procedure. (gexp->derivation)[%modules]: Remove. [requested-graft?]: New variable. [add-modules]: New procedure. Rewrite in terms of 'lower-gexp'. (gexp-inputs): Add TODO comment. * tests/gexp.scm ("lower-gexp"): New test. --- guix/gexp.scm | 240 +++++++++++++++++++++++++++++++++++++++++++-------------- tests/gexp.scm | 37 +++++++++ 2 files changed, 218 insertions(+), 59 deletions(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index 4f2adba90a..ce48d8d001 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -39,6 +39,9 @@ gexp-input gexp-input? + gexp-input-thing + gexp-input-output + gexp-input-native? local-file local-file? @@ -78,6 +81,14 @@ load-path-expression gexp-modules + lower-gexp + lowered-gexp? + lowered-gexp-sexp + lowered-gexp-inputs + lowered-gexp-guile + lowered-gexp-load-path + lowered-gexp-load-compiled-path + gexp->derivation gexp->file gexp->script @@ -566,15 +577,20 @@ list." "Turn any package from INPUTS into a derivation for SYSTEM; return the corresponding input list as a monadic value. When TARGET is true, use it as the cross-compilation target triplet." + (define (store-item? obj) + (and (string? obj) (store-path? obj))) + (with-monad %store-monad (mapm %store-monad (match-lambda (((? struct? thing) sub-drv ...) (mlet %store-monad ((drv (lower-object thing system #:target target))) - (return `(,drv ,@sub-drv)))) + (return (apply gexp-input drv sub-drv)))) + (((? store-item? item)) + (return (gexp-input item))) (input - (return input))) + (return (gexp-input input)))) inputs))) (define* (lower-reference-graphs graphs #:key system target) @@ -586,7 +602,9 @@ corresponding derivation." (mlet %store-monad ((inputs (lower-inputs inputs #:system system #:target target))) - (return (map cons file-names inputs)))))) + (return (map (lambda (file input) + (cons file (gexp-input->tuple input))) + file-names inputs)))))) (define* (lower-references lst #:key system target) "Based on LST, a list of output names and packages, return a list of output @@ -618,6 +636,130 @@ names and file names suitable for the #:allowed-references argument to (lambda (system) ((force proc) system)))) +;; Representation of a gexp instantiated for a given target and system. +(define-record-type + (lowered-gexp sexp inputs guile load-path load-compiled-path) + lowered-gexp? + (sexp lowered-gexp-sexp) ;sexp + (inputs lowered-gexp-inputs) ;list of + (guile lowered-gexp-guile) ; | #f + (load-path lowered-gexp-load-path) ;list of store items + (load-compiled-path lowered-gexp-load-compiled-path)) ;list of store items + +(define* (lower-gexp exp + #:key + (module-path %load-path) + (system (%current-system)) + (target 'current) + (graft? (%graft?)) + (guile-for-build (%guile-for-build)) + (effective-version "2.2") + + deprecation-warnings + (pre-load-modules? #t)) ;transitional + "*Note: This API is subject to change; use at your own risk!* + +Lower EXP, a gexp, instantiating it for SYSTEM and TARGET. Return a + ready to be used. + +Lowered gexps are an intermediate representation that's useful for +applications that deal with gexps outside in a way that is disconnected from +derivations--e.g., code evaluated for its side effects." + (define %modules + (delete-duplicates (gexp-modules exp))) + + (define (search-path modules extensions suffix) + (append (match modules + ((? derivation? drv) + (list (derivation->output-path drv))) + (#f + '()) + ((? store-path? item) + (list item))) + (map (lambda (extension) + (string-append (match extension + ((? derivation? drv) + (derivation->output-path drv)) + ((? store-path? item) + item)) + suffix)) + extensions))) + + (mlet* %store-monad ( ;; The following binding forces '%current-system' and + ;; '%current-target-system' to be looked up at >>= + ;; time. + (graft? (set-grafting graft?)) + + (system -> (or system (%current-system))) + (target -> (if (eq? target 'current) + (%current-target-system) + target)) + (guile (if guile-for-build + (return guile-for-build) + (default-guile-derivation system))) + (normals (lower-inputs (gexp-inputs exp) + #:system system + #:target target)) + (natives (lower-inputs (gexp-native-inputs exp) + #:system system + #:target #f)) + (inputs -> (append normals natives)) + (sexp (gexp->sexp exp + #:system system + #:target target)) + (extensions -> (gexp-extensions exp)) + (exts (mapm %store-monad + (lambda (obj) + (lower-object obj system)) + extensions)) + (modules (if (pair? %modules) + (imported-modules %modules + #:system system + #:module-path module-path) + (return #f))) + (compiled (if (pair? %modules) + (compiled-modules %modules + #:system system + #:module-path module-path + #:extensions extensions + #:guile guile + #:pre-load-modules? + pre-load-modules? + #:deprecation-warnings + deprecation-warnings) + (return #f)))) + (define load-path + (search-path modules exts + (string-append "/share/guile/site/" effective-version))) + + (define load-compiled-path + (search-path compiled exts + (string-append "/lib/guile/" effective-version + "/site-ccache"))) + + (mbegin %store-monad + (set-grafting graft?) ;restore the initial setting + (return (lowered-gexp sexp + `(,@(if modules + (list (gexp-input modules)) + '()) + ,@(if compiled + (list (gexp-input compiled)) + '()) + ,@(map gexp-input exts) + ,@inputs) + guile + load-path + load-compiled-path))))) + +(define (gexp-input->tuple input) + "Given INPUT, a record, return the corresponding input tuple +suitable for the 'derivation' procedure." + (match (gexp-input-output input) + ("out" `(,(gexp-input-thing input))) + (output `(,(gexp-input-thing input) + ,(gexp-input-output input))))) + (define* (gexp->derivation name exp #:key system (target 'current) @@ -682,10 +824,8 @@ DEPRECATION-WARNINGS determines whether to show deprecation warnings while compiling modules. It can be #f, #t, or 'detailed. The other arguments are as for 'derivation'." - (define %modules - (delete-duplicates - (append modules (gexp-modules exp)))) (define outputs (gexp-outputs exp)) + (define requested-graft? graft?) (define (graphs-file-names graphs) ;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS. @@ -699,11 +839,13 @@ The other arguments are as for 'derivation'." (cons file-name thing))) graphs)) - (define (extension-flags extension) - `("-L" ,(string-append (derivation->output-path extension) - "/share/guile/site/" effective-version) - "-C" ,(string-append (derivation->output-path extension) - "/lib/guile/" effective-version "/site-ccache"))) + (define (add-modules exp modules) + (if (null? modules) + exp + (make-gexp (gexp-references exp) + (append modules (gexp-self-modules exp)) + (gexp-self-extensions exp) + (gexp-proc exp)))) (mlet* %store-monad ( ;; The following binding forces '%current-system' and ;; '%current-target-system' to be looked up at >>= @@ -714,40 +856,21 @@ The other arguments are as for 'derivation'." (target -> (if (eq? target 'current) (%current-target-system) target)) - (normals (lower-inputs (gexp-inputs exp) - #:system system - #:target target)) - (natives (lower-inputs (gexp-native-inputs exp) - #:system system - #:target #f)) - (inputs -> (append normals natives)) - (sexp (gexp->sexp exp - #:system system - #:target target)) - (builder (text-file script-name - (object->string sexp))) - (extensions -> (gexp-extensions exp)) - (exts (mapm %store-monad - (lambda (obj) - (lower-object obj system)) - extensions)) - (modules (if (pair? %modules) - (imported-modules %modules - #:system system - #:module-path module-path - #:guile guile-for-build) - (return #f))) - (compiled (if (pair? %modules) - (compiled-modules %modules - #:system system - #:module-path module-path - #:extensions extensions - #:guile guile-for-build - #:pre-load-modules? - pre-load-modules? - #:deprecation-warnings - deprecation-warnings) - (return #f))) + (exp -> (add-modules exp modules)) + (lowered (lower-gexp exp + #:module-path module-path + #:system system + #:target target + #:graft? requested-graft? + #:guile-for-build + guile-for-build + #:effective-version + effective-version + #:deprecation-warnings + deprecation-warnings + #:pre-load-modules? + pre-load-modules?)) + (graphs (if references-graphs (lower-reference-graphs references-graphs #:system system @@ -763,32 +886,30 @@ The other arguments are as for 'derivation'." #:system system #:target target) (return #f))) - (guile (if guile-for-build - (return guile-for-build) - (default-guile-derivation system)))) + (guile -> (lowered-gexp-guile lowered)) + (builder (text-file script-name + (object->string + (lowered-gexp-sexp lowered))))) (mbegin %store-monad (set-grafting graft?) ;restore the initial setting (raw-derivation name (string-append (derivation->output-path guile) "/bin/guile") `("--no-auto-compile" - ,@(if (pair? %modules) - `("-L" ,(if (derivation? modules) - (derivation->output-path modules) - modules) - "-C" ,(derivation->output-path compiled)) - '()) - ,@(append-map extension-flags exts) + ,@(append-map (lambda (directory) + `("-L" ,directory)) + (lowered-gexp-load-path lowered)) + ,@(append-map (lambda (directory) + `("-C" ,directory)) + (lowered-gexp-load-compiled-path lowered)) ,builder) #:outputs outputs #:env-vars env-vars #:system system #:inputs `((,guile) (,builder) - ,@(if modules - `((,modules) (,compiled) ,@inputs) - inputs) - ,@(map list exts) + ,@(map gexp-input->tuple + (lowered-gexp-inputs lowered)) ,@(match graphs (((_ . inputs) ...) inputs) (_ '()))) @@ -804,6 +925,7 @@ The other arguments are as for 'derivation'." (define* (gexp-inputs exp #:key native?) "Return the input list for EXP. When NATIVE? is true, return only native references; otherwise, return only non-native references." + ;; TODO: Return records instead of tuples. (define (add-reference-inputs ref result) (match ref (($ (? gexp? exp) _ #t) diff --git a/tests/gexp.scm b/tests/gexp.scm index cee2c96610..23904fce2e 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -832,6 +832,43 @@ (built-derivations (list drv)) (return (equal? '(42 84) (call-with-input-file out read)))))) +(test-assertm "lower-gexp" + (mlet* %store-monad + ((extension -> %extension-package) + (extension-drv (package->derivation %extension-package)) + (coreutils-drv (package->derivation coreutils)) + (exp -> (with-extensions (list extension) + (with-imported-modules `((guix build utils)) + #~(begin + (use-modules (guix build utils) + (hg2g)) + #$coreutils:debug + mkdir-p + the-answer)))) + (lexp (lower-gexp exp + #:effective-version "2.0"))) + (define (matching-input drv output) + (lambda (input) + (and (eq? (gexp-input-thing input) drv) + (string=? (gexp-input-output input) output)))) + + (mbegin %store-monad + (return (and (find (matching-input extension-drv "out") + (lowered-gexp-inputs (pk 'lexp lexp))) + (find (matching-input coreutils-drv "debug") + (lowered-gexp-inputs lexp)) + (member (string-append + (derivation->output-path extension-drv) + "/share/guile/site/2.0") + (lowered-gexp-load-path lexp)) + (= 2 (length (lowered-gexp-load-path lexp))) + (member (string-append + (derivation->output-path extension-drv) + "/lib/guile/2.0/site-ccache") + (lowered-gexp-load-compiled-path lexp)) + (= 2 (length (lowered-gexp-load-compiled-path lexp))) + (eq? (lowered-gexp-guile lexp) (%guile-for-build))))))) + (test-assertm "gexp->derivation #:references-graphs" (mlet* %store-monad ((one (text-file "one" (random-text))) -- cgit v1.2.3 From 92a4087bf4862d5ba9b77111eba3c68c2a1c4679 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Jun 2019 17:09:35 +0200 Subject: Add (guix repl). * guix/scripts/repl.scm: Use (guix repl). (self-quoting?, machine-repl): Remove. * guix/repl.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + guix/repl.scm | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/repl.scm | 56 ++------------------------------- 3 files changed, 90 insertions(+), 53 deletions(-) create mode 100644 guix/repl.scm diff --git a/Makefile.am b/Makefile.am index 8adf23c699..9c070cd5b8 100644 --- a/Makefile.am +++ b/Makefile.am @@ -90,6 +90,7 @@ MODULES = \ guix/nar.scm \ guix/derivations.scm \ guix/grafts.scm \ + guix/repl.scm \ guix/inferior.scm \ guix/describe.scm \ guix/channels.scm \ diff --git a/guix/repl.scm b/guix/repl.scm new file mode 100644 index 0000000000..5cff5c71e9 --- /dev/null +++ b/guix/repl.scm @@ -0,0 +1,86 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018, 2019 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix repl) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 match) + #:export (send-repl-response + machine-repl)) + +;;; Commentary: +;;; +;;; This module implements the "machine-readable" REPL provided by +;;; 'guix repl -t machine'. It's a lightweight module meant to be +;;; embedded in any Guile process providing REPL functionality. +;;; +;;; Code: + +(define (self-quoting? x) + "Return #t if X is self-quoting." + (letrec-syntax ((one-of (syntax-rules () + ((_) #f) + ((_ pred rest ...) + (or (pred x) + (one-of rest ...)))))) + (one-of symbol? string? pair? null? vector? + bytevector? number? boolean?))) + + +(define (send-repl-response exp output) + "Write the response corresponding to the evaluation of EXP to PORT, an +output port." + (define (value->sexp value) + (if (self-quoting? value) + `(value ,value) + `(non-self-quoting ,(object-address value) + ,(object->string value)))) + + (catch #t + (lambda () + (let ((results (call-with-values + (lambda () + (primitive-eval exp)) + list))) + (write `(values ,@(map value->sexp results)) + output) + (newline output) + (force-output output))) + (lambda (key . args) + (write `(exception ,key ,@(map value->sexp args))) + (newline output) + (force-output output)))) + +(define* (machine-repl #:optional + (input (current-input-port)) + (output (current-output-port))) + "Run a machine-usable REPL over ports INPUT and OUTPUT. + +The protocol of this REPL is meant to be machine-readable and provides proper +support to represent multiple-value returns, exceptions, objects that lack a +read syntax, and so on. As such it is more convenient and robust than parsing +Guile's REPL prompt." + (write `(repl-version 0 0) output) + (newline output) + (force-output output) + + (let loop () + (match (read input) + ((? eof-object?) #t) + (exp + (send-repl-response exp output) + (loop))))) diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm index 02169e8004..e1cc759fc8 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,7 @@ (define-module (guix scripts repl) #:use-module (guix ui) #:use-module (guix scripts) + #:use-module (guix repl) #:use-module (guix utils) #:use-module (guix packages) #:use-module (gnu packages) @@ -29,8 +30,7 @@ #:autoload (system repl repl) (start-repl) #:autoload (system repl server) (make-tcp-server-socket make-unix-domain-server-socket) - #:export (machine-repl - guix-repl)) + #:export (guix-repl)) ;;; Commentary: ;;; @@ -68,62 +68,12 @@ Start a Guile REPL in the Guix execution environment.\n")) (newline) (show-bug-report-information)) -(define (self-quoting? x) - "Return #t if X is self-quoting." - (letrec-syntax ((one-of (syntax-rules () - ((_) #f) - ((_ pred rest ...) - (or (pred x) - (one-of rest ...)))))) - (one-of symbol? string? pair? null? vector? - bytevector? number? boolean?))) - (define user-module ;; Module where we execute user code. (let ((module (resolve-module '(guix-user) #f #f #:ensure #t))) (beautify-user-module! module) module)) -(define* (machine-repl #:optional - (input (current-input-port)) - (output (current-output-port))) - "Run a machine-usable REPL over ports INPUT and OUTPUT. - -The protocol of this REPL is meant to be machine-readable and provides proper -support to represent multiple-value returns, exceptions, objects that lack a -read syntax, and so on. As such it is more convenient and robust than parsing -Guile's REPL prompt." - (define (value->sexp value) - (if (self-quoting? value) - `(value ,value) - `(non-self-quoting ,(object-address value) - ,(object->string value)))) - - (write `(repl-version 0 0) output) - (newline output) - (force-output output) - - (let loop () - (match (read input) - ((? eof-object?) #t) - (exp - (catch #t - (lambda () - (let ((results (call-with-values - (lambda () - - (primitive-eval exp)) - list))) - (write `(values ,@(map value->sexp results)) - output) - (newline output) - (force-output output))) - (lambda (key . args) - (write `(exception ,key ,@(map value->sexp args))) - (newline output) - (force-output output))) - (loop))))) - (define (call-with-connection spec thunk) "Dynamically-bind the current input and output ports according to SPEC and call THUNK." -- cgit v1.2.3 From d0ffa321dd4917ddb9777728ccf90bd147fe51fb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Jun 2019 17:11:43 +0200 Subject: inferior: Add 'read-repl-response'. * guix/inferior.scm (read-repl-response): New procedure. (read-inferior-response): Use it. --- guix/inferior.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index 63c95141d7..fee97750b6 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -59,6 +59,7 @@ inferior-eval inferior-eval-with-store inferior-object? + read-repl-response inferior-packages inferior-available-packages @@ -183,7 +184,8 @@ equivalent. Return #f if the inferior could not be launched." (set-record-type-printer! write-inferior-object) -(define (read-inferior-response inferior) +(define (read-repl-response port) + "Read a (guix repl) response from PORT and return it as a Scheme object." (define sexp->object (match-lambda (('value value) @@ -191,12 +193,15 @@ equivalent. Return #f if the inferior could not be launched." (('non-self-quoting address string) (inferior-object address string)))) - (match (read (inferior-socket inferior)) + (match (read port) (('values objects ...) (apply values (map sexp->object objects))) (('exception key objects ...) (apply throw key (map sexp->object objects))))) +(define (read-inferior-response inferior) + (read-repl-response (inferior-socket inferior))) + (define (send-inferior-request exp inferior) (write exp (inferior-socket inferior)) (newline (inferior-socket inferior))) -- cgit v1.2.3 From 9d8ab8034ea4efe5f6ac317df7cf2c7c7e76590d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Jun 2019 22:39:39 +0200 Subject: Add (guix remote). * guix/remote.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + guix/remote.scm | 134 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 135 insertions(+) create mode 100644 guix/remote.scm diff --git a/Makefile.am b/Makefile.am index 9c070cd5b8..31430545cb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -274,6 +274,7 @@ if HAVE_GUILE_SSH MODULES += \ guix/ssh.scm \ + guix/remote.scm \ guix/scripts/copy.scm \ guix/store/ssh.scm diff --git a/guix/remote.scm b/guix/remote.scm new file mode 100644 index 0000000000..e503c76167 --- /dev/null +++ b/guix/remote.scm @@ -0,0 +1,134 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix remote) + #:use-module (guix ssh) + #:use-module (guix gexp) + #:use-module (guix inferior) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix modules) + #:use-module (guix derivations) + #:use-module (ssh popen) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:export (remote-eval)) + +;;; Commentary: +;;; +;;; Note: This API is experimental and subject to change! +;;; +;;; Evaluate a gexp on a remote machine, over SSH, ensuring that all the +;;; elements the gexp refers to are deployed beforehand. This is useful for +;;; expressions that have side effects; for pure expressions, you would rather +;;; build a derivation remotely or offload it. +;;; +;;; Code: + +(define (remote-pipe-for-gexp lowered session) + "Return a remote pipe for the given SESSION to evaluate LOWERED." + (define shell-quote + (compose object->string object->string)) + + (apply open-remote-pipe* session OPEN_READ + (string-append (derivation->output-path + (lowered-gexp-guile lowered)) + "/bin/guile") + "--no-auto-compile" + (append (append-map (lambda (directory) + `("-L" ,directory)) + (lowered-gexp-load-path lowered)) + (append-map (lambda (directory) + `("-C" ,directory)) + (lowered-gexp-load-path lowered)) + `("-c" + ,(shell-quote (lowered-gexp-sexp lowered)))))) + +(define (%remote-eval lowered session) + "Evaluate LOWERED, a lowered gexp, in SESSION. This assumes that all the +prerequisites of EXP are already available on the host at SESSION." + (let* ((pipe (remote-pipe-for-gexp lowered session)) + (result (read-repl-response pipe))) + (close-port pipe) + result)) + +(define (trampoline exp) + "Return a \"trampoline\" gexp that evaluates EXP and writes the evaluation +result to the current output port using the (guix repl) protocol." + (define program + (scheme-file "remote-exp.scm" exp)) + + (with-imported-modules (source-module-closure '((guix repl))) + #~(begin + (use-modules (guix repl)) + (send-repl-response '(primitive-load #$program) + (current-output-port)) + (force-output)))) + +(define* (remote-eval exp session + #:key + (build-locally? #t) + (module-path %load-path) + (socket-name "/var/guix/daemon-socket/socket")) + "Evaluate EXP, a gexp, on the host at SESSION, an SSH session. Ensure that +all the elements EXP refers to are built and deployed to SESSION beforehand. +When BUILD-LOCALLY? is true, said dependencies are built locally and sent to +the remote store afterwards; otherwise, dependencies are built directly on the +remote store." + (mlet %store-monad ((lowered (lower-gexp (trampoline exp) + #:module-path %load-path)) + (remote -> (connect-to-remote-daemon session + socket-name))) + (define inputs + (cons (gexp-input (lowered-gexp-guile lowered)) + (lowered-gexp-inputs lowered))) + + (define to-build + (map (lambda (input) + (if (derivation? (gexp-input-thing input)) + (cons (gexp-input-thing input) + (gexp-input-output input)) + (gexp-input-thing input))) + inputs)) + + (if build-locally? + (let ((to-send (map (lambda (input) + (match (gexp-input-thing input) + ((? derivation? drv) + (derivation->output-path + drv (gexp-input-output input))) + ((? store-path? item) + item))) + inputs))) + (mbegin %store-monad + (built-derivations to-build) + ((store-lift send-files) to-send remote #:recursive? #t) + (return (close-connection remote)) + (return (%remote-eval lowered session)))) + (let ((to-send (map (lambda (input) + (match (gexp-input-thing input) + ((? derivation? drv) + (derivation-file-name drv)) + ((? store-path? item) + item))) + inputs))) + (mbegin %store-monad + ((store-lift send-files) to-send remote #:recursive? #t) + (return (build-derivations remote to-build)) + (return (close-connection remote)) + (return (%remote-eval lowered session))))))) -- cgit v1.2.3 From b9fcf0c82a14df48c7c6f36a08dbdcd3184fcbf8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 2 Jul 2019 09:19:48 +0200 Subject: pack: 'docker' backend records the profile's search paths. * guix/docker.scm (config): Add #:environment parameter and honor it. (build-docker-image): Likewise, and pass it to 'config'. * guix/scripts/pack.scm (docker-image): Import (guix profiles) and (guix search-paths). Call 'profile-search-paths' and pass #:environment to 'build-docker-image'. * gnu/tests/docker.scm (run-docker-test)["Load docker image and run it"]: Add example that expects (json) to be available. * gnu/tests/docker.scm (build-tarball&run-docker-test): Replace %BOOTSTRAP-GUILE by GUILE-2.2 and GUILE-JSON in the environment. --- gnu/tests/docker.scm | 18 ++++++++++++------ guix/docker.scm | 17 +++++++++++++---- guix/scripts/pack.scm | 23 +++++++++++++++++++---- 3 files changed, 44 insertions(+), 14 deletions(-) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index f2674cdbe8..3ec5c3d6ee 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -27,7 +27,6 @@ #:use-module (gnu services networking) #:use-module (gnu services docker) #:use-module (gnu services desktop) - #:use-module (gnu packages bootstrap) ; %bootstrap-guile #:use-module (gnu packages docker) #:use-module (gnu packages guile) #:use-module (guix gexp) @@ -101,7 +100,7 @@ inside %DOCKER-OS." marionette)) (test-equal "Load docker image and run it" - '("hello world" "hi!") + '("hello world" "hi!" "JSON!") (marionette-eval `(begin (define slurp @@ -125,8 +124,15 @@ inside %DOCKER-OS." (response2 (slurp ;default entry point ,(string-append #$docker-cli "/bin/docker") "run" repository&tag - "-c" "(display \"hi!\")"))) - (list response1 response2))) + "-c" "(display \"hi!\")")) + + ;; Check whether (json) is in $GUILE_LOAD_PATH. + (response3 (slurp ;default entry point + environment + ,(string-append #$docker-cli "/bin/docker") + "run" repository&tag + "-c" "(use-modules (json)) + (display (json-string->scm (scm->json-string \"JSON!\")))"))) + (list response1 response2 response3))) marionette)) (test-end) @@ -144,7 +150,7 @@ inside %DOCKER-OS." (version "0") (source #f) (build-system trivial-build-system) - (arguments `(#:guile ,%bootstrap-guile + (arguments `(#:guile ,guile-2.2 #:builder (let ((out (assoc-ref %outputs "out"))) (mkdir out) @@ -158,7 +164,7 @@ standard output device and then enters a new line.") (home-page #f) (license license:public-domain))) (profile (profile-derivation (packages->manifest - (list %bootstrap-guile + (list guile-2.2 guile-json guest-script-package)) #:hooks '() #:locales? #f)) diff --git a/guix/docker.scm b/guix/docker.scm index 7fe83d9797..b1bd226fa1 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -73,7 +73,7 @@ `((,(generate-tag path) . ((latest . ,id))))) ;; See https://github.com/opencontainers/image-spec/blob/master/config.md -(define* (config layer time arch #:key entry-point) +(define* (config layer time arch #:key entry-point (environment '())) "Generate a minimal image configuration for the given LAYER file." ;; "architecture" must be values matching "platform.arch" in the ;; runtime-spec at @@ -81,9 +81,13 @@ `((architecture . ,arch) (comment . "Generated by GNU Guix") (created . ,time) - (config . ,(if entry-point - `((entrypoint . ,entry-point)) - #nil)) + (config . ,`((env . ,(map (match-lambda + ((name . value) + (string-append name "=" value))) + environment)) + ,@(if entry-point + `((entrypoint . ,entry-point)) + '()))) (container_config . #nil) (os . "linux") (rootfs . ((type . "layers") @@ -113,6 +117,7 @@ return \"a\"." (system (utsname:machine (uname))) database entry-point + (environment '()) compressor (creation-time (current-time time-utc))) "Write to IMAGE a Docker image archive containing the given PATHS. PREFIX @@ -124,6 +129,9 @@ When DATABASE is true, copy it to /var/guix/db in the image and create When ENTRY-POINT is true, it must be a list of strings; it is stored as the entry point in the Docker image JSON structure. +ENVIRONMENT must be a list of name/value pairs. It specifies the environment +variables that must be defined in the resulting image. + SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be created in the image, where each TARGET is relative to PREFIX. TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to @@ -234,6 +242,7 @@ SRFI-19 time-utc object, as the creation time in metadata." (lambda () (scm->json (config (string-append id "/layer.tar") time arch + #:environment environment #:entry-point entry-point)))) (with-output-to-file "manifest.json" (lambda () diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index c90b777222..bb6a8cda1a 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -27,6 +27,7 @@ #:use-module (guix utils) #:use-module (guix store) #:use-module ((guix status) #:select (with-status-verbosity)) + #:use-module ((guix self) #:select (make-config.scm)) #:use-module (guix grafts) #:autoload (guix inferior) (inferior-package?) #:use-module (guix monads) @@ -440,11 +441,24 @@ the image." (define build ;; Guile-JSON and Guile-Gcrypt are required by (guix docker). (with-extensions (list guile-json guile-gcrypt) - (with-imported-modules (source-module-closure '((guix docker) - (guix build store-copy)) - #:select? not-config?) + (with-imported-modules `(((guix config) => ,(make-config.scm)) + ,@(source-module-closure + `((guix docker) + (guix build store-copy) + (guix profiles) + (guix search-paths)) + #:select? not-config?)) #~(begin - (use-modules (guix docker) (srfi srfi-19) (guix build store-copy)) + (use-modules (guix docker) (guix build store-copy) + (guix profiles) (guix search-paths) + (srfi srfi-19) (ice-9 match)) + + (define environment + (map (match-lambda + ((spec . value) + (cons (search-path-specification-variable spec) + value))) + (profile-search-paths #$profile))) (setenv "PATH" (string-append #$archiver "/bin")) @@ -455,6 +469,7 @@ the image." #$profile #:database #+database #:system (or #$target (utsname:machine (uname))) + #:environment environment #:entry-point #$(and entry-point #~(string-append #$profile "/" #$entry-point)) -- cgit v1.2.3 From dea62932bc929243dae5e8b08f4fbe0b6f70be95 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 2 Jul 2019 10:30:23 +0200 Subject: pack: 'squashfs' backend records the profile's search paths. * guix/scripts/pack.scm (singularity-environment-file): New procedure. (squashfs-image): Use it, and create /.singularity/env/90-environment.sh. * gnu/tests/singularity.scm (run-singularity-test)["singularity run, with environment"]: New test, currently skipped. * gnu/tests/singularity.scm (build-tarball&run-singularity-test): Add GUILE-JSON to the profile. --- gnu/tests/singularity.scm | 18 +++++++++++++++++- guix/scripts/pack.scm | 41 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 57 insertions(+), 2 deletions(-) diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm index 668043a0bc..2f3a6f289d 100644 --- a/gnu/tests/singularity.scm +++ b/gnu/tests/singularity.scm @@ -111,6 +111,21 @@ "run" #$image "-c" "(exit 42)")) marionette)) + ;; FIXME: Singularity 2.x doesn't directly honor + ;; /.singularity.d/env/*.sh. Instead, you have to load those files + ;; manually, which we don't do. Remove 'test-skip' call once we've + ;; switch to Singularity 3.x. + (test-skip 1) + (test-equal "singularity run, with environment" + 0 + (marionette-eval + ;; Check whether GUILE_LOAD_PATH is properly set, allowing us to + ;; find the (json) module. + `(status:exit-val + (system* #$(file-append singularity "/bin/singularity") + "--debug" "run" #$image "-c" "(use-modules (json))")) + marionette)) + (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) @@ -122,7 +137,8 @@ (guile (set-guile-for-build (default-guile))) ;; 'singularity exec' insists on having /bin/sh in the image. (profile (profile-derivation (packages->manifest - (list bash-minimal guile-2.2)) + (list bash-minimal + guile-2.2 guile-json)) #:hooks '() #:locales? #f)) (tarball (squashfs-image "singularity-pack" profile diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index bb6a8cda1a..4ac5dfc896 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -286,6 +286,32 @@ added to the pack." build #:references-graphs `(("profile" ,profile)))) +(define (singularity-environment-file profile) + "Return a shell script that defines the environment variables corresponding +to the search paths of PROFILE." + (define build + (with-extensions (list guile-gcrypt) + (with-imported-modules `(((guix config) => ,(make-config.scm)) + ,@(source-module-closure + `((guix profiles) + (guix search-paths)) + #:select? not-config?)) + #~(begin + (use-modules (guix profiles) (guix search-paths) + (ice-9 match)) + + (call-with-output-file #$output + (lambda (port) + (for-each (match-lambda + ((spec . value) + (format port "~a=~a~%export ~a~%" + (search-path-specification-variable spec) + value + (search-path-specification-variable spec)))) + (profile-search-paths #$profile)))))))) + + (computed-file "singularity-environment.sh" build)) + (define* (squashfs-image name profile #:key target (profile-name "guix-profile") @@ -305,6 +331,9 @@ added to the pack." (file-append (store-database (list profile)) "/db/db.sqlite"))) + (define environment + (singularity-environment-file profile)) + (define build (with-imported-modules (source-module-closure '((guix build utils) @@ -339,6 +368,7 @@ added to the pack." `(,@(map store-info-item (call-with-input-file "profile" read-reference-graph)) + #$environment ,#$output ;; Do not perform duplicate checking because we @@ -379,10 +409,19 @@ added to the pack." target))))))) '#$symlinks) + "-p" "/.singularity.d d 555 0 0" + + ;; Create the environment file. + "-p" "/.singularity.d/env d 555 0 0" + "-p" ,(string-append + "/.singularity.d/env/90-environment.sh s 777 0 0 " + (relative-file-name "/.singularity.d/env" + #$environment)) + ;; Create /.singularity.d/actions, and optionally the 'run' ;; script, used by 'singularity run'. - "-p" "/.singularity.d d 555 0 0" "-p" "/.singularity.d/actions d 555 0 0" + ,@(if entry-point `(;; This one if for Singularity 2.x. "-p" -- cgit v1.2.3 From fb236fddb277ccde372e3b81b23cd00f76c072db Mon Sep 17 00:00:00 2001 From: Alex Griffin Date: Thu, 13 Jun 2019 13:46:14 -0500 Subject: gnu: Add python-notify2, python2-notify2. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/python-xyz.scm (python-notify2): New variable. (python2-notify2): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/python-xyz.scm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 1e2adb8f2f..860efd38ed 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -61,6 +61,7 @@ ;;; Copyright © 2019 Sam ;;; Copyright © 2019 Jack Hill ;;; Copyright © 2019 Guillaume Le Vaillant +;;; Copyright © 2019 Alex Griffin ;;; ;;; This file is part of GNU Guix. ;;; @@ -5601,6 +5602,33 @@ implementation of D-Bus.") ;; "ValueError: unichr() arg not in range(0x10000) (narrow Python build)" (arguments `(#:tests? #f)))) +(define-public python-notify2 + (package + (name "python-notify2") + (version "0.3.1") + (source + (origin + (method url-fetch) + (uri (pypi-uri "notify2" version)) + (sha256 + (base32 + "0z8rrv9rsg1r2qgh2dxj3dfj5xnki98kgi3w839kqby4a26i1yik")))) + (build-system python-build-system) + (arguments `(#:tests? #f)) ; tests depend on system state + (native-inputs + `(("python-dbus" ,python-dbus))) + (home-page "https://bitbucket.org/takluyver/pynotify2") + (synopsis "Python interface to D-Bus notifications") + (description + "Pynotify2 provides a Python interface for sending D-Bus notifications. +It is a reimplementation of pynotify in pure Python, and an alternative to +the GObject Introspection bindings to libnotify for non-GTK applications.") + (license (list license:bsd-2 + license:lgpl2.1+)))) + +(define-public python2-notify2 + (package-with-python2 python-notify2)) + (define-public python-lxml (package (name "python-lxml") -- cgit v1.2.3 From dd85eca02a57b40360e567691a4d031d88a75ad7 Mon Sep 17 00:00:00 2001 From: Alex Griffin Date: Thu, 13 Jun 2019 15:46:10 -0500 Subject: gnu: Add python2-pyroute2. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/python-xyz.scm (python2-pyroute2): New variable. Co-authored-by: Ludovic Courtès --- gnu/packages/python-xyz.scm | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 860efd38ed..bcf2a51963 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -6901,6 +6901,41 @@ and MAC network addresses.") (define-public python2-netaddr (package-with-python2 python-netaddr)) +(define-public python2-pyroute2 + (package + (name "python2-pyroute2") + (version "0.5.6") + (source + (origin + (method url-fetch) + (uri (pypi-uri "pyroute2" version)) + (sha256 + (base32 + "1gmz4r1w0yzj6fjjypnalmfyy0lnfznydyn62gi3wk50j5hhxbny")))) + (build-system python-build-system) + (arguments + `(#:python ,python-2)) ;Python 3.x is not supported + (home-page "https://github.com/svinota/pyroute2") + (synopsis "Python netlink library") + (description + "Pyroute2 is a pure Python netlink library with minimal dependencies. +Supported netlink families and protocols include: +@itemize +@item rtnl, network settings - addresses, routes, traffic controls +@item nfnetlink - netfilter API: ipset, nftables, ... +@item ipq - simplest userspace packet filtering, iptables QUEUE target +@item devlink - manage and monitor devlink-enabled hardware +@item generic - generic netlink families + @itemize + @item nl80211 - wireless functions API (basic support) + @item taskstats - extended process statistics + @item acpi_events - ACPI events monitoring + @item thermal_events - thermal events monitoring + @item VFS_DQUOT - disk quota events monitoring + @end itemize +@end itemize") + (license license:gpl2+))) + (define-public python-wrapt (package (name "python-wrapt") -- cgit v1.2.3 From 6609ebe7af01f7adc3929504cfcb05ead3c0fb0c Mon Sep 17 00:00:00 2001 From: Alex Griffin Date: Thu, 13 Jun 2019 14:21:53 -0500 Subject: gnu: Add python2-zeroconf. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/python-xyz.scm (python2-zeroconf): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/python-xyz.scm | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index bcf2a51963..b911d3693d 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -15830,6 +15830,42 @@ by Igor Pavlov.") (define-public python2-pylzma (package-with-python2 python-pylzma)) +(define-public python2-zeroconf + (package + (name "python2-zeroconf") + + ;; This is the last version that supports Python 2.x. + (version "0.19.1") + (source + (origin + (method url-fetch) + (uri (pypi-uri "zeroconf" version)) + (sha256 + (base32 + "0ykzg730n915qbrq9bn5pn06bv6rb5zawal4sqjyfnjjm66snkj3")))) + (build-system python-build-system) + (arguments + `(#:python ,python-2 + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'patch-requires + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "setup.py" + (("enum-compat") + "enum34")) + #t))))) + (native-inputs + `(("python2-six" ,python2-six) + ("python2-enum32" ,python2-enum34) + ("python2-netifaces" ,python2-netifaces) + ("python2-typing" ,python2-typing))) + (home-page "https://github.com/jstasiak/python-zeroconf") + (synopsis "Pure Python mDNS service discovery") + (description + "Pure Python multicast DNS (mDNS) service discovery library (Bonjour/Avahi +compatible).") + (license license:lgpl2.1+))) + (define-public python-bsddb3 (package (name "python-bsddb3") -- cgit v1.2.3 From e2332dec9ff3bd5da98dd37051849f0894a265f4 Mon Sep 17 00:00:00 2001 From: Alex Griffin Date: Thu, 13 Jun 2019 15:45:38 -0500 Subject: gnu: Add pulseaudio-dlna. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/pulseaudio.scm (pulseaudio-dlna): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/pulseaudio.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/gnu/packages/pulseaudio.scm b/gnu/packages/pulseaudio.scm index 96d15bdf9c..fa48d8a7a6 100644 --- a/gnu/packages/pulseaudio.scm +++ b/gnu/packages/pulseaudio.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2017 Stefan Reichör ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; Copyright © 2018 Pierre Langlois +;;; Copyright © 2019 Alex Griffin ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,6 +28,7 @@ (define-module (gnu packages pulseaudio) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix git-download) #:use-module ((guix licenses) #:prefix l:) #:use-module (guix build-system gnu) #:use-module (guix build-system python) @@ -43,6 +45,10 @@ #:use-module (gnu packages web) #:use-module (gnu packages linux) #:use-module (gnu packages m4) + #:use-module (gnu packages protobuf) + #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) + #:use-module (gnu packages python-web) #:use-module (gnu packages pkg-config) #:use-module (gnu packages xiph)) @@ -303,3 +309,55 @@ sinks.") (description "Pulsemixer is a PulseAudio mixer with command-line and curses-style interfaces.") (license l:expat))) + +(define-public pulseaudio-dlna + ;; The last release was in 2016; use a more recent commit. + (let ((commit "4472928dd23f274193f14289f59daec411023ab0") + (revision "1")) + (package + (name "pulseaudio-dlna") + (version (git-version "0.5.2" revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/masmu/pulseaudio-dlna.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1dfn7036vrq49kxv4an7rayypnm5dlawsf02pfsldw877hzdamqk")))) + (build-system python-build-system) + (arguments `(#:python ,python-2)) + (inputs + `(("python2-chardet" ,python2-chardet) + ("python2-dbus" ,python2-dbus) + ("python2-docopt" ,python2-docopt) + ("python2-futures" ,python2-futures) + ("python2-pygobject" ,python2-pygobject) + ("python2-lxml" ,python2-lxml) + ("python2-netifaces" ,python2-netifaces) + ("python2-notify2" ,python2-notify2) + ("python2-protobuf" ,python2-protobuf) + ("python2-psutil" ,python2-psutil) + ("python2-requests" ,python2-requests) + ("python2-pyroute2" ,python2-pyroute2) + ("python2-setproctitle" ,python2-setproctitle) + ("python2-zeroconf" ,python2-zeroconf))) + (home-page "https://github.com/masmu/pulseaudio-dlna") + (synopsis "Stream audio to DLNA/UPnP and Chromecast devices") + (description "This lightweight streaming server brings DLNA/UPnP and +Chromecast support to PulseAudio. It can stream your current PulseAudio +playback to different UPnP devices (UPnP Media Renderers, including Sonos +devices and some Smart TVs) or Chromecasts in your network. You should also +install one or more of the following packages alongside pulseaudio-dlna: + +@itemize +@item ffmpeg - transcoding support for multiple codecs +@item flac - FLAC transcoding support +@item lame - MP3 transcoding support +@item opus-tools - Opus transcoding support +@item sox - WAV transcoding support +@item vorbis-tools - Vorbis transcoding support +@end itemize") + (license l:gpl3+)))) -- cgit v1.2.3 From e3750dc7cb49eb903f78ecc0dc8de573abf26573 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:16:36 +0200 Subject: gnu: Add sbcl-lisp-namespace. * gnu/packages/lisp.scm (sbcl-lisp-namespace): New variable. --- gnu/packages/lisp.scm | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 8250340467..11d21ca6eb 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6092,3 +6092,36 @@ cookie headers, cookie creation, cookie jar creation and more.") (description "Dexador is yet another HTTP client for Common Lisp with neat APIs and connection-pooling. It is meant to supersede Drakma.") (license license:expat)))) + +(define-public sbcl-lisp-namespace + (let ((commit "28107cafe34e4c1c67490fde60c7f92dc610b2e0") + (revision "1")) + (package + (name "sbcl-lisp-namespace") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/guicho271828/lisp-namespace") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1jw2wykp06z2afb9nm1lgfzll5cjlj36pnknjx614057zkkxq4iy")))) + (inputs + `(("alexandria" ,sbcl-alexandria))) + (native-inputs + `(("fiveam" ,sbcl-fiveam))) + (arguments + `(#:test-asd-file "lisp-namespace.test.asd" + ;; XXX: Component LISP-NAMESPACE-ASD::LISP-NAMESPACE.TEST not found + #:tests? #f)) + (synopsis "LISP-N, or extensible namespaces in Common Lisp") + (description "Common Lisp already has major 2 namespaces, function +namespace and value namespace (or variable namespace), but there are actually +more — e.g., class namespace. +This library offers macros to deal with symbols from any namespace.") + (license license:llgpl)))) -- cgit v1.2.3 From 9526af923ad08b1059ea3a4f3c1f81b95169106a Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:17:33 +0200 Subject: gnu: Add sbcl-trivial-cltl2. * gnu/packages/lisp.scm (sbcl-trivial-cltl2): New variable. --- gnu/packages/lisp.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 11d21ca6eb..8c3a7cbd7f 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6125,3 +6125,28 @@ namespace and value namespace (or variable namespace), but there are actually more — e.g., class namespace. This library offers macros to deal with symbols from any namespace.") (license license:llgpl)))) + +(define-public sbcl-trivial-cltl2 + (let ((commit "8eec8407df833e8f27df8a388bc10913f16d9e83") + (revision "1")) + (package + (name "sbcl-trivial-cltl2") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1.1" revision commit)) + (home-page "https://github.com/Zulu-Inuoe/trivial-cltl2") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1dyyxz17vqv8hlfwq287gl8xxbvcnq798ajb7p5jdjz91wqf4bgk")))) + (synopsis "Simple CLtL2 compatibility layer for Common Lisp") + (description "This library is a portable compatibility layer around +\"Common Lisp the Language, 2nd +Edition\" (@url{https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node102.html}) +and it exports symbols from implementation-specific packages.") + (license license:llgpl)))) -- cgit v1.2.3 From f4a7653e44091350ece1bcbda6dfb0bef28a5786 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:18:43 +0200 Subject: gnu: Add sbcl-introspect-environment. * gnu/packages/lisp.scm (sbcl-introspect-environment): New variable. --- gnu/packages/lisp.scm | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 8c3a7cbd7f..de4a55bf16 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6150,3 +6150,44 @@ This library offers macros to deal with symbols from any namespace.") Edition\" (@url{https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node102.html}) and it exports symbols from implementation-specific packages.") (license license:llgpl)))) + +(define-public sbcl-introspect-environment + (let ((commit "fff42f8f8fd0d99db5ad6c5812e53de7d660020b") + (revision "1")) + (package + (name "sbcl-introspect-environment") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/Bike/introspect-environment") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1i305n0wfmpac63ni4i3vixnnkl8daw5ncxy0k3dv92krgx6qzhp")))) + (native-inputs + `(("fiveam" ,sbcl-fiveam))) + (synopsis "Common Lisp environment introspection portability layer") + (description "This library is a small interface to portable but +nonstandard introspection of Common Lisp environments. It is intended to +allow a bit more compile-time introspection of environments in Common Lisp. + +Quite a bit of information is available at the time a macro or compiler-macro +runs; inlining info, type declarations, that sort of thing. This information +is all standard - any Common Lisp program can @code{(declare (integer x))} and +such. + +This info ought to be accessible through the standard @code{&environment} +parameters, but it is not. Several implementations keep the information for +their own purposes but do not make it available to user programs, because +there is no standard mechanism to do so. + +This library uses implementation-specific hooks to make information available +to users. This is currently supported on SBCL, CCL, and CMUCL. Other +implementations have implementations of the functions that do as much as they +can and/or provide reasonable defaults.") + (license license:wtfpl2)))) -- cgit v1.2.3 From b0c1007dec8dee9ed8d7a8eb9397dae5612d50d4 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:19:49 +0200 Subject: gnu: Add sbcl-type-i. * gnu/packages/lisp.scm (sbcl-type-i): New variable. --- gnu/packages/lisp.scm | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index de4a55bf16..aec99cc121 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6191,3 +6191,35 @@ to users. This is currently supported on SBCL, CCL, and CMUCL. Other implementations have implementations of the functions that do as much as they can and/or provide reasonable defaults.") (license license:wtfpl2)))) + +(define-public sbcl-type-i + (let ((commit "dea233f45f94064105ec09f0767de338f67dcbe2") + (revision "1")) + (package + (name "sbcl-type-i") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/guicho271828/type-i") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "039g5pbrhh65s0bhr9314gmd2nwc2y5lp2377c5qrc2lxky89qs3")))) + (inputs + `(("alexandria" ,sbcl-alexandria) + ("introspect-environment" ,sbcl-introspect-environment) + ("trivia.trivial" ,sbcl-trivia.trivial))) + (native-inputs + `(("fiveam" ,sbcl-fiveam))) + (arguments + `(#:test-asd-file "type-i.test.asd")) + (synopsis "Type inference utility on unary predicates for Common Lisp") + (description "This library tries to provide a way to detect what kind of +type the given predicate is trying to check. This is different from inferring +the return type of a function.") + (license license:llgpl)))) -- cgit v1.2.3 From f1eb7961348f7e34932727de286303a41f5316ba Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:20:29 +0200 Subject: gnu: Add sbcl-optima. * gnu/packages/lisp.scm (sbcl-optima): New variable. --- gnu/packages/lisp.scm | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index aec99cc121..d2c6b21a0c 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6223,3 +6223,35 @@ can and/or provide reasonable defaults.") type the given predicate is trying to check. This is different from inferring the return type of a function.") (license license:llgpl)))) + +(define-public sbcl-optima + (let ((commit "373b245b928c1a5cce91a6cb5bfe5dd77eb36195") + (revision "1")) + (package + (name "sbcl-optima") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/m2ym/optima") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1yw4ymq7ms89342kkvb3aqxgv0w38m9kd8ikdqxxzyybnkjhndal")))) + (inputs + `(("alexandria" ,sbcl-alexandria) + ("closer-mop" ,sbcl-closer-mop))) + (native-inputs + `(("eos" ,sbcl-eos))) + (arguments + ;; XXX: Circular dependencies: tests depend on optima.ppcre which depends on optima. + `(#:tests? #f + #:test-asd-file "optima.test.asd")) + (synopsis "Optimized pattern matching library for Common Lisp") + (description "Optima is a fast pattern matching library which uses +optimizing techniques widely used in the functional programming world.") + (license license:expat)))) -- cgit v1.2.3 From 41c42e163cb898dc4701285cc4519a63a06747b2 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:21:38 +0200 Subject: gnu: Add sbcl-fare-quasiquote. * gnu/packages/lisp.scm (sbcl-fare-quasiquote): New variable. --- gnu/packages/lisp.scm | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index d2c6b21a0c..de96c30f15 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6255,3 +6255,40 @@ the return type of a function.") (description "Optima is a fast pattern matching library which uses optimizing techniques widely used in the functional programming world.") (license license:expat)))) + +(define-public sbcl-fare-quasiquote + (package + (name "sbcl-fare-quasiquote") + (build-system asdf-build-system/sbcl) + (version "20171130") + (home-page "http://common-lisp.net/project/fare-quasiquote") + (source + (origin + (method url-fetch) + (uri (string-append "http://beta.quicklisp.org/archive/fare-quasiquote/" + (date->string (string->date version "~Y~m~d") "~Y-~m-~d") + "/fare-quasiquote-" + version + "-git.tgz")) + (sha256 + (base32 + "00brmh7ndsi0c97nibi8cy10j3l4gmkyrfrr5jr5lzkfb7ngyfqa")))) + (inputs + `(("fare-utils" ,sbcl-fare-utils))) + (arguments + ;; XXX: Circular dependencies: Tests depend on subsystems, which depend on the main systems. + `(#:tests? #f + #:phases + (modify-phases %standard-phases + ;; XXX: Require 1.0.0 version of fare-utils, and we package some + ;; commits after 1.0.0.5, but ASDF fails to read the + ;; "-REVISION-COMMIT" part generated by Guix. + (add-after 'unpack 'patch-requirement + (lambda _ + (substitute* "fare-quasiquote.asd" + (("\\(:version \"fare-utils\" \"1.0.0\"\\)") "\"fare-utils\""))))))) + (synopsis "Pattern-matching friendly implementation of quasiquote for Common Lisp") + (description "The main purpose of this n+2nd reimplementation of +quasiquote is enable matching of quasiquoted patterns, using Optima or +Trivia.") + (license license:expat))) -- cgit v1.2.3 From b72314963be50a3a6c9e053497886278fe0d6066 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:21:45 +0200 Subject: gnu: Add sbcl-fare-quasiquote-readtable. * gnu/packages/lisp.scm (sbcl-fare-quasiquote-readtable): New variable. --- gnu/packages/lisp.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index de96c30f15..f6d26ca372 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6292,3 +6292,16 @@ optimizing techniques widely used in the functional programming world.") quasiquote is enable matching of quasiquoted patterns, using Optima or Trivia.") (license license:expat))) + +(define-public sbcl-fare-quasiquote-readtable + (package + (inherit sbcl-fare-quasiquote) + (name "sbcl-fare-quasiquote-readtable") + (inputs + `(("fare-quasiquote" ,sbcl-fare-quasiquote) + ("named-readtables" ,sbcl-named-readtables))) + (description "The main purpose of this n+2nd reimplementation of +quasiquote is enable matching of quasiquoted patterns, using Optima or +Trivia. + +This packages uses fare-quasiquote with named-readtable."))) -- cgit v1.2.3 From 5163929e6808f5776f8b91fed70d64c236291af1 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:23:41 +0200 Subject: gnu: Add sbcl-trivia.level0. * gnu/packages/lisp.scm (sbcl-trivia.level0): New variable. --- gnu/packages/lisp.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index f6d26ca372..c4d467cead 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6305,3 +6305,29 @@ quasiquote is enable matching of quasiquoted patterns, using Optima or Trivia. This packages uses fare-quasiquote with named-readtable."))) + +(define-public sbcl-trivia.level0 + (let ((commit "902e0c65602bbfe96ae82e679330b3771ddc7603") + (revision "1")) + (package + (name "sbcl-trivia.level0") + (build-system asdf-build-system/sbcl) + (version (git-version "0.0.0" revision commit)) + (home-page "https://github.com/guicho271828/trivia") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "11qbab30qqnfy9mx3x9fvgcw1jbvh1qn2cqv3p8xdn2m8981jvhr")))) + (inputs + `(("alexandria" ,sbcl-alexandria))) + (synopsis "Pattern matching in Common Lisp") + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima.") + (license license:llgpl)))) -- cgit v1.2.3 From e4e84e3db64f53541c3a973b3656b899b2a5bc6a Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:23:48 +0200 Subject: gnu: Add sbcl-trivia.level1. * gnu/packages/lisp.scm (sbcl-trivia.level1): New variable. --- gnu/packages/lisp.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index c4d467cead..e41ab60f4a 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6331,3 +6331,15 @@ This packages uses fare-quasiquote with named-readtable."))) with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima.") (license license:llgpl)))) + +(define-public sbcl-trivia.level1 + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.level1") + (inputs + `(("trivia.level0" ,sbcl-trivia.level0))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the core patterns of Trivia."))) -- cgit v1.2.3 From 49df8a0ae8f3256cacb63f071dad72ed278d0622 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:23:58 +0200 Subject: gnu: Add sbcl-trivia.level2. * gnu/packages/lisp.scm (sbcl-trivia.level2): New variable. --- gnu/packages/lisp.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index e41ab60f4a..ba9c637be1 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6343,3 +6343,19 @@ with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima. This system contains the core patterns of Trivia."))) + +(define-public sbcl-trivia.level2 + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.level2") + (inputs + `(("trivia.level1" ,sbcl-trivia.level1) + ("lisp-namespace" ,sbcl-lisp-namespace) + ("trivial-cltl2" ,sbcl-trivial-cltl2) + ("closer-mop" ,sbcl-closer-mop))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains a non-optimized pattern matcher compatible with Optima, +with extensible optimizer interface."))) -- cgit v1.2.3 From 02a8324b12d1f52d94ace2ed31bd541222ed3c5c Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:24:18 +0200 Subject: gnu: Add sbcl-trivia.trivial. * gnu/packages/lisp.scm (sbcl-trivia.trivial): New variable. --- gnu/packages/lisp.scm | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index ba9c637be1..daf5008293 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6359,3 +6359,41 @@ be faster and more extensible than Optima. This system contains a non-optimized pattern matcher compatible with Optima, with extensible optimizer interface."))) + +(define-public sbcl-trivia.trivial + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.trivial") + (inputs + `(("trivia.level2" ,sbcl-trivia.level2))) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'create-asd-file + (lambda* (#:key outputs inputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (lib (string-append out "/lib/sbcl")) + (level2 (assoc-ref inputs "trivia.level2"))) + (mkdir-p lib) + (install-file "trivia.trivial.asd" lib) + ;; XXX: This .asd does not have any component and the build + ;; system fails to work in this case. We should update the + ;; build system to handle component-less .asd. + ;; TODO: How do we append to file in Guile? It seems that + ;; (open-file ... "a") gets a "Permission denied". + (substitute* (string-append lib "/trivia.trivial.asd") + (("\"\\)") + (string-append "\") + +(progn (asdf/source-registry:ensure-source-registry) + (setf (gethash + \"trivia.level2\" + asdf/source-registry:*source-registry*) + #p\"" + level2 + "/share/common-lisp/sbcl-bundle-systems/trivia.level2.asd\"))"))))))))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the base level system of Trivia with a trivial optimizer."))) -- cgit v1.2.3 From 9d450c6d422f885cb875fd816820e32069c58d38 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:24:30 +0200 Subject: gnu: Add sbcl-trivia.balland2006. * gnu/packages/lisp.scm (sbcl-trivia.balland2006): New variable. --- gnu/packages/lisp.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index daf5008293..28b7ae5e11 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6397,3 +6397,21 @@ with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima. This system contains the base level system of Trivia with a trivial optimizer."))) + +(define-public sbcl-trivia.balland2006 + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.balland2006") + (inputs + `(("trivia.trivial" ,sbcl-trivia.trivial) + ("iterate" ,sbcl-iterate) + ("type-i" ,sbcl-type-i) + ("alexandria" ,sbcl-alexandria))) + (arguments + ;; Tests are done in trivia itself. + `(#:tests? #f)) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the base level system of Trivia with a trivial optimizer."))) -- cgit v1.2.3 From 3706c0a43274cef9170b42f0ac09eff96f1829a5 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:24:44 +0200 Subject: gnu: Add sbcl-trivia.ppcre. * gnu/packages/lisp.scm (sbcl-trivia.ppcre): New variable. --- gnu/packages/lisp.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 28b7ae5e11..daa96403ba 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6415,3 +6415,16 @@ with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima. This system contains the base level system of Trivia with a trivial optimizer."))) + +(define-public sbcl-trivia.ppcre + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.ppcre") + (inputs + `(("trivia.trivial" ,sbcl-trivia.trivial) + ("cl-ppcre" ,sbcl-cl-ppcre))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the PPCRE extention."))) -- cgit v1.2.3 From 9b5e5eafc6e7d7766dee56186dd9487bc9825c9e Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:24:55 +0200 Subject: gnu: Add sbcl-trivia.quasiquote. * gnu/packages/lisp.scm (sbcl-trivia.quasiquote): New variable. --- gnu/packages/lisp.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index daa96403ba..306602ffe7 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6428,3 +6428,17 @@ with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima. This system contains the PPCRE extention."))) + +(define-public sbcl-trivia.quasiquote + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.quasiquote") + (inputs + `(("trivia.trivial" ,sbcl-trivia.trivial) + ("fare-quasiquote" ,sbcl-fare-quasiquote) + ("fare-quasiquote-readtable" ,sbcl-fare-quasiquote-readtable))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the fare-quasiquote extension."))) -- cgit v1.2.3 From 9d4e42261ebefe1fec3a3bca27962e54ed2bfa26 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:25:05 +0200 Subject: gnu: Add sbcl-trivia.cffi. * gnu/packages/lisp.scm (sbcl-trivia.cffi): New variable. --- gnu/packages/lisp.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 306602ffe7..08af5808e7 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6442,3 +6442,16 @@ with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima. This system contains the fare-quasiquote extension."))) + +(define-public sbcl-trivia.cffi + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.cffi") + (inputs + `(("cffi" ,sbcl-cffi) + ("trivia.trivial" ,sbcl-trivia.trivial))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the CFFI foreign slot access extension."))) -- cgit v1.2.3 From 87850c05a208f7b4213f632f3f79b59e76880724 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 4 Jul 2019 19:25:12 +0200 Subject: gnu: Add sbcl-trivia. * gnu/packages/lisp.scm (sbcl-trivia): New variable. --- gnu/packages/lisp.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 08af5808e7..2f8a06035a 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6455,3 +6455,21 @@ with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima. This system contains the CFFI foreign slot access extension."))) + +(define-public sbcl-trivia + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia") + (inputs + `(("trivia.balland2006" ,sbcl-trivia.balland2006))) + (native-inputs + `(("fiveam" ,sbcl-fiveam) + ("trivia.ppcre" ,sbcl-trivia.ppcre) + ("trivia.quasiquote" ,sbcl-trivia.quasiquote) + ("trivia.cffi" ,sbcl-trivia.cffi) + ("optima" ,sbcl-optima))) + (arguments + `(#:test-asd-file "trivia.test.asd")) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima."))) -- cgit v1.2.3 From b1510fd8d252c1ab0d32a32f064513105b99cf39 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 4 Jul 2019 23:09:11 +0200 Subject: derivations: 'derivation-build-plan' recurses on substituables. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes a bug whereby "guix build texlive -n" would report: 0.0 MB would be downloaded: /gnu/store/…-texlive-20180414 instead of: The following derivation would be built: /gnu/store/…-texlive-texmf-20180414.drv 2,595.2 MB would be downloaded: /gnu/store/…-texlive-20180414-texmf.tar.xz /gnu/store/…-texlive-20180414 where 'texlive-texmf' is a non-substitutable dependency of 'texlive'. * guix/derivations.scm (dependencies-of-substitutables): New procedure. (derivation-build-plan): When 'input-substitutable-info' returns true, append the subset of DEPS that corresponds to SUBSTITUABLES to the first argument of 'loop'. * guix/ui.scm (show-what-to-build): Remove half-baked traversal of DOWNLOAD. * tests/derivations.scm ("derivation-build-plan and substitutes, non-substitutable dep"): New test. --- guix/derivations.scm | 29 +++++++++++++++++++++-------- guix/ui.scm | 12 ------------ tests/derivations.scm | 29 +++++++++++++++++++++++++++++ 3 files changed, 50 insertions(+), 20 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index 186d7a3f8f..caa76bd16c 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -352,6 +352,16 @@ substituter many times." (#f #f) ((key . value) value))))) +(define (dependencies-of-substitutables substitutables inputs) + "Return the subset of INPUTS whose output file names is among the references +of SUBSTITUTABLES." + (let ((items (fold set-insert (set) + (append-map substitutable-references substitutables)))) + (filter (lambda (input) + (any (cut set-contains? items <>) + (derivation-input-output-paths input))) + inputs))) + (define* (derivation-build-plan store inputs #:key (mode (build-mode normal)) @@ -391,7 +401,9 @@ by 'substitution-oracle'." (() (values build substitute)) ((input rest ...) - (let ((key (derivation-input-key input))) + (let ((key (derivation-input-key input)) + (deps (derivation-inputs + (derivation-input-derivation input)))) (cond ((set-contains? visited key) (loop rest build substitute visited)) ((input-built? input) @@ -400,16 +412,17 @@ by 'substitution-oracle'." ((input-substitutable-info input) => (lambda (substitutables) - (loop rest build + (loop (append (dependencies-of-substitutables substitutables + deps) + rest) + build (append substitutables substitute) (set-insert key visited)))) (else - (let ((deps (derivation-inputs - (derivation-input-derivation input)))) - (loop (append deps rest) - (cons (derivation-input-derivation input) build) - substitute - (set-insert key visited)))))))))) + (loop (append deps rest) + (cons (derivation-input-derivation input) build) + substitute + (set-insert key visited))))))))) (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest) derivation-build-plan diff --git a/guix/ui.scm b/guix/ui.scm index 6d243ef041..2ce82ff658 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -844,18 +844,6 @@ check and report what is prerequisites are available for download." #:mode mode #:substitutable-info substitutable-info)) - ((download) ; add the references of DOWNLOAD - (if use-substitutes? - (delete-duplicates - (append download - (filter-map (lambda (item) - (if (valid-path? store item) - #f - (substitutable-info item))) - (append-map - substitutable-references - download)))) - download)) ((graft hook build) (match (fold (lambda (drv acc) (let ((file (derivation-file-name drv))) diff --git a/tests/derivations.scm b/tests/derivations.scm index d173a78906..7be7726163 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -896,6 +896,35 @@ (((= derivation-file-name build)) (string=? build (derivation-file-name drv))))))))) +(test-assert "derivation-build-plan and substitutes, non-substitutable dep" + (with-store store + (let* ((drv1 (build-expression->derivation store "prereq-no-subst" + (random 1000) + #:substitutable? #f)) + (drv2 (build-expression->derivation store "substitutable" + (random 1000) + #:inputs `(("dep" ,drv1))))) + + ;; Make sure substitutes are usable. + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) + + (with-derivation-narinfo drv2 + (sha256 => (make-bytevector 32 0)) + (references => (list (derivation->output-path drv1))) + + (let-values (((build download) + (derivation-build-plan store + (list (derivation-input drv2))))) + ;; Although DRV2 is available as a substitute, we must build its + ;; dependency, DRV1, due to #:substitutable? #f. + (and (match download + (((= substitutable-path item)) + (string=? item (derivation->output-path drv2)))) + (match build + (((= derivation-file-name build)) + (string=? build (derivation-file-name drv1)))))))))) + (test-assert "derivation-build-plan and substitutes, local build" (with-store store (let* ((drv (build-expression->derivation store "prereq-subst-local" -- cgit v1.2.3 From d74392a85cfd0992d034b903ca21180a6d73eaed Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Jul 2019 00:09:27 +0200 Subject: derivations: Simplify 'substitution-oracle'. * guix/derivations.scm (substitution-oracle)[valid?, dependencies]: Remove. [closure]: New procedure. Rename parameter from 'drv' to 'inputs-or-drv' and adjust accordingly. (derivation-build-plan): Pass INPUTS directly to 'substitution-oracle'. * guix/ui.scm (show-what-to-build)[substitutable-info]: Likewise. --- guix/derivations.scm | 86 ++++++++++++++++++++++++---------------------------- guix/ui.scm | 3 +- 2 files changed, 41 insertions(+), 48 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index caa76bd16c..731f1f698f 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -293,60 +293,57 @@ result is the set of prerequisites of DRV not already in valid." (derivation-output-path (assoc-ref outputs sub-drv))) sub-drvs)))) -(define* (substitution-oracle store drv +(define* (substitution-oracle store inputs-or-drv #:key (mode (build-mode normal))) "Return a one-argument procedure that, when passed a store file name, returns a 'substitutable?' if it's substitutable and #f otherwise. -The returned procedure -knows about all substitutes for all the derivations listed in DRV, *except* -those that are already valid (that is, it won't bother checking whether an -item is substitutable if it's already on disk); it also knows about their -prerequisites, unless they are themselves substitutable. + +The returned procedure knows about all substitutes for all the derivation +inputs or derivations listed in INPUTS-OR-DRV, *except* those that are already +valid (that is, it won't bother checking whether an item is substitutable if +it's already on disk); it also knows about their prerequisites, unless they +are themselves substitutable. Creating a single oracle (thus making a single 'substitutable-path-info' call) and reusing it is much more efficient than calling 'has-substitutes?' or similar repeatedly, because it avoids the costs associated with launching the substituter many times." - (define valid? - (cut valid-path? store <>)) - (define valid-input? (cut valid-derivation-input? store <>)) - (define (dependencies drv) - ;; Skip prerequisite sub-trees of DRV whose root is valid. This allows us - ;; to ask the substituter for just as much as needed, instead of asking it - ;; for the whole world, which can be significantly faster when substitute - ;; info is not already in cache. - ;; Also, skip derivations marked as non-substitutable. - (append-map (lambda (input) + (define (closure inputs) + (let loop ((inputs inputs) + (closure '()) + (visited (set))) + (match inputs + (() + (reverse closure)) + ((input rest ...) + (let ((key (derivation-input-key input))) + (cond ((set-contains? visited key) + (loop rest closure visited)) + ((valid-input? input) + (loop rest closure (set-insert key visited))) + (else (let ((drv (derivation-input-derivation input))) - (if (substitutable-derivation? drv) - (derivation-input-output-paths input) - '()))) - (derivation-prerequisites drv valid-input?))) - - (let* ((paths (delete-duplicates - (concatenate - (fold (lambda (drv result) - (let ((self (match (derivation->output-paths drv) - (((names . paths) ...) - paths)))) - (cond ((eqv? mode (build-mode check)) - (cons (dependencies drv) result)) - ((not (substitutable-derivation? drv)) - (cons (dependencies drv) result)) - ((every valid? self) - result) - (else - (cons* self (dependencies drv) result))))) - '() - drv)))) - (subst (fold (lambda (subst vhash) - (vhash-cons (substitutable-path subst) subst - vhash)) - vlist-null - (substitutable-path-info store paths)))) + (loop (append (derivation-inputs drv) rest) + (if (substitutable-derivation? drv) + (cons input closure) + closure) + (set-insert key visited)))))))))) + + (let* ((inputs (closure (map (match-lambda + ((? derivation-input? input) + input) + ((? derivation? drv) + (derivation-input drv))) + inputs-or-drv))) + (items (append-map derivation-input-output-paths inputs)) + (subst (fold (lambda (subst vhash) + (vhash-cons (substitutable-path subst) subst + vhash)) + vlist-null + (substitutable-path-info store items)))) (lambda (item) (match (vhash-assoc item subst) (#f #f) @@ -367,10 +364,7 @@ of SUBSTITUTABLES." (mode (build-mode normal)) (substitutable-info (substitution-oracle - store - (map derivation-input-derivation - inputs) - #:mode mode))) + store inputs #:mode mode))) "Given INPUTS, a list of derivation-inputs, return two values: the list of derivation to build, and the list of substitutable items that, together, allows INPUTS to be realized. diff --git a/guix/ui.scm b/guix/ui.scm index 2ce82ff658..7d6ab9a2a7 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -835,8 +835,7 @@ check and report what is prerequisites are available for download." ;; substituter many times. This makes a big difference, especially when ;; DRV is a long list as is the case with 'guix environment'. (if use-substitutes? - (substitution-oracle store (map derivation-input-derivation inputs) - #:mode mode) + (substitution-oracle store inputs #:mode mode) (const #f))) (let*-values (((build download) -- cgit v1.2.3 From 728a4ab1019fda2f14a5c69d3f1b277fb5e09cda Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Jul 2019 00:48:20 +0200 Subject: store: 'run-with-store' gracefully deals with #f store. This is a followup to dd0ee954c4fa965023fd887452927c02edb8b52f, which introduced a failure in tests/graph.scm. * guix/store.scm (run-with-store): Check whether STORE and NEW-STORE are true before calling 'store-connection-object-cache' etc. Fixes a failure in tests/graph.scm related to %REVERSE-PACKAGE-NODE-TYPE, which uses #f as the store. --- guix/store.scm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index 52940ff751..d7c603898c 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1802,11 +1802,12 @@ connection, and return the result." (call-with-values (lambda () (run-with-state mval store)) (lambda (result new-store) - ;; Copy the object cache from NEW-STORE so we don't fully discard the - ;; state. - (let ((cache (store-connection-object-cache new-store))) - (set-store-connection-object-cache! store cache) - result))))) + (when (and store new-store) + ;; Copy the object cache from NEW-STORE so we don't fully discard + ;; the state. + (let ((cache (store-connection-object-cache new-store))) + (set-store-connection-object-cache! store cache))) + result)))) ;;; -- cgit v1.2.3 From 4add773e8c7ae7e7730a8cdef7d69d441a9888fb Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 5 Jul 2019 07:52:44 +0100 Subject: gnu: patchwork: Update to 2.1.4. * gnu/packages/patchutils.scm (patchwork): Update to 2.1.4. --- gnu/packages/patchutils.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm index 687864c008..a63d889cff 100644 --- a/gnu/packages/patchutils.scm +++ b/gnu/packages/patchutils.scm @@ -307,7 +307,7 @@ you to figure out what is going on in that merge you keep avoiding.") (define-public patchwork (package (name "patchwork") - (version "2.1.2") + (version "2.1.4") (source (origin (method git-fetch) (uri (git-reference @@ -316,7 +316,7 @@ you to figure out what is going on in that merge you keep avoiding.") (file-name (git-file-name name version)) (sha256 (base32 - "06ng5pv6744w98zkyfm0ldkmpdgnsql3gbbbh6awq61sr2ndr3qw")))) + "0zi1hcqb0pi2diyznbv0c1631qk4rx02zl8ghyrr59g3ljlyr18y")))) (build-system python-build-system) (arguments `(;; TODO: Tests require a running database -- cgit v1.2.3 From e48f80cba03a0a428bbffb7388a49fd765a92318 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Fri, 28 Jun 2019 13:15:03 +0530 Subject: gnu: Add qlogo. * gnu/packages/logo.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Register it. * gnu/packages/logo.scm (qlogo): New variable. --- gnu/local.mk | 1 + gnu/packages/logo.scm | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+) create mode 100644 gnu/packages/logo.scm diff --git a/gnu/local.mk b/gnu/local.mk index 6e90d88689..8d7760cf46 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -299,6 +299,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/llvm.scm \ %D%/packages/lout.scm \ %D%/packages/logging.scm \ + %D%/packages/logo.scm \ %D%/packages/lolcode.scm \ %D%/packages/lsof.scm \ %D%/packages/lua.scm \ diff --git a/gnu/packages/logo.scm b/gnu/packages/logo.scm new file mode 100644 index 0000000000..17c3990a94 --- /dev/null +++ b/gnu/packages/logo.scm @@ -0,0 +1,71 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Arun Isaac +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu packages logo) + #:use-module (gnu packages qt) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix download) + #:use-module (guix packages) + #:use-module (guix build-system gnu)) + +(define-public qlogo + (package + (name "qlogo") + (version "0.92") + (source + (origin + (method url-fetch) + (uri (string-append "https://qlogo.org/assets/sources/QLogo-" + version ".tgz")) + (sha256 + (base32 + "0cpyj1ji6hjy7zzz05672f0j6fr0mwpc1y3sq36hhkv2fkpidw22")))) + (build-system gnu-build-system) + (inputs + `(("qtbase" ,qtbase))) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (substitute* "QLogo.pro" + (("target\\.path = /usr/bin") + (string-append "target.path = " + (assoc-ref outputs "out") "/bin"))) + (invoke "qmake" "QLogo.pro"))) + ;; The check phase rebuilds the source for tests. So, it needs to be + ;; run after the install phase has installed the outputs of the build + ;; phase. + (delete 'check) + (add-after 'install 'check + (lambda _ + ;; Clean files created by the build phase. + (invoke "make" "clean") + ;; QLogo tries to create its "dribble file" in the home + ;; directory. So, set HOME. + (setenv "HOME" "/tmp") + ;; Build and run tests. + (invoke "qmake" "TestQLogo.pro") + (invoke "make" "-j" (number->string (parallel-job-count))) + (invoke "./testqlogo")))))) + (home-page "https://qlogo.org") + (synopsis "Logo interpreter using Qt and OpenGL") + (description "QLogo is an interpreter for the Logo language written in C++ +using Qt and OpenGL. Specifically, it mimics, as reasonably as possible, the +UCBLogo interpreter.") + (license license:gpl2+))) -- cgit v1.2.3 From 1d8d87ddf77f50cc01f852facdadfe1e087bb7ac Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:21:51 +0200 Subject: gnu: sbcl-iolib: Add CFFI to list of inputs and fix spacing. * gnu/packages/lisp.scm (sbcl-iolib)[inputs]: Do it. --- gnu/packages/lisp.scm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 2f8a06035a..5ff4524c07 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -5863,11 +5863,12 @@ and @code{kqueue(2)}), a pathname library and file-system utilities.") `(("iolib.asdf" ,sbcl-iolib.asdf) ("iolib.conf" ,sbcl-iolib.conf) ("iolib.grovel" ,sbcl-iolib.grovel) - ("iolib.base", sbcl-iolib.base) - ("bordeaux-threads", sbcl-bordeaux-threads) - ("idna", sbcl-idna) - ("swap-bytes", sbcl-swap-bytes) - ("libfixposix", libfixposix))) + ("iolib.base" ,sbcl-iolib.base) + ("bordeaux-threads" ,sbcl-bordeaux-threads) + ("idna" ,sbcl-idna) + ("swap-bytes" ,sbcl-swap-bytes) + ("libfixposix" ,libfixposix) + ("cffi" ,sbcl-cffi))) (native-inputs `(("fiveam" ,sbcl-fiveam))) (arguments -- cgit v1.2.3 From c51db1dd3685c1a4ab315e9585f729915fd7747c Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:22:31 +0200 Subject: gnu: sbcl-closure-common: Use official home-page. * gnu/packages/lisp.scm (sbcl-closure-common)[home-page]: Do it. --- gnu/packages/lisp.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 5ff4524c07..edf868c277 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -5954,12 +5954,12 @@ floating point values to IEEE 754 binary representation.") (name "sbcl-closure-common") (build-system asdf-build-system/sbcl) (version (git-version "20101006" revision commit)) - (home-page "https://github.com/sharplispers/closure-common") + (home-page "https://common-lisp.net/project/cxml/") (source (origin (method git-fetch) (uri (git-reference - (url home-page) + (url "https://github.com/sharplispers/closure-common") (commit commit))) (file-name (git-file-name name version)) (sha256 -- cgit v1.2.3 From 075e3220c6281f831f8b2b05c273b8ac5f0a3321 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:29:13 +0200 Subject: gnu: Add sbcl-cxml+xml. * gnu/packages/lisp.scm (sbcl-cxml+xml): New variable. --- gnu/packages/lisp.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index edf868c277..82c87994dc 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -5974,6 +5974,37 @@ Closure is a reference to the web browser it was originally written for.") ;; TODO: License? (license #f)))) +(define-public sbcl-cxml+xml + (let ((commit "00b22bf4c4cf11c993d5866fae284f95ab18e6bf") + (revision "1")) + (package + (name "sbcl-cxml+xml") + (build-system asdf-build-system/sbcl) + (version (git-version "0.0.0" revision commit)) + (home-page "https://common-lisp.net/project/cxml/") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/sharplispers/cxml") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "13kif7rf3gqdycsk9zq0d7y0g9y81krkl0z87k0p2fkbjfgrph37")))) + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("trivial-gray-streams" ,sbcl-trivial-gray-streams))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/xml")) + (synopsis "Common Lisp XML parser") + (description "CXML implements a namespace-aware, validating XML 1.0 +parser as well as the DOM Level 2 Core interfaces. Two parser interfaces are +offered, one SAX-like, the other similar to StAX.") + (license license:llgpl)))) + (define-public sbcl-cl-reexport (let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b") (revision "1")) -- cgit v1.2.3 From 53270eb96604cbb331aa59e83db758b2cb88c329 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:29:22 +0200 Subject: gnu: Add sbcl-cxml+dom. * gnu/packages/lisp.scm (sbcl-cxml+dom): New variable. --- gnu/packages/lisp.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 82c87994dc..3c0d0409c1 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6005,6 +6005,18 @@ parser as well as the DOM Level 2 Core interfaces. Two parser interfaces are offered, one SAX-like, the other similar to StAX.") (license license:llgpl)))) +(define sbcl-cxml+dom + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml+dom") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("cxml+xml" ,sbcl-cxml+xml))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/dom")))) + (define-public sbcl-cl-reexport (let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b") (revision "1")) -- cgit v1.2.3 From d22b47aad6266f6881b43d6d9d5e655bcac1640e Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:29:39 +0200 Subject: gnu: Add sbcl-cxml+klacks. * gnu/packages/lisp.scm (sbcl-cxml+klacks): New variable. --- gnu/packages/lisp.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 3c0d0409c1..d1d8c75db8 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6017,6 +6017,18 @@ offered, one SAX-like, the other similar to StAX.") `(#:asd-file "cxml.asd" #:asd-system-name "cxml/dom")))) +(define sbcl-cxml+klacks + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml+klacks") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("cxml+xml" ,sbcl-cxml+xml))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/klacks")))) + (define-public sbcl-cl-reexport (let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b") (revision "1")) -- cgit v1.2.3 From 9a08c0a577682c5f074674bc404de762677cf561 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:29:55 +0200 Subject: gnu: Add sbcl-cxml+test. * gnu/packages/lisp.scm (sbcl-cxml+test): New variable. --- gnu/packages/lisp.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index d1d8c75db8..d4f833b951 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6029,6 +6029,18 @@ offered, one SAX-like, the other similar to StAX.") `(#:asd-file "cxml.asd" #:asd-system-name "cxml/klacks")))) +(define sbcl-cxml+test + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml+test") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("cxml+xml" ,sbcl-cxml+xml))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/test")))) + (define-public sbcl-cl-reexport (let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b") (revision "1")) -- cgit v1.2.3 From 4f54138731c035b2fdc026206f7ed288fc14ffc4 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:30:21 +0200 Subject: gnu: Add sbcl-cxml. * gnu/packages/lisp.scm (sbcl-cxml): New variable. --- gnu/packages/lisp.scm | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index d4f833b951..e6ddd2cb68 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6041,6 +6041,44 @@ offered, one SAX-like, the other similar to StAX.") `(#:asd-file "cxml.asd" #:asd-system-name "cxml/test")))) +(define-public sbcl-cxml + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("trivial-gray-streams" ,sbcl-trivial-gray-streams) + ("cxml+dom" ,sbcl-cxml+dom) + ("cxml+klacks" ,sbcl-cxml+klacks) + ("cxml+test" ,sbcl-cxml+test))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml" + #:phases + (modify-phases %standard-phases + (add-after 'build 'install-dtd + (lambda* (#:key outputs #:allow-other-keys) + (install-file "catalog.dtd" + (string-append + (assoc-ref outputs "out") + "/lib/" (%lisp-type))))) + (add-after 'create-asd 'remove-component + ;; XXX: The original .asd has no components, but our build system + ;; creates an entry nonetheless. We need to remove it for the + ;; generated .asd to load properly. See trivia.trivial for a + ;; similar problem. + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (asd (string-append out "/lib/sbcl/cxml.asd"))) + (substitute* asd + ((" :components +") + "")) + (substitute* asd + ((" *\\(\\(:compiled-file \"cxml--system\"\\)\\)") + "")))))))))) + (define-public sbcl-cl-reexport (let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b") (revision "1")) -- cgit v1.2.3 From 57f815cb6b74dca7e69d44af0f2df819af889359 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:30:41 +0200 Subject: gnu: sbcl-trivia.trivial: Resolve Lisp type dynamically. * gnu/packages/lisp.scm (sbcl-trivia.trivial)[arguments]: Use %lisp-type instead of hard-coding "sbcl". --- gnu/packages/lisp.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index e6ddd2cb68..3aa2429595 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6478,7 +6478,7 @@ with extensible optimizer interface."))) (replace 'create-asd-file (lambda* (#:key outputs inputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) - (lib (string-append out "/lib/sbcl")) + (lib (string-append out "/lib/" (%lisp-type))) (level2 (assoc-ref inputs "trivia.level2"))) (mkdir-p lib) (install-file "trivia.trivial.asd" lib) -- cgit v1.2.3 From ec982546941b59fdd14e0b08f023baf2e75d71a3 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:33:35 +0200 Subject: gnu: Add sbcl-cl-xmlspam. * gnu/packages/lisp.scm (sbcl-cl-xmlspam): New variable. --- gnu/packages/lisp.scm | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 3aa2429595..64e5a16939 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6579,3 +6579,32 @@ This system contains the CFFI foreign slot access extension."))) (description "Trivia is a pattern matching compiler that is compatible with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima."))) + +(define-public sbcl-cl-xmlspam + (package + (name "sbcl-cl-xmlspam") + (build-system asdf-build-system/sbcl) + (version "0.0.0") + (home-page "https://common-lisp.net/project/cl-xmlspam/") + (source + (origin + (method url-fetch) + (uri "http://common-lisp.net/project/cl-xmlspam/cl-xmlspam.tgz") + (file-name (string-append name "-" version)) + (sha256 + (base32 + "0r0pjh1yjcj2izxlbd3f3bwfwxllhag56wz8ijdl6442pf3gdazh")))) + (inputs + `(("cxml" ,sbcl-cxml) + ("cl-ppcre" ,sbcl-cl-ppcre))) + (synopsis "Concise, regexp-like pattern matching on streaming XML for Common Lisp") + (description "CXML does an excellent job at parsing XML elements, but what +do you do when you have a XML file that's larger than you want to fit in +memory, and you want to extract some information from it? Writing code to deal +with SAX events, or even using Klacks, quickly becomes tedious. +@code{cl-xmlspam} (for XML Stream PAttern Matcher) is designed to make it easy +to write code that mirrors the structure of the XML that it's parsing. It +also makes it easy to shift paradigms when necessary - the usual Lisp control +constructs can be used interchangeably with pattern matching, and the full +power of CXML is available when necessary.") + (license #f))) -- cgit v1.2.3 From 7af213fefe3608a80c9f0a7e91f0c79051aff16f Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 5 Jul 2019 12:33:50 +0200 Subject: gnu: Add sbcl-dbus. * gnu/packages/lisp.scm (sbcl-dbus): New variable. --- gnu/packages/lisp.scm | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 64e5a16939..c05ec715cb 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6608,3 +6608,39 @@ also makes it easy to shift paradigms when necessary - the usual Lisp control constructs can be used interchangeably with pattern matching, and the full power of CXML is available when necessary.") (license #f))) + +(define-public sbcl-dbus + (let ((commit "24b452df3a45ca5dc95015500f34baad175c981a") + (revision "1")) + (package + (name "sbcl-dbus") + (build-system asdf-build-system/sbcl) + (version (git-version "20190408" revision commit)) + (home-page "https://github.com/death/dbus") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "0fw2q866yddbf23nk9pxphm9gsasx35vjyss82xzvndnjmzlqfl5")))) + (inputs + `(("alexandria" ,sbcl-alexandria) + ("trivial-garbage" ,sbcl-trivial-garbage) + ("babel" ,sbcl-babel) + ("iolib" ,sbcl-iolib) + ("iolib+multiplex" ,sbcl-iolib+multiplex) + ("iolib+syscalls" ,sbcl-iolib+syscalls) + ("iolib+streams" ,sbcl-iolib+streams) + ("iolib+sockets" ,sbcl-iolib+sockets) + ("ieee-floats" ,sbcl-ieee-floats) + ("flexi-streams" ,sbcl-flexi-streams) + ("cl-xmlspam" ,sbcl-cl-xmlspam) + ("ironclad" ,sbcl-ironclad))) + (synopsis "D-Bus client library for Common Lisp") + (description "This is a Common Lisp library that allows to publish D-Bus +objects as well as send and notify other objects connected to a bus.") + (license license:bsd-2)))) -- cgit v1.2.3 From b35af249388edd3c089090ce58e74fd04dbb6919 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 5 Jul 2019 15:07:58 +0200 Subject: gnu: nanopolish: Update to 0.11.1-1.6331dc4. * gnu/packages/bioinformatics.scm (nanopolish): Update to 0.11.1-1.6331dc4. --- gnu/packages/bioinformatics.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 9a30a0eaff..f8ac41c249 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -14069,11 +14069,11 @@ choosing which reads pass the filter.") ;; . ;; Also, the differences between release and current version seem to be ;; significant. - (let ((commit "50e8b5cc62f9b46f5445f5c5e8c5ab7263ea6d9d") + (let ((commit "6331dc4f15b9dfabb954ba3fae9d76b6c3ca6377") (revision "1")) (package (name "nanopolish") - (version (git-version "0.10.2" revision commit)) + (version (git-version "0.11.1" revision commit)) (source (origin (method git-fetch) @@ -14083,7 +14083,7 @@ choosing which reads pass the filter.") (recursive? #t))) (file-name (git-file-name name version)) (sha256 - (base32 "09j5gz57yr9i34a27vbl72i4g8syv2zzgmsfyjq02yshmnrvkjs6")) + (base32 "15ikl3d37y49pwd7vx36xksgsqajhf24q7qqsnpl15dqqyy5qgbc")) (modules '((guix build utils))) (snippet '(begin -- cgit v1.2.3 From eafd039005815fee5f7ddcbb527c6a95cf2afe5a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Jul 2019 14:26:03 +0200 Subject: gnu: hugin: Build against Exiv2 0.26. * gnu/packages/image.scm (exiv2-0.26): New variable. * gnu/packages/photo.scm (hugin)[inputs]: Use it instead of EXIV2. --- gnu/packages/image.scm | 30 +++++++++++++++++++++++++++++- gnu/packages/photo.scm | 4 ++-- 2 files changed, 31 insertions(+), 3 deletions(-) diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index ef477fa6f1..fabc2fb2d1 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2017 Ludovic Courtès +;;; Copyright © 2013, 2017, 2019 Ludovic Courtès ;;; Copyright © 2013, 2015, 2016 Andreas Enge ;;; Copyright © 2014, 2015, 2016 Mark H Weaver ;;; Copyright © 2014, 2015 Alex Kost @@ -1066,6 +1066,34 @@ and XMP metadata of images in various formats.") ;; . (license license:gpl2+))) +(define-public exiv2-0.26 + (package + (inherit exiv2) + (version "0.26") + (source (origin + (method url-fetch) + (uri (list (string-append "https://www.exiv2.org/builds/exiv2-" + version "-trunk.tar.gz") + (string-append "https://www.exiv2.org/exiv2-" + version ".tar.gz") + (string-append "https://fossies.org/linux/misc/exiv2-" + version ".tar.gz"))) + (patches (search-patches "exiv2-CVE-2017-14860.patch" + "exiv2-CVE-2017-14859-14862-14864.patch")) + (sha256 + (base32 + "1yza317qxd8yshvqnay164imm0ks7cvij8y8j86p1gqi1153qpn7")))) + (build-system gnu-build-system) + (arguments '(#:tests? #f)) ; no `check' target + (propagated-inputs + `(("expat" ,expat) + ("zlib" ,zlib))) + (native-inputs + `(("intltool" ,intltool))) + + ;; People should rely on the newer version, so don't expose it. + (properties `((hidden? . #t))))) + (define-public devil (package (name "devil") diff --git a/gnu/packages/photo.scm b/gnu/packages/photo.scm index b2e3edca18..b8ac1ea1d6 100644 --- a/gnu/packages/photo.scm +++ b/gnu/packages/photo.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2017, 2019 Ludovic Courtès ;;; Copyright © 2015 Ricardo Wurmus ;;; Copyright © 2015, 2017 Andreas Enge ;;; Copyright © 2016, 2017, 2018 Efraim Flashner @@ -445,7 +445,7 @@ and enhance them.") (inputs `(("boost" ,boost) ("enblend-enfuse" ,enblend-enfuse) - ("exiv2" ,exiv2) + ("exiv2" ,exiv2-0.26) ("fftw" ,fftw) ("flann" ,flann) ("freeglut" ,freeglut) -- cgit v1.2.3 From 1aa026aa397e12305cad0ed4fd50c2257e760c4a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Jul 2019 14:48:18 +0200 Subject: gnu: emacsy: Remove big 'texlive' dependency. * gnu/packages/guile-xyz.scm (emacsy)[inputs]: Replace TEXLIVE by a 'texlive-union' call. --- gnu/packages/guile-xyz.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index f652a94d2e..d479fb6ea9 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -2348,7 +2348,7 @@ more expressive and flexible than the traditional @code{format} procedure.") ("perl" ,perl) ("pkg-config" ,pkg-config) ("texinfo" ,texinfo) - ("texlive" ,texlive))) + ("texlive" ,(texlive-union (list texlive-generic-epsf))))) (propagated-inputs `(("dbus-glib" ,dbus-glib) ("guile" ,guile-2.2) -- cgit v1.2.3 From 6b4a4318434522372a5f2c7476fbc1bacbcee278 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Jul 2019 22:29:12 +0200 Subject: Revert "gnu: Add sbcl-dbus." Remove sbcl-dbus because it depends on sbcl-cl-xmlspam, which is currently non-free. This reverts commit 7af213fefe3608a80c9f0a7e91f0c79051aff16f. --- gnu/packages/lisp.scm | 36 ------------------------------------ 1 file changed, 36 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index c05ec715cb..64e5a16939 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6608,39 +6608,3 @@ also makes it easy to shift paradigms when necessary - the usual Lisp control constructs can be used interchangeably with pattern matching, and the full power of CXML is available when necessary.") (license #f))) - -(define-public sbcl-dbus - (let ((commit "24b452df3a45ca5dc95015500f34baad175c981a") - (revision "1")) - (package - (name "sbcl-dbus") - (build-system asdf-build-system/sbcl) - (version (git-version "20190408" revision commit)) - (home-page "https://github.com/death/dbus") - (source - (origin - (method git-fetch) - (uri (git-reference - (url home-page) - (commit commit))) - (file-name (git-file-name name version)) - (sha256 - (base32 - "0fw2q866yddbf23nk9pxphm9gsasx35vjyss82xzvndnjmzlqfl5")))) - (inputs - `(("alexandria" ,sbcl-alexandria) - ("trivial-garbage" ,sbcl-trivial-garbage) - ("babel" ,sbcl-babel) - ("iolib" ,sbcl-iolib) - ("iolib+multiplex" ,sbcl-iolib+multiplex) - ("iolib+syscalls" ,sbcl-iolib+syscalls) - ("iolib+streams" ,sbcl-iolib+streams) - ("iolib+sockets" ,sbcl-iolib+sockets) - ("ieee-floats" ,sbcl-ieee-floats) - ("flexi-streams" ,sbcl-flexi-streams) - ("cl-xmlspam" ,sbcl-cl-xmlspam) - ("ironclad" ,sbcl-ironclad))) - (synopsis "D-Bus client library for Common Lisp") - (description "This is a Common Lisp library that allows to publish D-Bus -objects as well as send and notify other objects connected to a bus.") - (license license:bsd-2)))) -- cgit v1.2.3 From cce7b037084fe6680803850aed249950e0fdba09 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Jul 2019 22:29:47 +0200 Subject: Revert "gnu: Add sbcl-cl-xmlspam." The sbcl-cl-xmlspam package currently has no license information, which makes it non-free. Furthermore, the invalid 'license' field prevents evaluation from completing. This reverts commit ec982546941b59fdd14e0b08f023baf2e75d71a3. --- gnu/packages/lisp.scm | 29 ----------------------------- 1 file changed, 29 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 64e5a16939..3aa2429595 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -6579,32 +6579,3 @@ This system contains the CFFI foreign slot access extension."))) (description "Trivia is a pattern matching compiler that is compatible with Optima, another pattern matching library for Common Lisp. It is meant to be faster and more extensible than Optima."))) - -(define-public sbcl-cl-xmlspam - (package - (name "sbcl-cl-xmlspam") - (build-system asdf-build-system/sbcl) - (version "0.0.0") - (home-page "https://common-lisp.net/project/cl-xmlspam/") - (source - (origin - (method url-fetch) - (uri "http://common-lisp.net/project/cl-xmlspam/cl-xmlspam.tgz") - (file-name (string-append name "-" version)) - (sha256 - (base32 - "0r0pjh1yjcj2izxlbd3f3bwfwxllhag56wz8ijdl6442pf3gdazh")))) - (inputs - `(("cxml" ,sbcl-cxml) - ("cl-ppcre" ,sbcl-cl-ppcre))) - (synopsis "Concise, regexp-like pattern matching on streaming XML for Common Lisp") - (description "CXML does an excellent job at parsing XML elements, but what -do you do when you have a XML file that's larger than you want to fit in -memory, and you want to extract some information from it? Writing code to deal -with SAX events, or even using Klacks, quickly becomes tedious. -@code{cl-xmlspam} (for XML Stream PAttern Matcher) is designed to make it easy -to write code that mirrors the structure of the XML that it's parsing. It -also makes it easy to shift paradigms when necessary - the usual Lisp control -constructs can be used interchangeably with pattern matching, and the full -power of CXML is available when necessary.") - (license #f))) -- cgit v1.2.3 From a9b09ed7764762f93c1a8b7c96769b9da72dc8c4 Mon Sep 17 00:00:00 2001 From: "Jakob L. Kreuze" Date: Fri, 5 Jul 2019 14:54:32 -0400 Subject: ssh: Add 'identity' keyword to 'open-ssh-session'. * guix/ssh.scm (open-ssh-session): Add 'identity' keyword argument. --- guix/ssh.scm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/guix/ssh.scm b/guix/ssh.scm index 9b9baf54ea..ede00133c8 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -57,12 +57,14 @@ (define %compression "zlib@openssh.com,zlib") -(define* (open-ssh-session host #:key user port +(define* (open-ssh-session host #:key user port identity (compression %compression)) - "Open an SSH session for HOST and return it. When USER and PORT are #f, use -default values or whatever '~/.ssh/config' specifies; otherwise use them. -Throw an error on failure." + "Open an SSH session for HOST and return it. IDENTITY specifies the file +name of a private key to use for authenticating with the host. When USER, +PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config' +specifies; otherwise use them. Throw an error on failure." (let ((session (make-session #:user user + #:identity identity #:host host #:port port #:timeout 10 ;seconds -- cgit v1.2.3 From fa9edf09e992db7510c7471486dffc93e1e707e5 Mon Sep 17 00:00:00 2001 From: "Jakob L. Kreuze" Date: Fri, 5 Jul 2019 14:55:21 -0400 Subject: gnu: Add machine type for deployment specifications. * gnu/machine.scm: New file. * gnu/machine/ssh.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- Makefile.am | 3 +- gnu/local.mk | 5 +- gnu/machine.scm | 107 +++++++++++++++ gnu/machine/ssh.scm | 369 ++++++++++++++++++++++++++++++++++++++++++++++++++++ po/guix/POTFILES.in | 1 + 5 files changed, 483 insertions(+), 2 deletions(-) create mode 100644 gnu/machine.scm create mode 100644 gnu/machine/ssh.scm diff --git a/Makefile.am b/Makefile.am index 31430545cb..beb60097a4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -425,7 +425,8 @@ SCM_TESTS = \ tests/import-utils.scm \ tests/store-database.scm \ tests/store-deduplication.scm \ - tests/store-roots.scm + tests/store-roots.scm \ + tests/machine.scm SH_TESTS = \ tests/guix-build.sh \ diff --git a/gnu/local.mk b/gnu/local.mk index 8d7760cf46..68a43330c4 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -565,6 +565,9 @@ GNU_SYSTEM_MODULES = \ %D%/system/uuid.scm \ %D%/system/vm.scm \ \ + %D%/machine.scm \ + %D%/machine/ssh.scm \ + \ %D%/build/accounts.scm \ %D%/build/activation.scm \ %D%/build/bootloader.scm \ @@ -630,7 +633,7 @@ INSTALLER_MODULES = \ %D%/installer/newt/user.scm \ %D%/installer/newt/utils.scm \ %D%/installer/newt/welcome.scm \ - %D%/installer/newt/wifi.scm + %D%/installer/newt/wifi.scm # Always ship the installer modules but compile them only when # ENABLE_INSTALLER is true. diff --git a/gnu/machine.scm b/gnu/machine.scm new file mode 100644 index 0000000000..0b79402b0a --- /dev/null +++ b/gnu/machine.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 David Thompson +;;; Copyright © 2019 Jakob L. Kreuze +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu machine) + #:use-module (gnu system) + #:use-module (guix derivations) + #:use-module (guix monads) + #:use-module (guix records) + #:use-module (guix store) + #:use-module ((guix utils) #:select (source-properties->location)) + #:export (environment-type + environment-type? + environment-type-name + environment-type-description + environment-type-location + + machine + machine? + this-machine + + machine-system + machine-environment + machine-configuration + machine-display-name + + deploy-machine + machine-remote-eval)) + +;;; Commentary: +;;; +;;; This module provides the types used to declare individual machines in a +;;; heterogeneous Guix deployment. The interface allows users of specify system +;;; configurations and the means by which resources should be provisioned on a +;;; per-host basis. +;;; +;;; Code: + + +;;; +;;; Declarations for resources that can be provisioned. +;;; + +(define-record-type* environment-type + make-environment-type + environment-type? + + ;; Interface to the environment type's deployment code. Each procedure + ;; should take the same arguments as the top-level procedure of this file + ;; that shares the same name. For example, 'machine-remote-eval' should be + ;; of the form '(machine-remote-eval machine exp)'. + (machine-remote-eval environment-type-machine-remote-eval) ; procedure + (deploy-machine environment-type-deploy-machine) ; procedure + + ;; Metadata. + (name environment-type-name) ; symbol + (description environment-type-description ; string + (default #f)) + (location environment-type-location ; + (default (and=> (current-source-location) + source-properties->location)) + (innate))) + + +;;; +;;; Declarations for machines in a deployment. +;;; + +(define-record-type* machine + make-machine + machine? + this-machine + (system machine-system) ; + (environment machine-environment) ; symbol + (configuration machine-configuration ; configuration object + (default #f))) ; specific to environment + +(define (machine-display-name machine) + "Return the host-name identifying MACHINE." + (operating-system-host-name (machine-system machine))) + +(define (machine-remote-eval machine exp) + "Evaluate EXP, a gexp, on MACHINE. Ensure that all the elements EXP refers to +are built and deployed to MACHINE beforehand." + (let ((environment (machine-environment machine))) + ((environment-type-machine-remote-eval environment) machine exp))) + +(define (deploy-machine machine) + "Monadic procedure transferring the new system's OS closure to the remote +MACHINE, activating it on MACHINE and switching MACHINE to the new generation." + (let ((environment (machine-environment machine))) + ((environment-type-deploy-machine environment) machine))) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm new file mode 100644 index 0000000000..a7d1a967ae --- /dev/null +++ b/gnu/machine/ssh.scm @@ -0,0 +1,369 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Jakob L. Kreuze +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu machine ssh) + #:use-module (gnu bootloader) + #:use-module (gnu machine) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu system) + #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix i18n) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix records) + #:use-module (guix remote) + #:use-module (guix ssh) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-35) + #:export (managed-host-environment-type + + machine-ssh-configuration + machine-ssh-configuration? + machine-ssh-configuration + + machine-ssh-configuration-host-name + machine-ssh-configuration-port + machine-ssh-configuration-user + machine-ssh-configuration-session)) + +;;; Commentary: +;;; +;;; This module implements remote evaluation and system deployment for +;;; machines that are accessable over SSH and have a known host-name. In the +;;; sense of the broader "machine" interface, we describe the environment for +;;; such machines as 'managed-host. +;;; +;;; Code: + + +;;; +;;; Parameters for the SSH client. +;;; + +(define-record-type* machine-ssh-configuration + make-machine-ssh-configuration + machine-ssh-configuration? + this-machine-ssh-configuration + (host-name machine-ssh-configuration-host-name) ; string + (port machine-ssh-configuration-port ; integer + (default 22)) + (user machine-ssh-configuration-user ; string + (default "root")) + (identity machine-ssh-configuration-identity ; path to a private key + (default #f)) + (session machine-ssh-configuration-session ; session + (default #f))) + +(define (machine-ssh-session machine) + "Return the SSH session that was given in MACHINE's configuration, or create +one from the configuration's parameters if one was not provided." + (maybe-raise-unsupported-configuration-error machine) + (let ((config (machine-configuration machine))) + (or (machine-ssh-configuration-session config) + (let ((host-name (machine-ssh-configuration-host-name config)) + (user (machine-ssh-configuration-user config)) + (port (machine-ssh-configuration-port config)) + (identity (machine-ssh-configuration-identity config))) + (open-ssh-session host-name + #:user user + #:port port + #:identity identity))))) + + +;;; +;;; Remote evaluation. +;;; + +(define (managed-host-remote-eval machine exp) + "Internal implementation of 'machine-remote-eval' for MACHINE instances with +an environment type of 'managed-host." + (maybe-raise-unsupported-configuration-error machine) + (remote-eval exp (machine-ssh-session machine))) + + +;;; +;;; System deployment. +;;; + +(define (switch-to-system machine) + "Monadic procedure creating a new generation on MACHINE and execute the +activation script for the new system configuration." + (define (remote-exp drv script) + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define %system-profile + (string-append %state-directory "/profiles/system")) + + (let* ((system #$drv) + (number (1+ (generation-number %system-profile))) + (generation (generation-file-name %system-profile number))) + (switch-symlinks generation system) + (switch-symlinks %system-profile generation) + ;; The implementation of 'guix system reconfigure' saves the + ;; load path and environment here. This is unnecessary here + ;; because each invocation of 'remote-eval' runs in a distinct + ;; Guile REPL. + (setenv "GUIX_NEW_SYSTEM" system) + ;; The activation script may write to stdout, which confuses + ;; 'remote-eval' when it attempts to read a result from the + ;; remote REPL. We work around this by forcing the output to a + ;; string. + (with-output-to-string + (lambda () + (primitive-load #$script)))))))) + + (let* ((os (machine-system machine)) + (script (operating-system-activation-script os))) + (mlet* %store-monad ((drv (operating-system-derivation os))) + (machine-remote-eval machine (remote-exp drv script))))) + +;; XXX: Currently, this does NOT attempt to restart running services. This is +;; also the case with 'guix system reconfigure'. +;; +;; See . +(define (upgrade-shepherd-services machine) + "Monadic procedure unloading and starting services on the remote as needed +to realize the MACHINE's system configuration." + (define target-services + ;; Monadic expression evaluating to a list of (name output-path) pairs for + ;; all of MACHINE's services. + (mapm %store-monad + (lambda (service) + (mlet %store-monad ((file ((compose lower-object + shepherd-service-file) + service))) + (return (list (shepherd-service-canonical-name service) + (derivation->output-path file))))) + (service-value + (fold-services (operating-system-services (machine-system machine)) + #:target-type shepherd-root-service-type)))) + + (define (remote-exp target-services) + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + (define running + (filter live-service-running (current-services))) + + (define (essential? service) + ;; Return #t if SERVICE is essential and should not be unloaded + ;; under any circumstance. + (memq (first (live-service-provision service)) + '(root shepherd))) + + (define (obsolete? service) + ;; Return #t if SERVICE can be safely unloaded. + (and (not (essential? service)) + (every (lambda (requirements) + (not (memq (first (live-service-provision service)) + requirements))) + (map live-service-requirement running)))) + + (define to-unload + (filter obsolete? + (remove (lambda (service) + (memq (first (live-service-provision service)) + (map first '#$target-services))) + running))) + + (define to-start + (remove (lambda (service-pair) + (memq (first service-pair) + (map (compose first live-service-provision) + running))) + '#$target-services)) + + ;; Unload obsolete services. + (for-each (lambda (service) + (false-if-exception + (unload-service service))) + to-unload) + + ;; Load the service files for any new services and start them. + (load-services/safe (map second to-start)) + (for-each start-service (map first to-start)) + + #t))) + + (mlet %store-monad ((target-services target-services)) + (machine-remote-eval machine (remote-exp target-services)))) + +(define (machine-boot-parameters machine) + "Monadic procedure returning a list of 'boot-parameters' for the generations +of MACHINE's system profile, ordered from most recent to oldest." + (define bootable-kernel-arguments + (@@ (gnu system) bootable-kernel-arguments)) + + (define remote-exp + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles))) + #~(begin + (use-modules (guix config) + (guix profiles) + (ice-9 textual-ports)) + + (define %system-profile + (string-append %state-directory "/profiles/system")) + + (define (read-file path) + (call-with-input-file path + (lambda (port) + (get-string-all port)))) + + (map (lambda (generation) + (let* ((system-path (generation-file-name %system-profile + generation)) + (boot-parameters-path (string-append system-path + "/parameters")) + (time (stat:mtime (lstat system-path)))) + (list generation + system-path + time + (read-file boot-parameters-path)))) + (reverse (generation-numbers %system-profile))))))) + + (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp))) + (return + (map (lambda (generation) + (match generation + ((generation system-path time serialized-params) + (let* ((params (call-with-input-string serialized-params + read-boot-parameters)) + (root (boot-parameters-root-device params)) + (label (boot-parameters-label params))) + (boot-parameters + (inherit params) + (label + (string-append label " (#" + (number->string generation) ", " + (let ((time (make-time time-utc 0 time))) + (date->string (time-utc->date time) + "~Y-~m-~d ~H:~M")) + ")")) + (kernel-arguments + (append (bootable-kernel-arguments system-path root) + (boot-parameters-kernel-arguments params)))))))) + generations)))) + +(define (install-bootloader machine) + "Create a bootloader entry for the new system generation on MACHINE, and +configure the bootloader to boot that generation by default." + (define bootloader-installer-script + (@@ (guix scripts system) bootloader-installer-script)) + + (define (remote-exp installer bootcfg bootcfg-file) + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build install) + (guix store) + (guix utils)) + (let* ((gc-root (string-append "/" %gc-roots-directory "/bootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + + (switch-symlinks temp-gc-root gc-root) + + (unless (false-if-exception + (begin + ;; The implementation of 'guix system reconfigure' + ;; saves the load path here. This is unnecessary here + ;; because each invocation of 'remote-eval' runs in a + ;; distinct Guile REPL. + (install-boot-config #$bootcfg #$bootcfg-file "/") + ;; The installation script may write to stdout, which + ;; confuses 'remote-eval' when it attempts to read a + ;; result from the remote REPL. We work around this + ;; by forcing the output to a string. + (with-output-to-string + (lambda () + (primitive-load #$installer))))) + (delete-file temp-gc-root) + (error "failed to install bootloader")) + + (rename-file temp-gc-root gc-root) + #t))))) + + (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))) + (let* ((os (machine-system machine)) + (bootloader ((compose bootloader-configuration-bootloader + operating-system-bootloader) + os)) + (bootloader-target (bootloader-configuration-target + (operating-system-bootloader os))) + (installer (bootloader-installer-script + (bootloader-installer bootloader) + (bootloader-package bootloader) + bootloader-target + "/")) + (menu-entries (map boot-parameters->menu-entry boot-parameters)) + (bootcfg (operating-system-bootcfg os menu-entries)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (machine-remote-eval machine (remote-exp installer bootcfg bootcfg-file))))) + +(define (deploy-managed-host machine) + "Internal implementation of 'deploy-machine' for MACHINE instances with an +environment type of 'managed-host." + (maybe-raise-unsupported-configuration-error machine) + (mbegin %store-monad + (switch-to-system machine) + (upgrade-shepherd-services machine) + (install-bootloader machine))) + + +;;; +;;; Environment type. +;;; + +(define managed-host-environment-type + (environment-type + (machine-remote-eval managed-host-remote-eval) + (deploy-machine deploy-managed-host) + (name 'managed-host-environment-type) + (description "Provisioning for machines that are accessable over SSH +and have a known host-name. This entails little more than maintaining an SSH +connection to the host."))) + +(define (maybe-raise-unsupported-configuration-error machine) + "Raise an error if MACHINE's configuration is not an instance of +." + (let ((config (machine-configuration machine)) + (environment (environment-type-name (machine-environment machine)))) + (unless (and config (machine-ssh-configuration? config)) + (raise (condition + (&message + (message (format #f (G_ "unsupported machine configuration '~a' +for environment of type '~a'") + config + environment)))))))) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index ceee589b2e..bcd6f76371 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -36,6 +36,7 @@ gnu/installer/steps.scm gnu/installer/timezone.scm gnu/installer/user.scm gnu/installer/utils.scm +gnu/machine/ssh.scm guix/scripts.scm guix/scripts/build.scm guix/discovery.scm -- cgit v1.2.3 From 5cbb832fb107a8ca55938a52f6699ad8c6f08c8d Mon Sep 17 00:00:00 2001 From: "Jakob L. Kreuze" Date: Fri, 5 Jul 2019 14:56:07 -0400 Subject: Add 'guix deploy'. * guix/scripts/deploy.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + guix/scripts/deploy.scm | 84 +++++++++++++++++++++++++++++++++++++++++++++++++ po/guix/POTFILES.in | 1 + 3 files changed, 86 insertions(+) create mode 100644 guix/scripts/deploy.scm diff --git a/Makefile.am b/Makefile.am index beb60097a4..34bef76b47 100644 --- a/Makefile.am +++ b/Makefile.am @@ -267,6 +267,7 @@ MODULES = \ guix/scripts/weather.scm \ guix/scripts/container.scm \ guix/scripts/container/exec.scm \ + guix/scripts/deploy.scm \ guix.scm \ $(GNU_SYSTEM_MODULES) diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm new file mode 100644 index 0000000000..978cfb2a81 --- /dev/null +++ b/guix/scripts/deploy.scm @@ -0,0 +1,84 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 David Thompson +;;; Copyright © 2019 Jakob L. Kreuze +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix scripts deploy) + #:use-module (gnu machine) + #:use-module (guix scripts) + #:use-module (guix scripts build) + #:use-module (guix store) + #:use-module (guix ui) + #:use-module (ice-9 format) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:export (guix-deploy)) + +;;; Commentary: +;;; +;;; This program provides a command-line interface to (gnu machine), allowing +;;; users to perform remote deployments through specification files. +;;; +;;; Code: + + + +(define (show-help) + (display (G_ "Usage: guix deploy [OPTION] FILE... +Perform the deployment specified by FILE.\n")) + (show-build-options-help) + (newline) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + %standard-build-options)) + +(define %default-options + '((system . ,(%current-system)) + (substitutes? . #t) + (build-hook? . #t) + (graft? . #t) + (debug . 0) + (verbosity . 1))) + +(define (load-source-file file) + "Load FILE as a user module." + (let ((module (make-user-module '((gnu) (gnu machine) (gnu machine ssh))))) + (load* file module))) + +(define (guix-deploy . args) + (define (handle-argument arg result) + (alist-cons 'file arg result)) + (let* ((opts (parse-command-line args %options (list %default-options) + #:argument-handler handle-argument)) + (file (assq-ref opts 'file)) + (machines (or (and file (load-source-file file)) '()))) + (with-store store + (set-build-options-from-command-line store opts) + (for-each (lambda (machine) + (info (G_ "deploying to ~a...") (machine-display-name machine)) + (run-with-store store (deploy-machine machine))) + machines)))) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index bcd6f76371..f5fc4956b4 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -67,6 +67,7 @@ guix/scripts/pack.scm guix/scripts/weather.scm guix/scripts/describe.scm guix/scripts/processes.scm +guix/scripts/deploy.scm guix/gnu-maintenance.scm guix/scripts/container.scm guix/scripts/container/exec.scm -- cgit v1.2.3 From 02a962c8e0a14110f5585dcf0f95c7f8a38f448c Mon Sep 17 00:00:00 2001 From: "Jakob L. Kreuze" Date: Fri, 5 Jul 2019 14:57:39 -0400 Subject: doc: Add section for 'guix deploy'. * doc/guix.texi: Add section "Invoking guix deploy". --- doc/guix.texi | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 1794c6cd5a..0b50482530 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -65,6 +65,7 @@ Copyright @copyright{} 2018 Alex Vong@* Copyright @copyright{} 2019 Josh Holland@* Copyright @copyright{} 2019 Diego Nicola Barbato@* Copyright @copyright{} 2019 Ivan Petkov@* +Copyright @copyright{} 2019 Jakob L. Kreuze@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -81,6 +82,7 @@ Documentation License''. * guix gc: (guix)Invoking guix gc. Reclaiming unused disk space. * guix pull: (guix)Invoking guix pull. Update the list of available packages. * guix system: (guix)Invoking guix system. Manage the operating system configuration. +* guix deploy: (guix)Invoking guix deploy. Manage operating system configurations for remote hosts. @end direntry @dircategory Software development @@ -269,6 +271,7 @@ System Configuration * Initial RAM Disk:: Linux-Libre bootstrapping. * Bootloader Configuration:: Configuring the boot loader. * Invoking guix system:: Instantiating a system configuration. +* Invoking guix deploy:: Deploying a system configuration to a remote host. * Running Guix in a VM:: How to run Guix System in a virtual machine. * Defining Services:: Adding new service definitions. @@ -10296,6 +10299,7 @@ instance to support new system services. * Initial RAM Disk:: Linux-Libre bootstrapping. * Bootloader Configuration:: Configuring the boot loader. * Invoking guix system:: Instantiating a system configuration. +* Invoking guix deploy:: Deploying a system configuration to a remote host. * Running Guix in a VM:: How to run Guix System in a virtual machine. * Defining Services:: Adding new service definitions. @end menu @@ -25392,6 +25396,116 @@ example graph. @end table +@node Invoking guix deploy +@section Invoking @code{guix deploy} + +We've already seen @code{operating-system} declarations used to manage a +machine's configuration locally. Suppose you need to configure multiple +machines, though---perhaps you're managing a service on the web that's +comprised of several servers. @command{guix deploy} enables you to use those +same @code{operating-system} declarations to manage multiple remote hosts at +once as a logical ``deployment''. + +@quotation Note +The functionality described in this section is still under development +and is subject to change. Get in touch with us on +@email{guix-devel@@gnu.org}! +@end quotation + +@example +guix deploy @var{file} +@end example + +Such an invocation will deploy the machines that the code within @var{file} +evaluates to. As an example, @var{file} might contain a definition like this: + +@example +;; This is a Guix deployment of a "bare bones" setup, with +;; no X11 display server, to a machine with an SSH daemon +;; listening on localhost:2222. A configuration such as this +;; may be appropriate for virtual machine with ports +;; forwarded to the host's loopback interface. + +(use-service-modules networking ssh) +(use-package-modules bootloaders) + +(define %system + (operating-system + (host-name "gnu-deployed") + (timezone "Etc/UTC") + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vda") + (terminal-outputs '(console)))) + (file-systems (cons (file-system + (mount-point "/") + (device "/dev/vda1") + (type "ext4")) + %base-file-systems)) + (services + (append (list (service dhcp-client-service-type) + (service openssh-service-type + (openssh-configuration + (permit-root-login #t) + (allow-empty-passwords? #t)))) + %base-services)))) + +(list (machine + (system %system) + (environment managed-host-environment-type) + (configuration (machine-ssh-configuration + (host-name "localhost") + (identity "./id_rsa") + (port 2222))))) +@end example + +The file should evaluate to a list of @var{machine} objects. This example, +upon being deployed, will create a new generation on the remote system +realizing the @code{operating-system} declaration @var{%system}. +@var{environment} and @var{configuration} specify how the machine should be +provisioned---that is, how the computing resources should be created and +managed. The above example does not create any resources, as a +@code{'managed-host} is a machine that is already running the Guix system and +available over the network. This is a particularly simple case; a more +complex deployment may involve, for example, starting virtual machines through +a Virtual Private Server (VPS) provider. In such a case, a different +@var{environment} type would be used. + +@deftp {Data Type} machine +This is the data type representing a single machine in a heterogeneous Guix +deployment. + +@table @asis +@item @code{system} +The object of the operating system configuration to deploy. + +@item @code{environment} +An @code{environment-type} describing how the machine should be provisioned. +At the moment, the only supported value is +@code{managed-host-environment-type}. + +@item @code{configuration} (default: @code{#f}) +An object describing the configuration for the machine's @code{environment}. +If the @code{environment} has a default configuration, @code{#f} maybe used. +If @code{#f} is used for an environment with no default configuration, +however, an error will be thrown. +@end table +@end deftp + +@deftp {Data Type} machine-ssh-configuration +This is the data type representing the SSH client parameters for a machine +with an @code{environment} of @code{managed-host-environment-type}. + +@table @asis +@item @code{host-name} +@item @code{port} (default: @code{22}) +@item @code{user} (default: @code{"root"}) +@item @code{identity} (default: @code{#f}) +If specified, the path to the SSH private key to use to authenticate with the +remote host. +@end table +@end deftp + @node Running Guix in a VM @section Running Guix in a Virtual Machine -- cgit v1.2.3 From c356e5f7a08f6f0c8780bdcd501702c0b2b4af3c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 6 Jul 2019 00:09:36 +0200 Subject: gnu: grammalecte: Update to 1.2. * gnu/packages/dictionaries.scm (grammalecte): Update to 1.2. --- gnu/packages/dictionaries.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/dictionaries.scm b/gnu/packages/dictionaries.scm index 9f4dc59cc8..d3a3f8d832 100644 --- a/gnu/packages/dictionaries.scm +++ b/gnu/packages/dictionaries.scm @@ -218,7 +218,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.") (define-public grammalecte (package (name "grammalecte") - (version "1.1.1") + (version "1.2") (source (origin (method url-fetch/zipbomb) @@ -226,7 +226,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.") "Grammalecte-fr-v" version ".zip")) (sha256 (base32 - "1al4c3976wgxijxghxqb1banarj82hwad51kln87xj2r5kwcfm05")))) + "0dwizai6w9yn617y7cnqdiwv77vn22p18s9sypypbl1bl695cnma")))) (build-system python-build-system) (home-page "https://grammalecte.net") (synopsis "French spelling and grammar checker") -- cgit v1.2.3 From 935e79af61f4d903e562362cdd828be807e15581 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 6 Jul 2019 00:18:18 +0200 Subject: linux-container: Mount a new /dev/pts instance in the container. Fixes . Reported by Steffen Rytter Postas . * gnu/build/linux-container.scm (mount-file-systems): When /dev/ptmx exists on the host, explicitly mount a new instance of devpts and make /dev/ptmx a symlink to /dev/pts/ptmx. --- gnu/build/linux-container.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm index e86ac606c0..6ccb924861 100644 --- a/gnu/build/linux-container.scm +++ b/gnu/build/linux-container.scm @@ -130,9 +130,14 @@ for the process." "/dev/random" "/dev/urandom" "/dev/tty" - "/dev/ptmx" "/dev/fuse")) + ;; Mount a new devpts instance on /dev/pts. + (when (file-exists? "/dev/ptmx") + (mount* "none" (scope "/dev/pts") "devpts" 0 + "newinstance,mode=0620") + (symlink "/dev/pts/ptmx" (scope "/dev/ptmx"))) + ;; Setup the container's /dev/console by bind mounting the pseudo-terminal ;; associated with standard input when there is one. (let* ((in (current-input-port)) -- cgit v1.2.3 From 403f2189aa5ca1d0c39add46a4d96b40552ad832 Mon Sep 17 00:00:00 2001 From: Rutger Helling Date: Sat, 6 Jul 2019 10:46:24 +0200 Subject: gnu: wine-staging: Update to 4.12. * gnu/packages/wine.scm (wine-staging-patchset-data): Update to 4.12. * gnu/packages/wine.scm (wine-staging): Update to 4.12. --- gnu/packages/wine.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/wine.scm b/gnu/packages/wine.scm index 72f0e1fd55..b76c9d18b9 100644 --- a/gnu/packages/wine.scm +++ b/gnu/packages/wine.scm @@ -310,7 +310,7 @@ integrate Windows applications into your desktop.") (define-public wine-staging-patchset-data (package (name "wine-staging-patchset-data") - (version "4.11") + (version "4.12") (source (origin (method git-fetch) @@ -320,7 +320,7 @@ integrate Windows applications into your desktop.") (file-name (git-file-name name version)) (sha256 (base32 - "0h8qldqr9w1kwn48qgg5m1cs2xqkv8xxg2c66cvfka91hy886jcf")))) + "1drsrps6bd5gcafzcfrr9pzajhh5s6qg5la7q4qpwzlng9969f3r")))) (build-system trivial-build-system) (native-inputs `(("bash" ,bash) @@ -366,7 +366,7 @@ integrate Windows applications into your desktop.") (file-name (string-append name "-" version ".tar.xz")) (sha256 (base32 - "1rmyfwlynzs2niz7l2lwjs2axm6in6gb43ldbzyzsflxsmk5fl9f")))) + "1az5pcczq2zl1cvfdggzf89n0sf77m3fjkc8rnna8qr3n585q4h0")))) (inputs `(("autoconf" ,autoconf) ; for autoreconf ("faudio" ,faudio) ("ffmpeg" ,ffmpeg) -- cgit v1.2.3 From d9e6217f4e978777d1e6f7b82a1e096740cc419a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 6 Jul 2019 15:54:45 +0200 Subject: channels: Simplify 'channel-instances->manifest'. * guix/channels.scm (channel-instances->manifest)[instance->entry]: Change to take two arguments instead of a tuple. Turn into a non-monadic procedure. Call it via 'map' instead of 'mapm'. --- guix/channels.scm | 43 +++++++++++++++++++------------------------ 1 file changed, 19 insertions(+), 24 deletions(-) diff --git a/guix/channels.scm b/guix/channels.scm index e7278c6060..fcf9fed829 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -429,32 +429,27 @@ derivation." (define (channel-instances->manifest instances) "Return a profile manifest with entries for all of INSTANCES, a list of channel instances." - (define instance->entry - (match-lambda - ((instance drv) - (let ((commit (channel-instance-commit instance)) - (channel (channel-instance-channel instance))) - (with-monad %store-monad - (return (manifest-entry - (name (symbol->string (channel-name channel))) - (version (string-take commit 7)) - (item (if (guix-channel? channel) - (if (old-style-guix? drv) - (whole-package-for-legacy - (string-append name "-" version) - drv) - drv) - drv)) - (properties - `((source (repository - (version 0) - (url ,(channel-url channel)) - (branch ,(channel-branch channel)) - (commit ,commit)))))))))))) + (define (instance->entry instance drv) + (let ((commit (channel-instance-commit instance)) + (channel (channel-instance-channel instance))) + (manifest-entry + (name (symbol->string (channel-name channel))) + (version (string-take commit 7)) + (item (if (guix-channel? channel) + (if (old-style-guix? drv) + (whole-package-for-legacy (string-append name "-" version) + drv) + drv) + drv)) + (properties + `((source (repository + (version 0) + (url ,(channel-url channel)) + (branch ,(channel-branch channel)) + (commit ,commit)))))))) (mlet* %store-monad ((derivations (channel-instance-derivations instances)) - (entries (mapm %store-monad instance->entry - (zip instances derivations)))) + (entries -> (map instance->entry instances derivations))) (return (manifest entries)))) (define (package-cache-file manifest) -- cgit v1.2.3 From c3ab921eed2a471022e9863a94ea521508782e53 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 6 Jul 2019 16:04:14 +0200 Subject: ci: 'channel-build-system' honors the target system. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes a bug made evident e79281be105b16153c375af5506db31fd1e32698: the x86_64-linux derivation of 'current-guix' would be cached and reused for i686-linux, leading to test failures. Namely, /run/current-system/profile/bin/guix would have an x86_64 binary in its shebang, and thus it would end up being interpreted by /bin/sh, which would fail like this: + guix --version /run/current-system/profile/bin/guix: line 2: !#: command not found /run/current-system/profile/bin/guix: line 3: syntax error near unexpected token `set!' /run/current-system/profile/bin/guix: line 3: `(begin (set! %load-path … See . * gnu/ci.scm (channel-build-system)[build]: Pass #:system to 'run-with-store'. --- gnu/ci.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/gnu/ci.scm b/gnu/ci.scm index e108b4b15b..4885870e16 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -193,9 +193,11 @@ system.") (define channel-build-system ;; Build system used to "convert" a channel instance to a package. (let* ((build (lambda* (store name inputs - #:key instance #:allow-other-keys) + #:key instance system + #:allow-other-keys) (run-with-store store - (channel-instances->derivation (list instance))))) + (channel-instances->derivation (list instance)) + #:system system))) (lower (lambda* (name #:key system instance #:allow-other-keys) (bag (name name) -- cgit v1.2.3 From 8dfb0c969e513276c632b8d26fb3601fa02993ca Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 6 Jul 2019 16:15:01 +0200 Subject: tests: encrypted-root-os: Increase root partition size. 1.2G had become slightly too small on x86_64. * gnu/tests/install.scm (%encrypted-root-installation-script): Increase root partition size to 1.3G. --- gnu/tests/install.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 9f6baa1a48..124d176181 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -661,7 +661,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts ls -l /run/current-system/gc-roots parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ - mkpart primary ext2 3M 1.2G \\ + mkpart primary ext2 3M 1.4G \\ set 1 boot on \\ set 1 bios_grub on echo -n thepassphrase | \\ -- cgit v1.2.3 From 834b8a4110758bec27753976ec0fe77cd4c32e30 Mon Sep 17 00:00:00 2001 From: "Jakob L. Kreuze" Date: Sat, 6 Jul 2019 08:19:47 -0400 Subject: Remove references to non-existent 'tests/machine.scm'. * Makefile.am (SCM_TESTS): Remove 'tests/machine.scm' line. --- Makefile.am | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Makefile.am b/Makefile.am index 34bef76b47..c5dcf4113e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -426,8 +426,7 @@ SCM_TESTS = \ tests/import-utils.scm \ tests/store-database.scm \ tests/store-deduplication.scm \ - tests/store-roots.scm \ - tests/machine.scm + tests/store-roots.scm SH_TESTS = \ tests/guix-build.sh \ -- cgit v1.2.3 From 5bef0f108c3883bbe8888c749d7e6e2a0db61fc4 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 6 Jul 2019 18:09:32 +0200 Subject: gnu: python-olefile: Update to 0.46. * gnu/packages/python-xyz.scm (python-olefile): Update to 0.46. [source]: Switch to release tarball instead of git snapshot. --- gnu/packages/python-xyz.scm | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index b911d3693d..c37122f950 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -4302,19 +4302,18 @@ services for your Python modules and applications.") (define-public python-olefile (package (name "python-olefile") - (version "0.45.1") + (version "0.46") (source (origin (method url-fetch) - (uri (string-append "https://github.com/decalage2/olefile/archive/v" - version ".tar.gz")) + (uri (string-append "https://github.com/decalage2/olefile/releases/" + "download/v" version "/olefile-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "18ai19zwagm6nli14k8bii31ipbab2rp7plrvsm6gmfql551a8ai")))) + "1kjxh4gr651hpqkjfv89cfzr40hyvf3vjlda7mifiail83j7j07m")))) (build-system python-build-system) - (home-page - "https://www.decalage.info/python/olefileio") + (home-page "https://www.decalage.info/python/olefileio") (synopsis "Read and write Microsoft OLE2 files.") (description "@code{olefile} can parse, read and write Microsoft OLE2 files (Structured -- cgit v1.2.3 From e39d4933d12e6f7a32f2bee4f41a6194888214c6 Mon Sep 17 00:00:00 2001 From: Brian Leung Date: Fri, 5 Jul 2019 01:02:44 +0200 Subject: gnu: python-setuptools: Update to 41.0.1. * gnu/packages/python-xyz.scm (python-setuptools): Update to 41.0.1. Signed-off-by: Marius Bakke --- gnu/packages/python-xyz.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index c37122f950..8e904daaf2 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -649,14 +649,14 @@ other machines, such as over the network.") (define-public python-setuptools (package (name "python-setuptools") - (version "40.0.0") + (version "41.0.1") (source (origin (method url-fetch) (uri (pypi-uri "setuptools" version ".zip")) (sha256 (base32 - "0pq116lr14gnc62v76nk0npkm6krb2mpp7p9ab369zgv4n7dnah1")) + "04sns22y2hhsrwfy1mha2lgslvpjsjsz8xws7h2rh5a7ylkd28m2")) (modules '((guix build utils))) (snippet '(begin -- cgit v1.2.3 From e9cb6edd0652972993c4f71b640b591c322e1017 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 6 Jul 2019 18:39:17 +0200 Subject: gnu: python-soupsieve: Update to 1.9.2. * gnu/packages/python-xyz.scm (python-soupsieve): Update to 1.9.2. --- gnu/packages/python-xyz.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 8e904daaf2..e27cb16007 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -5702,14 +5702,14 @@ converts incoming documents to Unicode and outgoing documents to UTF-8.") (define-public python-soupsieve (package (name "python-soupsieve") - (version "1.9.1") + (version "1.9.2") (source (origin (method url-fetch) (uri (pypi-uri "soupsieve" version)) (sha256 (base32 - "1jnzkiwmjl6yvqckc9mf689g87b6yz07sv868hap2aa5arggy3mj")))) + "0in9rc9q3h8w5b4qf7kvl3qxcvw6vrz35ckblchgf70hm6pg3dbj")))) (build-system python-build-system) (arguments `(#:tests? #f)) ;;XXX: 2 tests fail currently despite claming they were to be -- cgit v1.2.3 From f4d562b008f939edb01673418872ab90ffd37e78 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 6 Jul 2019 18:44:15 +0200 Subject: gnu: libraw: Update to 0.19.3. * gnu/packages/photo.scm (libraw): Update to 0.19.3. --- gnu/packages/photo.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/photo.scm b/gnu/packages/photo.scm index b8ac1ea1d6..cf7da80642 100644 --- a/gnu/packages/photo.scm +++ b/gnu/packages/photo.scm @@ -70,14 +70,14 @@ (define-public libraw (package (name "libraw") - (version "0.19.2") + (version "0.19.3") (source (origin (method url-fetch) (uri (string-append "https://www.libraw.org/data/LibRaw-" version ".tar.gz")) (sha256 (base32 - "0i4nhjm5556xgn966x0i503ygk2wafq6z83kg0lisacjjab4f3a0")))) + "0xs1qb6pcvc4c43fy5xi3nkqxcif77gakkw99irf0fc5iccdd5px")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) -- cgit v1.2.3 From f1818f96a32584a81c7aa4775769d156c973cbf4 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 6 Jul 2019 18:48:56 +0200 Subject: gnu: jsoncpp: Fetch sources through git. * gnu/packages/serialization.scm (jsoncpp)[source]: Switch to GIT-FETCH. --- gnu/packages/serialization.scm | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/gnu/packages/serialization.scm b/gnu/packages/serialization.scm index ae1ef9749b..2a7dd629d5 100644 --- a/gnu/packages/serialization.scm +++ b/gnu/packages/serialization.scm @@ -298,17 +298,15 @@ that implements both the msgpack and msgpack-rpc specifications.") (package (name "jsoncpp") (version "1.8.4") + (home-page "https://github.com/open-source-parsers/jsoncpp") (source (origin - (method url-fetch) - (uri (string-append - "https://github.com/open-source-parsers/jsoncpp/archive/" - version ".tar.gz")) - (file-name (string-append name "-" version ".tar.gz")) + (method git-fetch) + (uri (git-reference (url home-page) (commit version))) + (file-name (git-file-name name version)) (sha256 (base32 - "1dpxk8hkni5dq4mdw8qbaj40jmid3a31d1gh8iqcnfwkw34ym7f4")))) + "1z0gj7a6jypkijmpknis04qybs1hkd04d1arr3gy89lnxmp6qzlm")))) (build-system cmake-build-system) - (home-page "https://github.com/open-source-parsers/jsoncpp") (arguments `(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES"))) (synopsis "C++ library for interacting with JSON") -- cgit v1.2.3 From 4ed252c332b83ca544f7ccf3890cdab293163736 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 6 Jul 2019 18:49:52 +0200 Subject: gnu: jsoncpp: Update to 1.9.0. * gnu/packages/serialization.scm (jsoncpp): Update to 1.9.0. --- gnu/packages/serialization.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/serialization.scm b/gnu/packages/serialization.scm index 2a7dd629d5..505c196abd 100644 --- a/gnu/packages/serialization.scm +++ b/gnu/packages/serialization.scm @@ -297,7 +297,7 @@ that implements both the msgpack and msgpack-rpc specifications.") (define-public jsoncpp (package (name "jsoncpp") - (version "1.8.4") + (version "1.9.0") (home-page "https://github.com/open-source-parsers/jsoncpp") (source (origin (method git-fetch) @@ -305,7 +305,7 @@ that implements both the msgpack and msgpack-rpc specifications.") (file-name (git-file-name name version)) (sha256 (base32 - "1z0gj7a6jypkijmpknis04qybs1hkd04d1arr3gy89lnxmp6qzlm")))) + "10wnwlq92gp32f5p55kjcc12jfsl0yq6f2y4abb0si6wym12krw9")))) (build-system cmake-build-system) (arguments `(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES"))) -- cgit v1.2.3 From c72647fbae675654e32e17a6891980a7b9272a71 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 6 Jul 2019 20:43:00 +0200 Subject: gnu: xpad: Build against gtksourceview@3. * gnu/packages/gnome.scm (xpad)[inputs]: Change GTKSOURCEVIEW to GTKSOURCEVIEW-3. --- gnu/packages/gnome.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 2820be0022..88d293ee9f 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -7232,7 +7232,7 @@ is suitable as a default application in a Desktop environment.") ("intltool" ,intltool) ("pkg-config" ,pkg-config))) (inputs - `(("gtksourceview" ,gtksourceview) + `(("gtksourceview" ,gtksourceview-3) ("libsm" ,libsm))) (home-page "https://wiki.gnome.org/Apps/Xpad") (synopsis "Virtual sticky note") -- cgit v1.2.3