From 6bd1c41e8729ab5f40620f2acc41dbc630d886de Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 4 Sep 2017 05:29:12 -0400 Subject: gnu: linux-libre: Update to 4.13. * gnu/packages/linux.scm (%linux-libre-version): Update to 4.13. (%linux-libre-hash): Update hash. * gnu/packages/aux-files/linux-libre/4.12-i686.conf, gnu/packages/aux-files/linux-libre/4.12-x86_64.conf: Delete files. * gnu/packages/aux-files/linux-libre/4.13-i686.conf, gnu/packages/aux-files/linux-libre/4.13-x86_64.conf: New files. * Makefile.am (AUX_FILES): Adjust accordingly. --- Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 9ba4ccba78..4c2e77d191 100644 --- a/Makefile.am +++ b/Makefile.am @@ -223,8 +223,8 @@ dist_noinst_DATA = guix/tests.scm guix/tests/http.scm # Auxiliary files for packages. AUX_FILES = \ gnu/packages/aux-files/emacs/guix-emacs.el \ - gnu/packages/aux-files/linux-libre/4.12-i686.conf \ - gnu/packages/aux-files/linux-libre/4.12-x86_64.conf \ + gnu/packages/aux-files/linux-libre/4.13-i686.conf \ + gnu/packages/aux-files/linux-libre/4.13-x86_64.conf \ gnu/packages/aux-files/linux-libre/4.9-i686.conf \ gnu/packages/aux-files/linux-libre/4.9-x86_64.conf \ gnu/packages/aux-files/linux-libre/4.4-i686.conf \ -- cgit 1.4.1 From 8f3b63b5d73c0b49139c8a20b7576732abfdeeb8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 14 Sep 2017 00:01:21 +0200 Subject: uuid: Move tests to 'tests/uuid.scm'. * tests/file-systems.scm ("uuid->string", "string->uuid") ("uuid", "uuid, syntax error"): Move to... * tests/uuid.scm: ... here. New file. ("uuid, ISO-9660, format preserved"): New test. --- Makefile.am | 1 + tests/file-systems.scm | 28 ------------------------- tests/uuid.scm | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 57 insertions(+), 28 deletions(-) create mode 100644 tests/uuid.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 4c2e77d191..aca18526f7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -312,6 +312,7 @@ SCM_TESTS = \ tests/workers.scm \ tests/zlib.scm \ tests/file-systems.scm \ + tests/uuid.scm \ tests/system.scm \ tests/services.scm \ tests/scripts-build.scm \ diff --git a/tests/file-systems.scm b/tests/file-systems.scm index 8e5c75e48c..4c28d0ebc5 100644 --- a/tests/file-systems.scm +++ b/tests/file-systems.scm @@ -19,43 +19,15 @@ (define-module (test-file-systems) #:use-module (guix store) #:use-module (guix modules) - #:use-module (gnu system uuid) #:use-module (gnu system file-systems) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) - #:use-module (rnrs bytevectors) #:use-module (ice-9 match)) ;; Test the (gnu system file-systems) module. (test-begin "file-systems") -(test-equal "uuid->string" - "c5307e6b-d1ba-499d-89c5-cb0b143577c4" - (uuid->string - #vu8(197 48 126 107 209 186 73 157 137 197 203 11 20 53 119 196))) - -(test-equal "string->uuid" - '(16 "4dab5feb-d176-45de-b287-9b0a6e4c01cb") - (let ((uuid (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))) - (list (bytevector-length uuid) (uuid->string uuid)))) - -(test-assert "uuid" - (let ((str "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) - (bytevector=? (uuid-bytevector - (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) - (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))) - -(test-assert "uuid, syntax error" - (catch 'syntax-error - (lambda () - (eval '(uuid "foobar") (current-module)) - #f) - (lambda (key proc message location form . args) - (and (eq? proc 'uuid) - (string-contains message "invalid UUID") - (equal? form '(uuid "foobar" 'dce)))))) - (test-assert "file-system-needed-for-boot?" (let-syntax ((dummy-fs (syntax-rules () ((_ directory) diff --git a/tests/uuid.scm b/tests/uuid.scm new file mode 100644 index 0000000000..c2f15de996 --- /dev/null +++ b/tests/uuid.scm @@ -0,0 +1,56 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015, 2017 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 (test-uuid) + #:use-module (gnu system uuid) + #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors)) + +(test-begin "uuid") + +(test-equal "uuid->string" + "c5307e6b-d1ba-499d-89c5-cb0b143577c4" + (uuid->string + #vu8(197 48 126 107 209 186 73 157 137 197 203 11 20 53 119 196))) + +(test-equal "string->uuid" + '(16 "4dab5feb-d176-45de-b287-9b0a6e4c01cb") + (let ((uuid (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))) + (list (bytevector-length uuid) (uuid->string uuid)))) + +(test-assert "uuid" + (let ((str "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) + (bytevector=? (uuid-bytevector + (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) + (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))) + +(test-assert "uuid, syntax error" + (catch 'syntax-error + (lambda () + (eval '(uuid "foobar") (current-module)) + #f) + (lambda (key proc message location form . args) + (and (eq? proc 'uuid) + (string-contains message "invalid UUID") + (equal? form '(uuid "foobar" 'dce)))))) + +(test-equal "uuid, ISO-9660, format preserved" + "1970-01-01-17-14-42-99" + (uuid->string (uuid "1970-01-01-17-14-42-99" 'iso9660))) + +(test-end) -- cgit 1.4.1 From 0649321d91406bb5c19419fac931c202867d7416 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Sep 2017 16:07:30 +0200 Subject: guix system: Add 'search' command. * guix/scripts/system.scm (resolve-subcommand): New procedure. (process-command): Handle 'search'. (guix-system): Likewise. (show-help): Augment. * guix/scripts/system/search.scm: New file. * po/guix/POTFILES.in: Add it. * Makefile.am (MODULES): Add it. * guix/ui.scm (%text-width): Export. * doc/guix.texi (Invoking guix system): Document it. (Service Types and Services): Mention 'guix system search'. * tests/guix-system.sh: Test it. --- Makefile.am | 1 + doc/guix.texi | 40 +++++++++++- guix/scripts/system.scm | 13 +++- guix/scripts/system/search.scm | 144 +++++++++++++++++++++++++++++++++++++++++ guix/ui.scm | 1 + po/guix/POTFILES.in | 1 + tests/guix-system.sh | 6 +- 7 files changed, 202 insertions(+), 4 deletions(-) create mode 100644 guix/scripts/system/search.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index aca18526f7..a2fb313916 100644 --- a/Makefile.am +++ b/Makefile.am @@ -164,6 +164,7 @@ MODULES = \ guix/scripts/authenticate.scm \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ + guix/scripts/system/search.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/cran.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index b2eed51bd0..ebeef50709 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17391,6 +17391,42 @@ operating system is instantiated. Currently the following values are supported: @table @code +@item search +Display available service type definitions that match the given regular +expressions, sorted by relevance: + +@example +$ guix system search console font +name: console-fonts +location: gnu/services/base.scm:729:2 +extends: shepherd-root +description: Install the given fonts on the specified ttys (fonts are ++ per virtual console on GNU/Linux). The value of this service is a list ++ of tty/font pairs like: ++ ++ '(("tty1" . "LatGrkCyr-8x16")) +relevance: 20 + +name: mingetty +location: gnu/services/base.scm:1048:2 +extends: shepherd-root +description: Provide console login using the `mingetty' program. +relevance: 2 + +name: login +location: gnu/services/base.scm:775:2 +extends: pam +description: Provide a console log-in service as specified by its ++ configuration value, a `login-configuration' object. +relevance: 2 + +@dots{} +@end example + +As for @command{guix package --search}, the result is written in +@code{recutils} format, which makes it easy to filter the output +(@pxref{Top, GNU recutils databases,, recutils, GNU recutils manual}). + @item reconfigure Build the operating system described in @var{file}, activate it, and switch to it@footnote{This action (and the related actions @@ -18023,7 +18059,9 @@ list of contributed rules. @item description This is a string giving an overview of the service type. The string can -contain Texinfo markup (@pxref{Overview,,, texinfo, GNU Texinfo}). +contain Texinfo markup (@pxref{Overview,,, texinfo, GNU Texinfo}). The +@command{guix system search} command searches these strings and displays +them (@pxref{Invoking guix system}). @end table There can be only one instance of an extensible service type such as diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index ea35fcdbc9..567d8bb643 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -73,7 +73,6 @@ "Read the operating-system declaration from FILE and return it." (load* file %user-module)) - ;;; ;;; Installation. @@ -751,6 +750,8 @@ Some ACTIONS support additional ARGS.\n")) (newline) (display (G_ "The valid values for ACTION are:\n")) (newline) + (display (G_ "\ + search search for existing service types\n")) (display (G_ "\ reconfigure switch to a new operating system configuration\n")) (display (G_ "\ @@ -937,6 +938,12 @@ resulting from command-line parsing." #:gc-root (assoc-ref opts 'gc-root))))) #:system system)))) +(define (resolve-subcommand name) + (let ((module (resolve-interface + `(guix scripts system ,(string->symbol name)))) + (proc (string->symbol (string-append "guix-system-" name)))) + (module-ref module proc))) + (define (process-command command args opts) "Process COMMAND, one of the 'guix system' sub-commands. ARGS is its argument list and OPTS is the option alist." @@ -949,6 +956,8 @@ argument list and OPTS is the option alist." ((pattern) pattern) (x (leave (G_ "wrong number of arguments~%")))))) (list-generations pattern))) + ((search) + (apply (resolve-subcommand "search") args)) ;; The following commands need to use the store, but they do not need an ;; operating system configuration file. ((switch-generation) @@ -978,7 +987,7 @@ argument list and OPTS is the option alist." (case action ((build container vm vm-image disk-image reconfigure init extension-graph shepherd-graph list-generations roll-back - switch-generation) + switch-generation search) (alist-cons 'action action result)) (else (leave (G_ "~a: unknown action~%") action)))))) diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm new file mode 100644 index 0000000000..b4f790c9bf --- /dev/null +++ b/guix/scripts/system/search.scm @@ -0,0 +1,144 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 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 scripts system search) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (gnu services) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (ice-9 regex) + #:use-module (ice-9 match) + #:export (service-type->recutils + find-service-types + guix-system-search)) + +;;; Commentary: +;;; +;;; Implement the 'guix system search' command, which searches among the +;;; available service types. +;;; +;;; Code: + +(define service-type-name* + (compose symbol->string service-type-name)) + +(define* (service-type->recutils type port + #:optional (width (%text-width)) + #:key (extra-fields '())) + "Write to PORT a recutils record of TYPE, arranging to fit within WIDTH +columns." + (define width* + ;; The available number of columns once we've taken into account space for + ;; the initial "+ " prefix. + (if (> width 2) (- width 2) width)) + + (define (extensions->recutils extensions) + (let ((list (string-join (map (compose service-type-name* + service-extension-target) + extensions)))) + (string->recutils + (fill-paragraph list width* + (string-length "extends: "))))) + + ;; Note: Don't i18n field names so that people can post-process it. + (format port "name: ~a~%" (service-type-name type)) + (format port "location: ~a~%" + (or (and=> (service-type-location type) location->string) + (G_ "unknown"))) + + (format port "extends: ~a~%" + (extensions->recutils (service-type-extensions type))) + + (when (service-type-description type) + (format port "~a~%" + (string->recutils + (string-trim-right + (parameterize ((%text-width width*)) + (texi->plain-text + (string-append "description: " + (or (and=> (service-type-description type) P_) + "")))) + #\newline)))) + + (for-each (match-lambda + ((field . value) + (let ((field (symbol->string field))) + (format port "~a: ~a~%" + field + (fill-paragraph (object->string value) width* + (string-length field)))))) + extra-fields) + (newline port)) + +(define (service-type-description-string type) + "Return the rendered and localised description of TYPE, a service type." + (and=> (service-type-description type) + (compose texi->plain-text P_))) + +(define %service-type-metrics + ;; Metrics used to estimate the relevance of a search result. + `((,service-type-name* . 3) + (,service-type-description-string . 2) + (,(lambda (type) + (match (and=> (service-type-location type) location-file) + ((? string? file) + (basename file ".scm")) + (#f + ""))) + . 1))) + +(define (find-service-types regexps) + "Return two values: the list of service types whose name or description +matches at least one of REGEXPS sorted by relevance, and the list of relevance +scores." + (let ((matches (fold-service-types + (lambda (type result) + (match (relevance type regexps + %service-type-metrics) + ((? zero?) + result) + (score + (cons (list type score) result)))) + '()))) + (unzip2 (sort matches + (lambda (m1 m2) + (match m1 + ((type1 score1) + (match m2 + ((type2 score2) + (if (= score1 score2) + (string>? (service-type-name* type1) + (service-type-name* type2)) + (> score1 score2))))))))))) + + +(define (guix-system-search . args) + (with-error-handling + (let ((regexps (map (cut make-regexp* <> regexp/icase) args))) + (leave-on-EPIPE + (let-values (((services scores) + (find-service-types regexps))) + (for-each (lambda (service score) + (service-type->recutils service + (current-output-port) + #:extra-fields + `((relevance . ,score)))) + services + scores)))))) diff --git a/guix/ui.scm b/guix/ui.scm index a51877c04d..6dfc8c7a5b 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -79,6 +79,7 @@ read/eval-package-expression location->string fill-paragraph + %text-width texi->plain-text package-description-string package-synopsis-string diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index b8e0aca877..e3f767cc67 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -19,6 +19,7 @@ guix/scripts/pull.scm guix/scripts/substitute.scm guix/scripts/authenticate.scm guix/scripts/system.scm +guix/scripts/system/search.scm guix/scripts/lint.scm guix/scripts/publish.scm guix/scripts/edit.scm diff --git a/tests/guix-system.sh b/tests/guix-system.sh index de6db0928c..d575795ea0 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2014, 2015, 2016 Ludovic Courtès +# Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès # # This file is part of GNU Guix. # @@ -215,3 +215,7 @@ EOF # In both cases 'my-torrc' should be properly resolved. guix system build "$tmpdir/config.scm" -n (cd "$tmpdir"; guix system build "config.scm" -n) + +# Searching. +guix system search tor | grep "^name: tor" +guix system search anonym network | grep "^name: tor" -- cgit 1.4.1 From 07c101e2215c43616c2bb28b1cb0743ecfdc7c87 Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Wed, 13 Sep 2017 14:37:39 +0200 Subject: build-system: Add 'meson-build-system'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Makefile.am (MODULES): Add 'guix/build-system/meson.scm' and 'guix/build/meson-build-system.scm'. * guix/build-system/meson.scm: New file. * guix/build/meson-build-system.scm: New file. * doc/guix.texi (Build Systems): Add 'meson-build-system'. Signed-off-by: Ludovic Courtès --- Makefile.am | 2 + doc/guix.texi | 55 ++++++++++++ guix/build-system/meson.scm | 178 ++++++++++++++++++++++++++++++++++++++ guix/build/meson-build-system.scm | 150 ++++++++++++++++++++++++++++++++ 4 files changed, 385 insertions(+) create mode 100644 guix/build-system/meson.scm create mode 100644 guix/build/meson-build-system.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index a2fb313916..e35bdac306 100644 --- a/Makefile.am +++ b/Makefile.am @@ -79,6 +79,7 @@ MODULES = \ guix/build-system/dub.scm \ guix/build-system/emacs.scm \ guix/build-system/font.scm \ + guix/build-system/meson.scm \ guix/build-system/minify.scm \ guix/build-system/asdf.scm \ guix/build-system/glib-or-gtk.scm \ @@ -106,6 +107,7 @@ MODULES = \ guix/build/cmake-build-system.scm \ guix/build/dub-build-system.scm \ guix/build/emacs-build-system.scm \ + guix/build/meson-build-system.scm \ guix/build/minify-build-system.scm \ guix/build/font-build-system.scm \ guix/build/asdf-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index ebeef50709..1356a357cc 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3811,6 +3811,61 @@ need to be copied into place. It copies font files to standard locations in the output directory. @end defvr +@defvr {Scheme Variable} meson-build-system +This variable is exported by @code{(guix build-system meson)}. It +implements the build procedure for packages that use +@url{http://mesonbuild.com, Meson} as their build system. + +It adds both Meson and @uref{https://ninja-build.org/, Ninja} to the set +of inputs, and they can be changed with the parameters @code{#:meson} +and @code{#:ninja} if needed. The default Meson is +@code{meson-for-build}, which is special because it doesn't clear the +@code{RUNPATH} of binaries and libraries when they are installed. + +This build system is an extension of @var{gnu-build-system}, but with the +following phases changed to some specific for Meson: + +@table @code + +@item configure +The phase runs @code{meson} with the flags specified in +@code{#:configure-flags}. The flag @code{--build-type} is always set to +@code{plain} unless something else is specified in @code{#:build-type}. + +@item build +The phase runs @code{ninja} to build the package in parallel by default, but +this can be changed with @code{#:parallel-build?}. + +@item check +The phase runs @code{ninja} with the target specified in @code{#:test-target}, +which is @code{"test"} by default. + +@item install +The phase runs @code{ninja install} and can not be changed. +@end table + +Apart from that, the build system also adds the following phases: + +@table @code + +@item fix-runpath +This phase tries to locate the local directories in the package being build, +which has libraries that some of the binaries need. If any are found, they will +be added to the programs @code{RUNPATH}. It is needed because +@code{meson-for-build} keeps the @code{RUNPATH} of binaries and libraries from +when they are build, but often that is not the @code{RUNPATH} we want. +Therefor it is also shrinked to the minimum needed by the program. + +@item glib-or-gtk-wrap +This phase is the phase provided by @code{glib-or-gtk-build-system}, and it +is not enabled by default. It can be enabled with @code{#:glib-or-gtk?}. + +@item glib-or-gtk-compile-schemas +This phase is the phase provided by @code{glib-or-gtk-build-system}, and it +is not enabled by default. It can be enabled with @code{#:glib-or-gtk?}. +@end table +@end defvr + Lastly, for packages that do not need anything as sophisticated, a ``trivial'' build system is provided. It is trivial in the sense that it provides basically no support: it does not pull any implicit inputs, diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm new file mode 100644 index 0000000000..d66ec760a4 --- /dev/null +++ b/guix/build-system/meson.scm @@ -0,0 +1,178 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Peter Mikkelsen +;;; +;;; 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 build-system meson) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (guix build-system glib-or-gtk) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:export (%meson-build-system-modules + meson-build-system)) + +;; Commentary: +;; +;; Standard build procedure for packages using Meson. This is implemented as an +;; extension of `gnu-build-system', with the option to turn on the glib/gtk +;; phases from `glib-or-gtk-build-system'. +;; +;; Code: + +(define %meson-build-system-modules + ;; Build-side modules imported by default. + `((guix build meson-build-system) + (guix build rpath) + ;; The modules from glib-or-gtk contains the modules from gnu-build-system, + ;; so there is no need to import that too. + ,@%glib-or-gtk-build-system-modules)) + +(define (default-ninja) + "Return the default ninja package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((module (resolve-interface '(gnu packages ninja)))) + (module-ref module 'ninja))) + +(define (default-meson) + "Return the default meson package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((module (resolve-interface '(gnu packages build-tools)))) + (module-ref module 'meson-for-build))) + +(define (default-patchelf) + "Return the default patchelf package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((module (resolve-interface '(gnu packages elf)))) + (module-ref module 'patchelf))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (meson (default-meson)) + (ninja (default-ninja)) + (glib-or-gtk #f) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + `(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target)) + + (and (not target) ;; TODO: add support for cross-compilation. + (bag + (name name) + (system system) + (build-inputs `(("meson" ,meson) + ("ninja" ,ninja) + ;; Add patchelf for (guix build rpath) to work. + ("patchelf" ,(default-patchelf)) + ,@native-inputs)) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (outputs outputs) + (build meson-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (meson-build store name inputs + #:key (guile #f) + (outputs '("out")) + (configure-flags ''()) + (search-paths '()) + (build-type "plain") + (tests? #t) + (test-target "test") + (glib-or-gtk? #f) + (parallel-build? #t) + (parallel-tests? #f) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (elf-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build meson-build-system) + %standard-phases)) + (system (%current-system)) + (imported-modules %meson-build-system-modules) + (modules '((guix build meson-build-system) + (guix build utils)))) + "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE +has a 'meson.build' file." + (define builder + `(let ((build-phases (if ,glib-or-gtk? + ,phases + (modify-phases ,phases + (delete 'glib-or-gtk-compile-schemas) + (delete 'glib-or-gtk-wrap))))) + (use-modules ,@modules) + (meson-build #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:system ,system + #:outputs %outputs + #:inputs %build-inputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:phases build-phases + #:configure-flags ,configure-flags + #:build-type ,build-type + #:tests? ,tests? + #:test-target ,test-target + #:parallel-build? ,parallel-build? + #:parallel-tests? ,parallel-tests? + #:validate-runpath? ,validate-runpath? + #:patch-shebangs? ,patch-shebangs? + #:strip-binaries? ,strip-binaries? + #:strip-flags ,strip-flags + #:strip-directories ,strip-directories + #:elf-directories ,elf-directories))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:system system + #:inputs inputs + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define meson-build-system + (build-system + (name 'meson) + (description "The standard Meson build system") + (lower lower))) + +;;; meson.scm ends here diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm new file mode 100644 index 0000000000..2b92240c52 --- /dev/null +++ b/guix/build/meson-build-system.scm @@ -0,0 +1,150 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Peter Mikkelsen +;;; +;;; 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 build meson-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:) + #:use-module (guix build utils) + #:use-module (guix build rpath) + #:use-module (guix build gremlin) + #:use-module (guix elf) + #:use-module (ice-9 match) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:export (%standard-phases + meson-build)) + +;; Commentary: +;; +;; Builder-side code of the standard meson build procedure. +;; +;; Code: + +(define* (configure #:key outputs configure-flags build-type + #:allow-other-keys) + "Configure the given package." + (let* ((out (assoc-ref outputs "out")) + (source-dir (getcwd)) + (build-dir "../build") + (prefix (assoc-ref outputs "out")) + (args `(,(string-append "--prefix=" prefix) + ,(string-append "--buildtype=" build-type) + ,@configure-flags + ,source-dir))) + (mkdir build-dir) + (chdir build-dir) + (zero? (apply system* "meson" args)))) + +(define* (build #:key parallel-build? + #:allow-other-keys) + "Build a given meson package." + (zero? (apply system* "ninja" + (if parallel-build? + `("-j" ,(number->string (parallel-job-count))) + '("-j" "1"))))) + +(define* (check #:key test-target parallel-tests? tests? + #:allow-other-keys) + (setenv "MESON_TESTTHREADS" + (if parallel-tests? + (number->string (parallel-job-count)) + "1")) + (if tests? + (zero? (system* "ninja" test-target)) + (begin + (format #t "test suite not run~%") + #t))) + +(define* (install #:rest args) + (zero? (system* "ninja" "install"))) + +(define* (fix-runpath #:key (elf-directories '("lib" "lib64" "libexec" + "bin" "sbin")) + outputs #:allow-other-keys) + "Try to make sure all ELF files in ELF-DIRECTORIES are able to find their +local dependencies in their RUNPATH, by searching for the needed libraries in +the directories of the package, and adding them to the RUNPATH if needed. +Also shrink the RUNPATH to what is needed, +since a lot of directories are left over from the build phase of meson, +for example libraries only needed for the tests." + + ;; Find the directories (if any) that contains DEP-NAME. The directories + ;; searched are the ones that ELF-FILES are in. + (define (find-deps dep-name elf-files) + (map dirname (filter (lambda (file) + (string=? dep-name (basename file))) + elf-files))) + + ;; Return a list of libraries that FILE needs. + (define (file-needed file) + (let* ((elf (call-with-input-file file + (compose parse-elf get-bytevector-all))) + (dyninfo (elf-dynamic-info elf))) + (if dyninfo + (elf-dynamic-info-needed dyninfo) + '()))) + + + ;; If FILE needs any libs that are part of ELF-FILES, the RUNPATH + ;; is modified accordingly. + (define (handle-file file elf-files) + (let* ((dep-dirs (concatenate (map (lambda (dep-name) + (find-deps dep-name elf-files)) + (file-needed file))))) + (unless (null? dep-dirs) + (augment-rpath file (string-join dep-dirs ":"))))) + + (define handle-output + (match-lambda + ((output . directory) + (let* ((elf-dirnames (map (lambda (subdir) + (string-append directory "/" subdir)) + elf-directories)) + (existing-elf-dirs (filter (lambda (dir) + (and (file-exists? dir) + (file-is-directory? dir))) + elf-dirnames)) + (elf-pred (lambda (name stat) + (elf-file? name))) + (elf-list (concatenate (map (lambda (dir) + (find-files dir elf-pred)) + existing-elf-dirs)))) + (for-each (lambda (elf-file) + (system* "patchelf" "--shrink-rpath" elf-file) + (handle-file elf-file elf-list)) + elf-list))))) + (for-each handle-output outputs) + #t) + +(define %standard-phases + ;; The standard-phases of glib-or-gtk contains a superset of the phases + ;; from the gnu-build-system. If the glib-or-gtk? key is #f (the default) + ;; then the extra phases will be removed again in (guix build-system meson). + (modify-phases glib-or-gtk:%standard-phases + (replace 'configure configure) + (replace 'build build) + (replace 'check check) + (replace 'install install) + (add-after 'strip 'fix-runpath fix-runpath))) + +(define* (meson-build #:key inputs phases + #:allow-other-keys #:rest args) + "Build the given package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; meson-build-system.scm ends here -- cgit 1.4.1 From c1d8b3b3b5af8282328b87dd7a8d09357cbb0af7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 25 Sep 2017 23:58:02 +0200 Subject: upstream: Add new GNOME updater. Partly fixes . Reported by Hartmut Goebel . * guix/import/gnome.scm: New file. * Makefile.am (MODULES): Add it. * guix/gnu-maintenance.scm (latest-gnome-release) (%gnome-updater): Remove. --- Makefile.am | 1 + guix/gnu-maintenance.scm | 54 ++--------------------- guix/import/gnome.scm | 112 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 116 insertions(+), 51 deletions(-) create mode 100644 guix/import/gnome.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index e35bdac306..2671065f68 100644 --- a/Makefile.am +++ b/Makefile.am @@ -151,6 +151,7 @@ MODULES = \ guix/import/hackage.scm \ guix/import/elpa.scm \ guix/import/texlive.scm \ + guix/import/gnome.scm \ guix/scripts.scm \ guix/scripts/download.scm \ guix/scripts/perform-download.scm \ diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index cd7ffeaefd..0de36f2f71 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -61,7 +61,6 @@ %gnu-updater %gnu-ftp-updater - %gnome-updater %kde-updater %xorg-updater %kernel.org-updater)) @@ -512,6 +511,9 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)." (values name+version #f) (values (match:substring match 1) (match:substring match 2))))) +(define gnome-package? + (url-prefix-predicate "mirror://gnome/")) + (define (pure-gnu-package? package) "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package. This excludes AucTeX, for instance, whose releases are now uploaded to @@ -525,49 +527,6 @@ releases are on gnu.org." (define gnu-hosted? (url-prefix-predicate "mirror://gnu/")) -(define gnome-package? - (url-prefix-predicate "mirror://gnome/")) - -(define (latest-gnome-release package) - "Return the latest release of PACKAGE, the name of a GNOME package." - (define %not-dot - (char-set-complement (char-set #\.))) - - (define (even-minor-version? version) - (match (string-tokenize version %not-dot) - (((= string->number major) (= string->number minor) . rest) - (and minor (even? minor))) - (_ - #t))) ;cross fingers - - (define (even-numbered? file) - ;; Return true if FILE somehow denotes an even-numbered file name. The - ;; trick here is that we want this to match both directories such as - ;; "3.18.6" and actual file names such as "gtk+-3.18.6.tar.bz2". - (let-values (((name version) (package-name->name+version file))) - (even-minor-version? (or version name)))) - - (define upstream-name - ;; Some packages like "NetworkManager" have camel-case names. - (package-upstream-name package)) - - (false-if-ftp-error - (latest-ftp-release upstream-name - #:server "ftp.gnome.org" - #:directory (string-append "/pub/gnome/sources/" - upstream-name) - - - ;; explains - ;; that odd minor version numbers represent development - ;; releases, which we are usually not interested in. - #:keep-file? even-numbered? - - ;; ftp.gnome.org provides no signatures, only - ;; checksums. - #:file->signature (const #f)))) - - (define (latest-kde-release package) "Return the latest release of PACKAGE, the name of an KDE.org package." (let ((uri (string->uri (origin-uri (package-source package))))) @@ -624,13 +583,6 @@ releases are on gnu.org." (pure-gnu-package? package)))) (latest latest-release*))) -(define %gnome-updater - (upstream-updater - (name 'gnome) - (description "Updater for GNOME packages") - (pred gnome-package?) - (latest latest-gnome-release))) - (define %kde-updater (upstream-updater (name 'kde) diff --git a/guix/import/gnome.scm b/guix/import/gnome.scm new file mode 100644 index 0000000000..1ade63e1af --- /dev/null +++ b/guix/import/gnome.scm @@ -0,0 +1,112 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 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 import gnome) + #:use-module (guix upstream) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix http-client) + #:use-module (json) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-34) + #:use-module (web uri) + #:use-module (ice-9 match) + #:export (%gnome-updater)) + +;;; Commentary: +;;; +;;; This package provides not an actual importer but simply an updater for +;;; GNOME packages. It grabs package meta-data from 'cache.json' files +;;; available on ftp.gnome.org. +;;; +;;; Code: + +(define (jsonish->upstream-source name jsonish) + "Return an object for package NAME, using JSONISH as the +source for metadata." + (match jsonish + ((version . dictionary) + (upstream-source + (package name) + (version version) + (urls (filter-map (lambda (extension) + (match (hash-ref dictionary extension) + (#f + #f) + ((? string? relative-url) + (string-append "mirror://gnome/sources/" + name "/" relative-url)))) + '("tar.lz" "tar.xz" "tar.bz2" "tar.gz"))))))) + +(define (latest-gnome-release package) + "Return the latest release of PACKAGE, a GNOME package, or #f if it could +not be determined." + (define %not-dot + (char-set-complement (char-set #\.))) + + (define (even-minor-version? version) + (match (string-tokenize version %not-dot) + (((= string->number major) (= string->number minor) . rest) + (and minor (even? minor))) + (_ + #t))) ;cross fingers + + (define upstream-name + ;; Some packages like "NetworkManager" have camel-case names. + (package-upstream-name package)) + + (guard (c ((http-get-error? c) + (if (= 404 (http-get-error-code c)) + #f + (raise c)))) + (let* ((port (http-fetch/cached + (string->uri (string-append + "https://ftp.gnome.org/pub/gnome/sources/" + upstream-name "/cache.json")) + + ;; ftp.gnome.org supports 'if-Modified-Since', so the local + ;; cache can expire early. + #:ttl (* 60 10))) + (json (json->scm port))) + (close-port port) + (match json + ((4 (? hash-table? releases) _ ...) + (let* ((releases (hash-ref releases upstream-name)) + (latest (hash-fold (lambda (key value result) + (cond ((even-minor-version? key) + (match result + (#f + (cons key value)) + ((newest . _) + (if (version>? key newest) + (cons key value) + result)))) + (else + result))) + #f + releases))) + (and latest + (jsonish->upstream-source upstream-name latest)))))))) + +(define %gnome-updater + (upstream-updater + (name 'gnome) + (description "Updater for GNOME packages") + (pred (url-prefix-predicate "mirror://gnome/")) + (latest latest-gnome-release))) -- cgit 1.4.1 From a95ddf0d0747bd3742a682fcce39a86c181e6312 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 26 Sep 2017 09:29:00 +0200 Subject: build: Build (guix import gnome) only when we have Guile-JSON. * Makefile.am (MODULES): Move guix/import/gnome.scm under "if HAVE_GUILE_JSON". --- Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 2671065f68..a178d53cb5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -151,7 +151,6 @@ MODULES = \ guix/import/hackage.scm \ guix/import/elpa.scm \ guix/import/texlive.scm \ - guix/import/gnome.scm \ guix/scripts.scm \ guix/scripts/download.scm \ guix/scripts/perform-download.scm \ @@ -195,6 +194,7 @@ MODULES += \ guix/import/crate.scm \ guix/import/gem.scm \ guix/import/github.scm \ + guix/import/gnome.scm \ guix/import/json.scm \ guix/import/pypi.scm \ guix/import/stackage.scm \ -- cgit 1.4.1 From 68a91a183b29c62232fb048bb27e10b6ff2e39dd Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 27 Aug 2017 17:21:39 +0200 Subject: import: Add package->code. * guix/import/print.scm: New file. * tests/print.scm: New file. * Makefile.am (SCM_TESTS): Add new test file. (MODULES): Add print.scm. --- Makefile.am | 2 + guix/import/print.scm | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/print.scm | 64 ++++++++++++++++++++ 3 files changed, 230 insertions(+) create mode 100644 guix/import/print.scm create mode 100644 tests/print.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index a178d53cb5..e16f15acef 100644 --- a/Makefile.am +++ b/Makefile.am @@ -143,6 +143,7 @@ MODULES = \ guix/build/make-bootstrap.scm \ guix/search-paths.scm \ guix/packages.scm \ + guix/import/print.scm \ guix/import/utils.scm \ guix/import/gnu.scm \ guix/import/snix.scm \ @@ -275,6 +276,7 @@ SCM_TESTS = \ tests/hash.scm \ tests/pk-crypto.scm \ tests/pki.scm \ + tests/print.scm \ tests/sets.scm \ tests/modules.scm \ tests/gnu-maintenance.scm \ diff --git a/guix/import/print.scm b/guix/import/print.scm new file mode 100644 index 0000000000..0bec32c8dc --- /dev/null +++ b/guix/import/print.scm @@ -0,0 +1,164 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 import print) + #:use-module (guix base32) + #:use-module (guix utils) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (gnu packages) + #:use-module (srfi srfi-1) + #:use-module (guix import utils) + #:use-module (ice-9 control) + #:use-module (ice-9 match) + #:export (package->code)) + +;; FIXME: the quasiquoted arguments field may contain embedded package +;; objects, e.g. in #:disallowed-references; they will just be printed with +;; their usual # representation, not as variable names. +(define (package->code package) + "Return an S-expression representing the source code that produces PACKAGE +when evaluated." + ;; The module in which the package PKG is defined + (define (package-module-name pkg) + (map string->symbol + (string-split (string-drop-right + (location-file (package-location pkg)) 4) + #\/))) + + ;; Return the first candidate variable name that is bound to VAL. + (define (variable-name val mod) + (match (let/ec return + (module-for-each (lambda (sym var) + (if (eq? val (variable-ref var)) + (return sym) + #f)) + (resolve-interface mod))) + ((? symbol? sym) sym) + (_ #f))) + + ;; Print either license variable name or the code for a license object + (define (license->code lic) + (let ((var (variable-name lic '(guix licenses)))) + (or var + `(license + (name ,(license-name lic)) + (uri ,(license-uri lic)) + (comment ,(license-comment lic)))))) + + (define (search-path-specification->code spec) + `(search-path-specification + (variable ,(search-path-specification-variable spec)) + (files (list ,@(search-path-specification-files spec))) + (separator ,(search-path-specification-separator spec)) + (file-type (quote ,(search-path-specification-file-type spec))) + (file-pattern ,(search-path-specification-file-pattern spec)))) + + (define (source->code source version) + (let ((uri (origin-uri source)) + (method (origin-method source)) + (sha256 (origin-sha256 source)) + (file-name (origin-file-name source)) + (patches (origin-patches source))) + `(origin + (method ,(procedure-name method)) + (uri (string-append ,@(factorize-uri uri version))) + (sha256 + (base32 + ,(format #f "~a" (bytevector->nix-base32-string sha256)))) + ;; FIXME: in order to be able to throw away the directory prefix, + ;; we just assume that the patch files can be found with + ;; "search-patches". + ,@(if (null? patches) '() + `((patches (search-patches ,@(map basename patches)))))))) + + (define (package-lists->code lsts) + (list 'quasiquote + (map (match-lambda + ((label pkg . out) + (let ((mod (package-module-name pkg))) + (list label + ;; FIXME: using '@ certainly isn't pretty, but it + ;; avoids having to import the individual package + ;; modules. + (list 'unquote + (list '@ mod (variable-name pkg mod))))))) + lsts))) + + (let ((name (package-name package)) + (version (package-version package)) + (source (package-source package)) + (build-system (package-build-system package)) + (arguments (package-arguments package)) + (inputs (package-inputs package)) + (propagated-inputs (package-propagated-inputs package)) + (native-inputs (package-native-inputs package)) + (outputs (package-outputs package)) + (native-search-paths (package-native-search-paths package)) + (search-paths (package-search-paths package)) + (replacement (package-replacement package)) + (synopsis (package-synopsis package)) + (description (package-description package)) + (license (package-license package)) + (home-page (package-home-page package)) + (supported-systems (package-supported-systems package)) + (properties (package-properties package))) + `(package + (name ,name) + (version ,version) + (source ,(source->code source version)) + ,@(match properties + (() '()) + (_ `((properties ,properties)))) + ,@(if replacement + `((replacement ,replacement)) + '()) + (build-system ,(symbol-append (build-system-name build-system) + '-build-system)) + ,@(match arguments + (() '()) + (args `((arguments ,(list 'quasiquote args))))) + ,@(match outputs + (("out") '()) + (outs `((outputs (list ,@outs))))) + ,@(match native-inputs + (() '()) + (pkgs `((native-inputs ,(package-lists->code pkgs))))) + ,@(match inputs + (() '()) + (pkgs `((inputs ,(package-lists->code pkgs))))) + ,@(match propagated-inputs + (() '()) + (pkgs `((propagated-inputs ,(package-lists->code pkgs))))) + ,@(if (lset= string=? supported-systems %supported-systems) + '() + `((supported-systems (list ,@supported-systems)))) + ,@(match (map search-path-specification->code native-search-paths) + (() '()) + (paths `((native-search-paths (list ,@paths))))) + ,@(match (map search-path-specification->code search-paths) + (() '()) + (paths `((search-paths (list ,@paths))))) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,description) + (license ,(if (list? license) + `(list ,@(map license->code license)) + (license->code license)))))) diff --git a/tests/print.scm b/tests/print.scm new file mode 100644 index 0000000000..305807c1d1 --- /dev/null +++ b/tests/print.scm @@ -0,0 +1,64 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 (test-print) + #:use-module (guix import print) + #:use-module (guix build-system gnu) + #:use-module (guix download) + #:use-module (guix packages) + #:use-module (guix licenses) + #:use-module (srfi srfi-64)) + +(test-begin "print") + +(define pkg + (package + (name "test") + (version "1.2.3") + (source (origin + (method url-fetch) + (uri (string-append "file:///tmp/test-" + version ".tar.gz")) + (sha256 + (base32 + "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) + (build-system gnu-build-system) + (home-page "http://gnu.org") + (synopsis "Dummy") + (description "This is a dummy package.") + (license gpl3+))) + +(test-equal "simple package" + (package->code pkg) + '(package + (name "test") + (version "1.2.3") + (source (origin + (method url-fetch) + (uri (string-append "file:///tmp/test-" + version ".tar.gz")) + (sha256 + (base32 + "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) + (build-system gnu-build-system) + (home-page "http://gnu.org") + (synopsis "Dummy") + (description "This is a dummy package.") + (license gpl3+))) + +(test-end "print") -- cgit 1.4.1 From fb1db385476bc4548d3eadea93b5dd6a346839f2 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 27 Aug 2017 17:41:18 +0200 Subject: import: Add JSON importer. * doc/guix.texi (Invoking guix import): Document it. * guix/scripts/import/json.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/import.scm (importers): Add json importer. --- Makefile.am | 1 + doc/guix.texi | 50 +++++++++++++++++++++ guix/scripts/build.scm | 18 +++++++- guix/scripts/import.scm | 2 +- guix/scripts/import/json.scm | 102 +++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 171 insertions(+), 2 deletions(-) create mode 100644 guix/scripts/import/json.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index e16f15acef..1f014b7c01 100644 --- a/Makefile.am +++ b/Makefile.am @@ -174,6 +174,7 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ + guix/scripts/import/json.scm \ guix/scripts/import/elpa.scm \ guix/scripts/import/texlive.scm \ guix/scripts/environment.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 5a32476bd3..dd0a46a638 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5899,6 +5899,56 @@ CTAN while fetching the sources from the directory guix import texlive --archive=generic ifxetex @end example +@item json +@cindex JSON, import +Import package metadata from a local JSON file@footnote{This +functionality requires Guile-JSON to be installed. +@xref{Requirements}.}. Consider the following example package +definition in JSON format: + +@example +@{ + "name": "hello", + "version": "2.10", + "source": "mirror://gnu/hello/hello-2.10.tar.gz", + "build-system": "gnu", + "home-page": "https://www.gnu.org/software/hello/", + "synopsis": "Hello, GNU world: An example GNU package", + "description": "GNU Hello prints a greeting.", + "license": "GPL-3.0+", + "native-inputs": ["gcc@@6"] +@} +@end example + +The field names are the same as for the @code{} record +(@xref{Defining Packages}). References to other packages are provided +as JSON lists of quoted package specification strings such as +@code{guile} or @code{guile@@2.0}. + +The importer also supports a more explicit source definition using the +common fields for @code{} records: + +@example +@{ + @dots{} + "source": @{ + "method": "url-fetch", + "uri": "mirror://gnu/hello/hello-2.10.tar.gz", + "sha256": @{ + "base32": "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i" + @} + @} + @dots{} +@} +@end example + +The command below reads metadata from the JSON file @code{hello.json} +and outputs a package expression: + +@example +guix import json hello.json +@end example + @item nix Import metadata from a local copy of the source of the @uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 0571b874f1..3cc679c70a 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver +;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,9 +32,11 @@ #:use-module (guix monads) #:use-module (guix gexp) + #:autoload (json) (json-string->scm) #:autoload (guix http-client) (http-fetch http-get-error?) #:use-module (ice-9 format) #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -55,6 +58,10 @@ register-root register-root*)) +;; Lazy reference to import utils to avoid cycle +(define (lazy-util sym) + (module-ref (resolve-interface '(guix import utils)) sym)) + (define %default-log-urls ;; Default base URLs for build logs. '("http://hydra.gnu.org/log")) @@ -606,7 +613,16 @@ build---packages, gexps, derivations, and so on." (else (list (specification->package spec))))) (('file . file) - (ensure-list (load* file (make-user-module '())))) + (if (string-suffix? ".json" file) + (begin + ;; Load (json) lazily to avoid hard dependency. + ;; TODO: doesn't work + (let* ((json (json-string->scm + (with-input-from-file file read-string))) + (pkg ((lazy-util 'data->guix-package) + ((lazy-util 'hash-table->alist) json)))) + (ensure-list pkg))) + (ensure-list (load* file (make-user-module '()))))) (('expression . str) (ensure-list (read/eval str))) (('argument . (? derivation? drv)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 9bba074e8c..67bc7a7553 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -74,7 +74,7 @@ rather than \\n." ;;; (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" - "cran" "crate" "texlive")) + "cran" "crate" "texlive" "json")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/json.scm b/guix/scripts/import/json.scm new file mode 100644 index 0000000000..8771e7b0eb --- /dev/null +++ b/guix/scripts/import/json.scm @@ -0,0 +1,102 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier +;;; Copyright © 2015, 2017 Ricardo Wurmus +;;; +;;; 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 import json) + #:use-module (json) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import utils) + #:use-module (guix import print) + #:use-module (guix scripts import) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 format) + #:export (guix-import-json)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import json PACKAGE-FILE +Import and convert the JSON package definition in PACKAGE-FILE.\n")) + (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 + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import json"))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-json . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((file-name) + (catch 'json-invalid + (lambda () + (let ((json (json-string->scm + (with-input-from-file file-name read-string)))) + ;; TODO: also print define-module boilerplate + (package->code (alist->package (hash-table->alist json))))) + (lambda _ + (leave (G_ "invalid JSON in file '~a'~%") file-name)))) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) -- cgit 1.4.1 From 454caca8e6db34d7777ddb4ba84680d41e381b32 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 27 Sep 2017 22:44:56 +0200 Subject: cuirass: Add 'cuirass-jobs.scm' target to compute the Cuirass jobs. * build-aux/hydra/evaluate.scm: Support "cuirass" command line option. * Makefile.am (cuirass-jobs.scm): New target. --- Makefile.am | 10 ++++++++++ build-aux/hydra/evaluate.scm | 13 +++++++++---- 2 files changed, 19 insertions(+), 4 deletions(-) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 1f014b7c01..d054f78791 100644 --- a/Makefile.am +++ b/Makefile.am @@ -7,6 +7,7 @@ # Copyright © 2017 Mathieu Othacehe # Copyright © 2017 Leo Famulari # Copyright © 2017 Ricardo Wurmus +# Copyright © 2017 Jan Nieuwenhuizen # # This file is part of GNU Guix. # @@ -711,6 +712,15 @@ hydra-jobs.scm: $(GOBJECTS) "$(top_srcdir)/build-aux/hydra/gnu-system.scm" > "$@.tmp" $(AM_V_at)mv "$@.tmp" "$@" +# Compute the Cuirass jobs and write them in the target file. +cuirass-jobs.scm: $(GOBJECTS) + $(AM_V_at)$(MKDIR_P) "`dirname "$@"`" + $(AM_V_GEN)$(top_builddir)/pre-inst-env "$(GUILE)" \ + "$(top_srcdir)/build-aux/hydra/evaluate.scm" \ + "$(top_srcdir)/build-aux/cuirass/gnu-system.scm" \ + cuirass > "$@.tmp" + $(AM_V_at)mv "$@.tmp" "$@" + .PHONY: gen-ChangeLog gen-AUTHORS gen-tarball-version .PHONY: assert-no-store-file-names assert-binaries-available .PHONY: assert-final-inputs-self-contained diff --git a/build-aux/hydra/evaluate.scm b/build-aux/hydra/evaluate.scm index cc6a4b9492..604022abcf 100644 --- a/build-aux/hydra/evaluate.scm +++ b/build-aux/hydra/evaluate.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2017 Jan Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -70,7 +71,7 @@ Otherwise return THING." ;; Without further ado... (match (command-line) - ((command file) + ((command file cuirass? ...) ;; Load FILE, a Scheme file that defines Hydra jobs. (let ((port (current-output-port))) (save-module-excursion @@ -96,7 +97,11 @@ Otherwise return THING." ;; Call the entry point of FILE and print the resulting job sexp. (pretty-print - (match ((module-ref %user-module 'hydra-jobs) store '()) + (match ((module-ref %user-module + (if (equal? cuirass? "cuirass") + 'cuirass-jobs + 'hydra-jobs)) + store '()) (((names . thunks) ...) (map (lambda (job thunk) (format (current-error-port) "evaluating '~a'... " job) @@ -107,8 +112,8 @@ Otherwise return THING." names thunks))) port)))) ((command _ ...) - (format (current-error-port) "Usage: ~a FILE -Evaluate the Hydra jobs defined in FILE.~%" + (format (current-error-port) "Usage: ~a FILE [cuirass] +Evaluate the Hydra or Cuirass jobs defined in FILE.~%" command) (exit 1))) -- cgit 1.4.1