From 1dbb9302c204c33d2d3b306065419d48596fe5cd Mon Sep 17 00:00:00 2001 From: Vagrant Cascadian Date: Mon, 18 Mar 2019 03:24:05 +0000 Subject: gnu: Add linux-libre-arm-veyron. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/linux (linux-libre-arm-veyron): New variable. (kernel-config-veyron): function to find veyron config. * gnu/packages/aux-files/linux-libre/5.0-arm-veyron.conf: New file. * Makefile.am (AUX_FILES): Adjust accordingly. Signed-off-by: Ludovic Courtès --- Makefile.am | 1 + 1 file changed, 1 insertion(+) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 4902f3afe7..a76c862563 100644 --- a/Makefile.am +++ b/Makefile.am @@ -292,6 +292,7 @@ AUX_FILES = \ gnu/packages/aux-files/linux-libre/5.0-i686.conf \ gnu/packages/aux-files/linux-libre/5.0-x86_64.conf \ gnu/packages/aux-files/linux-libre/4.19-arm.conf \ + gnu/packages/aux-files/linux-libre/5.0-arm-veyron.conf \ gnu/packages/aux-files/linux-libre/4.19-arm64.conf \ gnu/packages/aux-files/linux-libre/4.19-i686.conf \ gnu/packages/aux-files/linux-libre/4.19-x86_64.conf \ -- cgit v1.2.3 From df2a96167fd97b1b2013813127e44b0bd5ca7469 Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Mon, 4 Mar 2019 09:52:49 -0500 Subject: gnu: Add example system configuration for asus-c201. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/system/examples/asus-c201.tmpl: New file. * Makefile.am (EXAMPLES): Add it. Signed-off-by: Ludovic Courtès --- Makefile.am | 1 + gnu/system/examples/asus-c201.tmpl | 60 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+) create mode 100644 gnu/system/examples/asus-c201.tmpl (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index a76c862563..c331da7267 100644 --- a/Makefile.am +++ b/Makefile.am @@ -307,6 +307,7 @@ AUX_FILES = \ # Templates, examples. EXAMPLES = \ + gnu/system/examples/asus-c201.tmpl \ gnu/system/examples/bare-bones.tmpl \ gnu/system/examples/beaglebone-black.tmpl \ gnu/system/examples/desktop.tmpl \ diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl new file mode 100644 index 0000000000..098958f4a2 --- /dev/null +++ b/gnu/system/examples/asus-c201.tmpl @@ -0,0 +1,60 @@ +;; This is an operating system configuration template +;; for a "bare bones" setup for an ASUS C201PA. + +(use-modules (gnu) (gnu bootloader depthcharge)) +(use-service-modules networking ssh) +(use-package-modules linux screen) + +(operating-system + (host-name "komputilo") + (timezone "Europe/Berlin") + (locale "en_US.utf8") + + ;; Assuming /dev/mmcblk0p1 is the kernel partition, and + ;; "my-root" is the label of the target root file system. + (bootloader (bootloader-configuration + (bootloader depthcharge-bootloader) + (target "/dev/mmcblk0p1"))) + + ;; The ASUS C201PA requires a very particular kernel to boot, + ;; as well as the following arguments. + (kernel linux-libre-arm-veyron) + (kernel-arguments '("console=tty1")) + + ;; We do not need any special modules for initrd, and the + ;; PrawnOS kernel does not include many of the normal ones. + (initrd-modules '()) + + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + + ;; This is where user accounts are specified. The "root" + ;; account is implicit, and is initially created with the + ;; empty password. + (users (cons (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + + ;; Adding the account to the "wheel" group + ;; makes it a sudoer. Adding it to "audio" + ;; and "video" allows the user to play sound + ;; and access the webcam. + (supplementary-groups '("wheel" + "audio" "video")) + (home-directory "/home/alice")) + %base-user-accounts)) + + ;; Globally-installed packages. + (packages (cons screen %base-packages)) + + ;; Add services to the baseline: a DHCP client and + ;; an SSH server. + (services (append (list (service dhcp-client-service-type) + (service openssh-service-type + (openssh-configuration + (port-number 2222)))) + %base-services))) -- cgit v1.2.3 From 5d9f9ad63191646a22dc80624227aa413a4894f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 9 Apr 2019 22:39:26 +0200 Subject: Add (guix colors). * guix/colors.scm: New file. * Makefile.am (MODULES): Add it. * guix/ui.scm (color-table, color, colorize-string): Remove. * guix/status.scm (isatty?*, color-output? color-rules): Remove. --- Makefile.am | 1 + guix/colors.scm | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ guix/status.scm | 44 +------------------ guix/ui.scm | 55 +----------------------- 4 files changed, 132 insertions(+), 97 deletions(-) create mode 100644 guix/colors.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index c331da7267..87682b4949 100644 --- a/Makefile.am +++ b/Makefile.am @@ -138,6 +138,7 @@ MODULES = \ guix/store.scm \ guix/cvs-download.scm \ guix/svn-download.scm \ + guix/colors.scm \ guix/i18n.scm \ guix/ui.scm \ guix/status.scm \ diff --git a/guix/colors.scm b/guix/colors.scm new file mode 100644 index 0000000000..fad0bd2ab9 --- /dev/null +++ b/guix/colors.scm @@ -0,0 +1,129 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Free Software Foundation, Inc. +;;; Copyright © 2018 Sahithi Yarlagadda +;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2017, 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 colors) + #:use-module (guix memoization) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:export (colorize-string + color-rules + color-output? + isatty?*)) + +;;; Commentary: +;;; +;;; This module provides tools to produce colored output using ANSI escapes. +;;; +;;; Code: + +(define color-table + `((CLEAR . "0") + (RESET . "0") + (BOLD . "1") + (DARK . "2") + (UNDERLINE . "4") + (UNDERSCORE . "4") + (BLINK . "5") + (REVERSE . "6") + (CONCEALED . "8") + (BLACK . "30") + (RED . "31") + (GREEN . "32") + (YELLOW . "33") + (BLUE . "34") + (MAGENTA . "35") + (CYAN . "36") + (WHITE . "37") + (ON-BLACK . "40") + (ON-RED . "41") + (ON-GREEN . "42") + (ON-YELLOW . "43") + (ON-BLUE . "44") + (ON-MAGENTA . "45") + (ON-CYAN . "46") + (ON-WHITE . "47"))) + +(define (color . lst) + "Return a string containing the ANSI escape sequence for producing the +requested set of attributes in LST. Unknown attributes are ignored." + (let ((color-list + (remove not + (map (lambda (color) (assq-ref color-table color)) + lst)))) + (if (null? color-list) + "" + (string-append + (string #\esc #\[) + (string-join color-list ";" 'infix) + "m")))) + +(define (colorize-string str . color-list) + "Return a copy of STR colorized using ANSI escape sequences according to the +attributes STR. At the end of the returned string, the color attributes will +be reset such that subsequent output will not have any colors in effect." + (string-append + (apply color color-list) + str + (color 'RESET))) + +(define isatty?* + (mlambdaq (port) + "Return true if PORT is a tty. Memoize the result." + (isatty? port))) + +(define (color-output? port) + "Return true if we should write colored output to PORT." + (and (not (getenv "INSIDE_EMACS")) + (not (getenv "NO_COLOR")) + (isatty?* port))) + +(define-syntax color-rules + (syntax-rules () + "Return a procedure that colorizes the string it is passed according to +the given rules. Each rule has the form: + + (REGEXP COLOR1 COLOR2 ...) + +where COLOR1 specifies how to colorize the first submatch of REGEXP, and so +on." + ((_ (regexp colors ...) rest ...) + (let ((next (color-rules rest ...)) + (rx (make-regexp regexp))) + (lambda (str) + (if (string-index str #\nul) + str + (match (regexp-exec rx str) + (#f (next str)) + (m (let loop ((n 1) + (c '(colors ...)) + (result '())) + (match c + (() + (string-concatenate-reverse result)) + ((first . tail) + (loop (+ n 1) tail + (cons (colorize-string (match:substring m n) + first) + result))))))))))) + ((_) + (lambda (str) + str)))) diff --git a/guix/status.scm b/guix/status.scm index bddaa003db..7edb558ee7 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -20,7 +20,7 @@ (define-module (guix status) #:use-module (guix records) #:use-module (guix i18n) - #:use-module ((guix ui) #:select (colorize-string)) + #:use-module (guix colors) #:use-module (guix progress) #:autoload (guix build syscalls) (terminal-columns) #:use-module ((guix build download) @@ -339,10 +339,6 @@ build-log\" traces." (and (current-store-protocol-version) (>= (current-store-protocol-version) #x163))) -(define isatty?* - (mlambdaq (port) - (isatty? port))) - (define spin! (let ((steps (circular-list "\\" "|" "/" "-"))) (lambda (phase port) @@ -362,44 +358,6 @@ the current build phase." (format port (G_ "'~a' phase") phase)) (force-output port))))))) -(define (color-output? port) - "Return true if we should write colored output to PORT." - (and (not (getenv "INSIDE_EMACS")) - (not (getenv "NO_COLOR")) - (isatty?* port))) - -(define-syntax color-rules - (syntax-rules () - "Return a procedure that colorizes the string it is passed according to -the given rules. Each rule has the form: - - (REGEXP COLOR1 COLOR2 ...) - -where COLOR1 specifies how to colorize the first submatch of REGEXP, and so -on." - ((_ (regexp colors ...) rest ...) - (let ((next (color-rules rest ...)) - (rx (make-regexp regexp))) - (lambda (str) - (if (string-index str #\nul) - str - (match (regexp-exec rx str) - (#f (next str)) - (m (let loop ((n 1) - (c '(colors ...)) - (result '())) - (match c - (() - (string-concatenate-reverse result)) - ((first . tail) - (loop (+ n 1) tail - (cons (colorize-string (match:substring m n) - first) - result))))))))))) - ((_) - (lambda (str) - str)))) - (define colorize-log-line ;; Take a string and return a possibly colorized string according to the ;; rules below. diff --git a/guix/ui.scm b/guix/ui.scm index 0070301c47..c2807b711f 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -10,8 +10,6 @@ ;;; Copyright © 2016 Roel Janssen ;;; Copyright © 2016 Benz Schenk ;;; Copyright © 2018 Kyle Meyer -;;; Copyright © 2013, 2014 Free Software Foundation, Inc. -;;; Copyright © 2018 Sahithi Yarlagadda ;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -118,8 +116,7 @@ guix-warning-port warning info - guix-main - colorize-string)) + guix-main)) ;;; Commentary: ;;; @@ -1703,54 +1700,4 @@ and signal handling has already been set up." (initialize-guix) (apply run-guix args)) -(define color-table - `((CLEAR . "0") - (RESET . "0") - (BOLD . "1") - (DARK . "2") - (UNDERLINE . "4") - (UNDERSCORE . "4") - (BLINK . "5") - (REVERSE . "6") - (CONCEALED . "8") - (BLACK . "30") - (RED . "31") - (GREEN . "32") - (YELLOW . "33") - (BLUE . "34") - (MAGENTA . "35") - (CYAN . "36") - (WHITE . "37") - (ON-BLACK . "40") - (ON-RED . "41") - (ON-GREEN . "42") - (ON-YELLOW . "43") - (ON-BLUE . "44") - (ON-MAGENTA . "45") - (ON-CYAN . "46") - (ON-WHITE . "47"))) - -(define (color . lst) - "Return a string containing the ANSI escape sequence for producing the -requested set of attributes in LST. Unknown attributes are ignored." - (let ((color-list - (remove not - (map (lambda (color) (assq-ref color-table color)) - lst)))) - (if (null? color-list) - "" - (string-append - (string #\esc #\[) - (string-join color-list ";" 'infix) - "m")))) - -(define (colorize-string str . color-list) - "Return a copy of STR colorized using ANSI escape sequences according to the -attributes STR. At the end of the returned string, the color attributes will -be reset such that subsequent output will not have any colors in effect." - (string-append - (apply color color-list) - str - (color 'RESET))) - ;;; ui.scm ends here -- cgit v1.2.3 From 72eda0624be89ed18302fd7d7f22976071ab020c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 6 Apr 2019 22:27:57 +0200 Subject: Add (guix store roots). * guix/store/roots.scm, tests/store-roots.scm: New files. * Makefile.am (STORE_MODULES): Add guix/store/roots.scm. (SCM_TESTS): Add tests/store-roots.scm. --- Makefile.am | 6 ++- guix/store/roots.scm | 120 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/store-roots.scm | 53 ++++++++++++++++++++++ 3 files changed, 177 insertions(+), 2 deletions(-) create mode 100644 guix/store/roots.scm create mode 100644 tests/store-roots.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 87682b4949..704f2451c3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -277,7 +277,8 @@ endif BUILD_DAEMON_OFFLOAD # Scheme implementation of the build daemon and related functionality. STORE_MODULES = \ guix/store/database.scm \ - guix/store/deduplication.scm + guix/store/deduplication.scm \ + guix/store/roots.scm MODULES += $(STORE_MODULES) @@ -408,7 +409,8 @@ SCM_TESTS = \ tests/pypi.scm \ tests/import-utils.scm \ tests/store-database.scm \ - tests/store-deduplication.scm + tests/store-deduplication.scm \ + tests/store-roots.scm SH_TESTS = \ tests/guix-build.sh \ diff --git a/guix/store/roots.scm b/guix/store/roots.scm new file mode 100644 index 0000000000..4f23ae34e8 --- /dev/null +++ b/guix/store/roots.scm @@ -0,0 +1,120 @@ +;;; 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 store roots) + #:use-module (guix config) + #:use-module ((guix store) #:select (store-path? %gc-roots-directory)) + #:use-module (guix sets) + #:use-module (guix build syscalls) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:re-export (%gc-roots-directory) + #:export (gc-roots + user-owned?)) + +;;; Commentary: +;;; +;;; This module provides tools to list and access garbage collector roots ("GC +;;; roots"). +;;; +;;; Code: + +(define %profile-directory + ;; Directory where user profiles are stored. + ;; XXX: This is redundant with the definition in (guix profiles) and not + ;; entirely needed since in practice /var/guix/gcroots/profiles links to + ;; it. + (string-append %state-directory "/profiles")) + +(define (gc-roots) + "Return the list of garbage collector roots (\"GC roots\"). This includes +\"regular\" roots fount in %GC-ROOTS-DIRECTORY as well as indirect roots that +are user-controlled symlinks stored anywhere on the file system." + (define (regular? file) + (match file + (((or "." "..") . _) #f) + (_ #t))) + + (define (file-type=? type) + (match-lambda + ((file . properties) + (match (assq-ref properties 'type) + ('unknown + (let ((stat (lstat file))) + (eq? type (stat:type stat)))) + (actual-type + (eq? type actual-type)))))) + + (define directory? + (file-type=? 'directory)) + + (define symlink? + (file-type=? 'symlink)) + + (define canonical-root + (match-lambda + ((file . properties) + (let ((target (readlink file))) + (cond ((store-path? target) + ;; Regular root: FILE points to the store. + file) + + ;; Indirect root: FILE points to a user-controlled file outside + ;; the store. + ((string-prefix? "/" target) + target) + (else + (string-append (dirname file) "/" target))))))) + + (let loop ((directories (list %gc-roots-directory + %profile-directory)) + (roots '()) + (visited (set))) + (match directories + (() + roots) + ((directory . rest) + (if (set-contains? visited directory) + (loop rest roots visited) + (let*-values (((scope) + (cut string-append directory "/" <>)) + ((sub-directories files) + (partition directory? + (map (match-lambda + ((file . properties) + (cons (scope file) properties))) + (scandir* directory regular?))))) + (loop (append rest (map first sub-directories)) + (append (map canonical-root (filter symlink? files)) + roots) + (set-insert directory visited)))))))) + +(define* (user-owned? root #:optional (uid (getuid))) + "Return true if ROOT exists and is owned by UID, false otherwise." + ;; If ROOT is an indirect root, then perhaps it no longer exists. Thus, + ;; catch 'system-error' exceptions. + (catch 'system-error + (lambda () + (define stat + (lstat root)) + + (= (stat:uid stat) uid)) + (const #f))) diff --git a/tests/store-roots.scm b/tests/store-roots.scm new file mode 100644 index 0000000000..5bcf1bc87e --- /dev/null +++ b/tests/store-roots.scm @@ -0,0 +1,53 @@ +;;; 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 (test-store-deduplication) + #:use-module (guix tests) + #:use-module (guix store) + #:use-module (guix store roots) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +(define %store + (open-connection)) + +(test-begin "store-roots") + +(test-assert "gc-roots, regular root" + (let* ((item (add-text-to-store %store "something" + (random-text))) + (root (string-append %gc-roots-directory "/test-gc-root"))) + (symlink item root) + (let ((result (member root (gc-roots)))) + (delete-file root) + result))) + +(test-assert "gc-roots, indirect root" + (call-with-temporary-directory + (lambda (directory) + (let* ((item (add-text-to-store %store "something" + (random-text))) + (root (string-append directory "/gc-root"))) + (symlink item root) + (add-indirect-root %store root) + (let ((result (member root (gc-roots)))) + (delete-file root) + result))))) + +(test-end "store-roots") -- cgit v1.2.3 From ce6312999f20bb8d7e73c29b315747b1f4d184aa Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Fri, 5 Apr 2019 11:41:17 +0200 Subject: Add (guix build-system linux-module). * guix/build/linux-module-build-system.scm: New file. * guix/build-system/linux-module.scm: New file. * doc/guix.texi (Build Systems): Document it. * Makefile.am (MODULES): Add them. --- Makefile.am | 2 + doc/guix.texi | 27 +++++ guix/build-system/linux-module.scm | 166 +++++++++++++++++++++++++++++++ guix/build/linux-module-build-system.scm | 78 +++++++++++++++ 4 files changed, 273 insertions(+) create mode 100644 guix/build-system/linux-module.scm create mode 100644 guix/build/linux-module-build-system.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 704f2451c3..8d523262cb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -120,6 +120,7 @@ MODULES = \ guix/build-system/gnu.scm \ guix/build-system/guile.scm \ guix/build-system/haskell.scm \ + guix/build-system/linux-module.scm \ guix/build-system/perl.scm \ guix/build-system/python.scm \ guix/build-system/ocaml.scm \ @@ -173,6 +174,7 @@ MODULES = \ guix/build/texlive-build-system.scm \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ + guix/build/linux-module-build-system.scm \ guix/build/store-copy.scm \ guix/build/utils.scm \ guix/build/union.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 7dc4e1894a..9be7d9a27b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6210,6 +6210,33 @@ is not enabled by default. It can be enabled with @code{#:glib-or-gtk?}. @end table @end defvr +@defvr {Scheme Variable} linux-module-build-system +@var{linux-module-build-system} allows building Linux kernel modules. + +@cindex build phases +This build system is an extension of @var{gnu-build-system}, but with the +following phases changed: + +@table @code + +@item configure +This phase configures the environment so that the Linux kernel's Makefile +can be used to build the external kernel module. + +@item build +This phase uses the Linux kernel's Makefile in order to build the external +kernel module. + +@item install +This phase uses the Linux kernel's Makefile in order to install the external +kernel module. +@end table + +It is possible and useful to specify the Linux kernel to use for building +the module (in the "arguments" form of a package using the +linux-module-build-system, use the key #:linux to specify it). +@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/linux-module.scm b/guix/build-system/linux-module.scm new file mode 100644 index 0000000000..3ed3351353 --- /dev/null +++ b/guix/build-system/linux-module.scm @@ -0,0 +1,166 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Danny Milosavljevic +;;; +;;; 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 linux-module) + #: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 packages) + #:use-module (ice-9 match) + #:export (%linux-module-build-system-modules + linux-module-build + linux-module-build-system)) + +;; Commentary: +;; +;; Code: + +(define %linux-module-build-system-modules + ;; Build-side modules imported by default. + `((guix build linux-module-build-system) + ,@%gnu-build-system-modules)) + +(define (default-linux) + "Return the default Linux package." + + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages linux)))) + (module-ref module 'linux-libre))) + +(define (default-kmod) + "Return the default kmod package." + + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages linux)))) + (module-ref module 'kmod))) + +(define (default-gcc) + "Return the default gcc package." + + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages gcc)))) + (module-ref module 'gcc-7))) + +(define (make-linux-module-builder linux) + (package + (inherit linux) + (name (string-append (package-name linux) "-module-builder")) + (arguments + (substitute-keyword-arguments (package-arguments linux) + ((#:phases phases) + `(modify-phases ,phases + (replace 'build + (lambda _ + (invoke "make" "modules_prepare"))) + (delete 'strip) ; faster. + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (out-lib-build (string-append out "/lib/modules/build"))) + ; TODO: Only preserve the minimum, i.e. [Kbuild], Kconfig, scripts, include, ".config". + (copy-recursively "." out-lib-build) + #t))))))))) + +(define* (lower name + #:key source inputs native-inputs outputs + system target + (linux (default-linux)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + ,@(standard-packages))) + (build-inputs `(("linux" ,linux) ; for "Module.symvers". + ("linux-module-builder" + ,(make-linux-module-builder linux)) + ,@native-inputs + ;; TODO: Remove "gmp", "mpfr", "mpc" since they are only needed to compile the gcc plugins. Maybe remove "flex", "bison", "elfutils", "perl", "openssl". That leaves very little ("bc", "gcc", "kmod"). + ,@(package-native-inputs linux))) + (outputs outputs) + (build linux-module-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (linux-module-build store name inputs + #:key + (search-paths '()) + (tests? #t) + (phases '(@ (guix build linux-module-build-system) + %standard-phases)) + (outputs '("out")) + (system (%current-system)) + (guile #f) + (imported-modules + %linux-module-build-system-modules) + (modules '((guix build linux-module-build-system) + (guix build utils)))) + "Build SOURCE using LINUX, and with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (linux-module-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:phases ,phases + #:system ,system + #:tests? ,tests? + #:outputs %outputs + #:inputs %build-inputs))) + + (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 linux-module-build-system + (build-system + (name 'linux-module) + (description "The Linux module build system") + (lower lower))) + +;;; linux-module.scm ends here diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm new file mode 100644 index 0000000000..a6664f1eca --- /dev/null +++ b/guix/build/linux-module-build-system.scm @@ -0,0 +1,78 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Danny Milosavljevic +;;; +;;; 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 linux-module-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + linux-module-build)) + +;; Commentary: +;; +;; Builder-side code of linux-module build. +;; +;; Code: + +;; TODO: It might make sense to provide "Module.symvers" in the future. +(define* (configure #:key inputs #:allow-other-keys) + #t) + +(define* (build #:key inputs make-flags #:allow-other-keys) + (apply invoke "make" "-C" + (string-append (assoc-ref inputs "linux-module-builder") + "/lib/modules/build") + (string-append "M=" (getcwd)) + (or make-flags '()))) + +;; This block was copied from make-linux-libre--only took the "modules_install" +;; part. +(define* (install #:key inputs native-inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (moddir (string-append out "/lib/modules")) + (kmod (assoc-ref (or native-inputs inputs) "kmod"))) + ;; Install kernel modules + (mkdir-p moddir) + (invoke "make" "-C" + (string-append (assoc-ref inputs "linux-module-builder") + "/lib/modules/build") + (string-append "M=" (getcwd)) + (string-append "DEPMOD=" kmod "/bin/depmod") + (string-append "MODULE_DIR=" moddir) + (string-append "INSTALL_PATH=" out) + (string-append "INSTALL_MOD_PATH=" out) + "INSTALL_MOD_STRIP=1" + "modules_install"))) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (replace 'configure configure) + (replace 'build build) + (replace 'install install))) + +(define* (linux-module-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given package, applying all of PHASES in order, with a Linux kernel in attendance." + (apply gnu:gnu-build + #:inputs inputs #:phases phases + args)) + +;;; linux-module-build-system.scm ends here -- cgit v1.2.3 From 24963c13075b07db0c4e6005df9cde3bb51b2e32 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 19 Apr 2019 15:51:55 +0200 Subject: maint: 'release' clears gettext-induced changes in doc/. * Makefile.am (release): Run "git checkout ." in doc/ --- Makefile.am | 1 + 1 file changed, 1 insertion(+) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 8d523262cb..93203f0c81 100644 --- a/Makefile.am +++ b/Makefile.am @@ -701,6 +701,7 @@ GUIX_SYSTEM_VM_IMAGE_BASE = guix-system-vm-image-$(PACKAGE_VERSION) # issue described at . release: dist cd po; git checkout . + cd doc; git checkout . @if ! git diff-index --quiet HEAD; then \ echo "There are uncommitted changes; stopping." >&2 ; \ exit 1 ; \ -- cgit v1.2.3 From 35a09fd9c1aeb1023352b8e29c483b2fa6c4e41a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 19 Apr 2019 15:28:19 +0200 Subject: maint: Build all the 'guix' packages in parallel. Until now, the 'guix' package shipped in binary tarballs and system images would be built sequentially for each system type, one at a time. Now all of them can potentially be built in parallel. * Makefile.am (system_flags): New function. (release): Run "guix build guix" before "make binary-tarballs" and before "guix system disk-image" to build all the 'guix' packages in parallel. --- Makefile.am | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 93203f0c81..99d6ed64b6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -684,6 +684,9 @@ GUIX_SYSTEM_IMAGE_BASE = guix-system-install-$(PACKAGE_VERSION) # Prefix of the Guix VM image file name. GUIX_SYSTEM_VM_IMAGE_BASE = guix-system-vm-image-$(PACKAGE_VERSION) +# Return the sequence of '-s' flags for the given systems. +system_flags = $(foreach system,$(1),-s $(system)) + # The release process works in several phases: # # 0. We assume the developer created a 'vX.Y' tag. @@ -714,6 +717,9 @@ release: dist "`git rev-parse HEAD`" "$(PACKAGE_VERSION)" git add $(top_srcdir)/gnu/packages/package-management.scm git commit -m "gnu: guix: Update to $(PACKAGE_VERSION)." + $(top_builddir)/pre-inst-env guix build guix \ + $(call system_flags,$(SUPPORTED_SYSTEMS)) \ + -v1 --no-grafts -K rm -f $(BINARY_TARBALLS) $(MAKE) $(BINARY_TARBALLS) for system in $(SUPPORTED_SYSTEMS) ; do \ @@ -725,6 +731,9 @@ release: dist "`git rev-parse HEAD`" git add $(top_srcdir)/gnu/packages/package-management.scm git commit -m "gnu: guix: Update to `git rev-parse HEAD | cut -c1-7`." + $(top_builddir)/pre-inst-env guix build guix \ + $(call system_flags,$(GUIX_SYSTEM_SUPPORTED_SYSTEMS)) \ + -v1 --no-grafts -K for system in $(GUIX_SYSTEM_SUPPORTED_SYSTEMS) ; do \ image=`$(top_builddir)/pre-inst-env \ guix system disk-image \ -- cgit v1.2.3 From dbab5eb8f52963ffff5742ebbdf6ce7919e18ab1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 27 Apr 2019 09:56:45 +0200 Subject: maint: Pass '--image-size=30G' to 'guix system vm-image'. * Makefile.am (GUIX_SYSTEM_VM_IMAGE_FLAGS): New variable. (release): Use it. --- Makefile.am | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 99d6ed64b6..f25900de0f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -684,6 +684,10 @@ GUIX_SYSTEM_IMAGE_BASE = guix-system-install-$(PACKAGE_VERSION) # Prefix of the Guix VM image file name. GUIX_SYSTEM_VM_IMAGE_BASE = guix-system-vm-image-$(PACKAGE_VERSION) +# Flags for 'guix system vm-image'. By default create a VM image that appears +# to have a 20G hard disk. +GUIX_SYSTEM_VM_IMAGE_FLAGS ?= --image-size=30G + # Return the sequence of '-s' flags for the given systems. system_flags = $(foreach system,$(1),-s $(system)) @@ -750,7 +754,7 @@ release: dist done for system in $(GUIX_SYSTEM_VM_SYSTEMS) ; do \ image=`$(top_builddir)/pre-inst-env \ - guix system vm-image \ + guix system vm-image $(GUIX_SYSTEM_VM_IMAGE_FLAGS) \ --system=$$system \ gnu/system/examples/vm-image.tmpl` ; \ if [ ! -f "$$image" ] ; then \ -- cgit v1.2.3 From 554b30d2aca0cb27804d92863b87209593b023c6 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Fri, 26 Apr 2019 14:54:52 +0200 Subject: self: Rebuild translated manuals. * guix/self.scm (info-manual): Run po4a and related commands to generate translated texi files before building translated manuals. * guix/build/po.scm: New file. * Makefile.am (MODULES_NOT_COMPILED): Add it. --- Makefile.am | 1 + guix/build/po.scm | 69 ++++++++++++++++++++++++++++ guix/self.scm | 131 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 201 insertions(+) create mode 100644 guix/build/po.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index f25900de0f..05940719cd 100644 --- a/Makefile.am +++ b/Makefile.am @@ -54,6 +54,7 @@ nodist_noinst_SCRIPTS = \ # Modules that are not compiled but are installed nonetheless, such as # build-side modules with unusual dependencies. MODULES_NOT_COMPILED = \ + guix/build/po.scm \ guix/man-db.scm include gnu/local.mk diff --git a/guix/build/po.scm b/guix/build/po.scm new file mode 100644 index 0000000000..47ff67541c --- /dev/null +++ b/guix/build/po.scm @@ -0,0 +1,69 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Julien Lepiller +;;; +;;; 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 po) + #:use-module (ice-9 match) + #:use-module (ice-9 peg) + #:use-module (ice-9 regex) + #:use-module (ice-9 textual-ports) + #:export (read-po-file)) + +;; A small parser for po files +(define-peg-pattern po-file body (* (or comment entry whitespace))) +(define-peg-pattern whitespace body (or " " "\t" "\n")) +(define-peg-pattern comment-chr body (range #\space #\頋)) +(define-peg-pattern comment none (and "#" (* comment-chr) "\n")) +(define-peg-pattern entry all + (and (ignore (* whitespace)) (ignore "msgid ") msgid + (ignore (* whitespace)) (ignore "msgstr ") msgstr)) +(define-peg-pattern escape body (or "\\\\" "\\\"" "\\n")) +(define-peg-pattern str-chr body (or " " "!" (and (ignore "\\") "\"") + "\\n" (and (ignore "\\") "\\") + (range #\# #\頋))) +(define-peg-pattern msgid all content) +(define-peg-pattern msgstr all content) +(define-peg-pattern content body + (and (ignore "\"") (* str-chr) (ignore "\"") + (? (and (ignore (* whitespace)) content)))) + +(define (parse-tree->assoc parse-tree) + "Converts a po PARSE-TREE to an association list." + (define regex (make-regexp "\\\\n")) + (match parse-tree + ('() '()) + ((entry parse-tree ...) + (match entry + ((? string? entry) + (parse-tree->assoc parse-tree)) + ;; empty msgid + (('entry ('msgid ('msgstr msgstr))) + (parse-tree->assoc parse-tree)) + ;; empty msgstr + (('entry ('msgid msgid) 'msgstr) + (parse-tree->assoc parse-tree)) + (('entry ('msgid msgid) ('msgstr msgstr)) + (acons (regexp-substitute/global #f regex msgid 'pre "\n" 'post) + (regexp-substitute/global #f regex msgstr 'pre "\n" 'post) + (parse-tree->assoc parse-tree))))))) + +(define (read-po-file port) + "Read a .po file from PORT and return an alist of msgid and msgstr." + (let ((tree (peg:tree (match-pattern + po-file + (get-string-all port))))) + (parse-tree->assoc tree))) diff --git a/guix/self.scm b/guix/self.scm index 2a10d1d25f..68b87051e9 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -60,6 +60,8 @@ ("gzip" (ref '(gnu packages compression) 'gzip)) ("bzip2" (ref '(gnu packages compression) 'bzip2)) ("xz" (ref '(gnu packages compression) 'xz)) + ("po4a" (ref '(gnu packages gettext) 'po4a)) + ("gettext" (ref '(gnu packages gettext) 'gettext-minimal)) (_ #f)))) ;no such package @@ -253,8 +255,134 @@ DOMAIN, a gettext domain." (computed-file (string-append "guix-locale-" domain) build)) +(define (translate-texi-manuals source) + "Return the translated texinfo manuals built from SOURCE." + (define po4a + (specification->package "po4a")) + + (define gettext + (specification->package "gettext")) + + (define glibc-utf8-locales + (module-ref (resolve-interface '(gnu packages base)) + 'glibc-utf8-locales)) + + (define documentation + (file-append* source "doc")) + + (define documentation-po + (file-append* source "po/doc")) + + (define build + (with-imported-modules '((guix build utils) (guix build po)) + #~(begin + (use-modules (guix build utils) (guix build po) + (ice-9 match) (ice-9 regex) (ice-9 textual-ports) + (srfi srfi-1)) + + (mkdir #$output) + + (copy-recursively #$documentation "." + #:log (%make-void-port "w")) + + (for-each + (lambda (file) + (copy-file file (basename file))) + (find-files #$documentation-po ".*.po$")) + + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales "/lib/locale")) + (setenv "PATH" #+(file-append gettext "/bin")) + (setenv "LC_ALL" "en_US.UTF-8") + (setlocale LC_ALL "en_US.UTF-8") + + (define (translate-tmp-texi po source output) + "Translate Texinfo file SOURCE using messages from PO, and write +the result to OUTPUT." + (invoke #+(file-append po4a "/bin/po4a-translate") + "-M" "UTF-8" "-L" "UTF-8" "-k" "0" "-f" "texinfo" + "-m" source "-p" po "-l" output)) + + (define (make-ref-regex msgid end) + (make-regexp (string-append + "ref\\{" + (string-join (string-split (regexp-quote msgid) #\ ) + "[ \n]+") + end))) + + (define (translate-cross-references content translations) + "Take CONTENT, a string representing a .texi file and translate any +cross-reference in it (@ref, @xref and @pxref) that have a translation in +TRANSLATIONS, an alist of msgid and msgstr." + (fold + (lambda (elem content) + (match elem + ((msgid . msgstr) + ;; Empty translations and strings containing some special characters + ;; cannot be the name of a section. + (if (or (equal? msgstr "") + (string-any (lambda (chr) + (member chr '(#\{ #\} #\( #\) #\newline #\,))) + msgid)) + content + ;; Otherwise, they might be the name of a section, so we + ;; need to translate any occurence in @(p?x?)ref{...}. + (let ((regexp1 (make-ref-regex msgid ",")) + (regexp2 (make-ref-regex msgid "\\}"))) + (regexp-substitute/global + #f regexp2 + (regexp-substitute/global + #f regexp1 content 'pre "ref{" msgstr "," 'post) + 'pre "ref{" msgstr "}" 'post)))))) + content translations)) + + (define (translate-texi po lang) + "Translate the manual for one language LANG using the PO file." + (let ((translations (call-with-input-file po read-po-file))) + (translate-tmp-texi po "guix.texi" + (string-append "guix." lang ".texi.tmp")) + (translate-tmp-texi po "contributing.texi" + (string-append "contributing." lang ".texi.tmp")) + (let* ((texi-name (string-append "guix." lang ".texi")) + (tmp-name (string-append texi-name ".tmp"))) + (with-output-to-file texi-name + (lambda _ + (format #t "~a" + (translate-cross-references + (call-with-input-file tmp-name get-string-all) + translations))))) + (let* ((texi-name (string-append "contributing." lang ".texi")) + (tmp-name (string-append texi-name ".tmp"))) + (with-output-to-file texi-name + (lambda _ + (format #t "~a" + (translate-cross-references + (call-with-input-file tmp-name get-string-all) + translations))))))) + + (for-each (lambda (po) + (match (reverse (string-split po #\.)) + ((_ lang _ ...) + (translate-texi po lang)))) + (find-files "." "^guix-manual\\.[a-z]{2}(_[A-Z]{2})?\\.po$")) + + (for-each + (lambda (file) + (copy-file file (string-append #$output "/" file))) + (append + (find-files "." "contributing\\..*\\.texi$") + (find-files "." "guix\\..*\\.texi$")))))) + + (computed-file "guix-translated-texinfo" build)) + (define (info-manual source) "Return the Info manual built from SOURCE." + (define po4a + (specification->package "po4a")) + + (define gettext + (specification->package "gettext")) + (define texinfo (module-ref (resolve-interface '(gnu packages texinfo)) 'texinfo)) @@ -327,6 +455,8 @@ DOMAIN, a gettext domain." ;; see those images and produce image references in the Info output. (copy-recursively #$documentation "." #:log (%make-void-port "w")) + (copy-recursively #+(translate-texi-manuals source) "." + #:log (%make-void-port "w")) (delete-file-recursively "images") (symlink (string-append #$output "/images") "images") @@ -578,6 +708,7 @@ Info manual." ;; us to avoid an extra dependency on guile-gdbm-ffi. #:extra-files `(("guix/man-db.scm" ,(local-file "../guix/man-db.scm")) + ("guix/build/po.scm" ,(local-file "../guix/build/po.scm")) ("guix/store/schema.sql" ,(local-file "../guix/store/schema.sql"))) -- cgit v1.2.3 From d824cfbabeb0780c9ea7a6dab02c47b6a4d029c6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 27 Apr 2019 18:04:00 +0200 Subject: guix package: Add 'install', 'remove', and 'upgrade' aliases. * guix/scripts/install.scm, guix/scripts/remove.scm, guix/scripts/upgrade.scm, tests/guix-package-aliases.sh: New files. * Makefile.am (MODULES, SH_TESTS): Add them. * po/guix/POTFILES.in: Add them. * guix/scripts/package.scm (guix-package): Split with... (guix-package*): ... this. New procedure. * doc/guix.texi (Invoking guix package): Document them. (Binary Installation, Application Setup, Package Management) (Packages with Multiple Outputs, Package Modules) (X.509 Certificates, Installing Debugging Files): Use 'guix install' in simple examples. * etc/completion/bash/guix (_guix_complete): Handle "install", "remove", and "upgrade". --- Makefile.am | 4 ++ doc/guix.texi | 39 +++++++++++++------ etc/completion/bash/guix | 11 +++++- guix/scripts/install.scm | 80 +++++++++++++++++++++++++++++++++++++++ guix/scripts/package.scm | 11 +++++- guix/scripts/remove.scm | 77 +++++++++++++++++++++++++++++++++++++ guix/scripts/upgrade.scm | 88 +++++++++++++++++++++++++++++++++++++++++++ po/guix/POTFILES.in | 3 ++ tests/guix-package-aliases.sh | 58 ++++++++++++++++++++++++++++ 9 files changed, 358 insertions(+), 13 deletions(-) create mode 100644 guix/scripts/install.scm create mode 100644 guix/scripts/remove.scm create mode 100644 guix/scripts/upgrade.scm create mode 100644 tests/guix-package-aliases.sh (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 05940719cd..076f1c7a71 100644 --- a/Makefile.am +++ b/Makefile.am @@ -224,6 +224,9 @@ MODULES = \ guix/scripts/archive.scm \ guix/scripts/import.scm \ guix/scripts/package.scm \ + guix/scripts/install.scm \ + guix/scripts/remove.scm \ + guix/scripts/upgrade.scm \ guix/scripts/gc.scm \ guix/scripts/hash.scm \ guix/scripts/pack.scm \ @@ -425,6 +428,7 @@ SH_TESTS = \ tests/guix-pack-localstatedir.sh \ tests/guix-pack-relocatable.sh \ tests/guix-package.sh \ + tests/guix-package-aliases.sh \ tests/guix-package-net.sh \ tests/guix-system.sh \ tests/guix-archive.sh \ diff --git a/doc/guix.texi b/doc/guix.texi index c28ded1cf1..6c3dc7d208 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -689,7 +689,7 @@ You can confirm that Guix is working by installing a sample package into the root profile: @example -# guix package -i hello +# guix install hello @end example The binary installation tarball can be (re)produced and verified simply @@ -1577,7 +1577,7 @@ available with Guix and then define the @code{GUIX_LOCPATH} environment variable: @example -$ guix package -i glibc-locales +$ guix install glibc-locales $ export GUIX_LOCPATH=$HOME/.guix-profile/lib/locale @end example @@ -1677,7 +1677,7 @@ Multiple Outputs}). For instance, the following command installs fonts for Chinese languages: @example -guix package -i font-adobe-source-han-sans:cn +guix install font-adobe-source-han-sans:cn @end example @cindex @code{xterm} @@ -2492,7 +2492,7 @@ emacs-guix, The Emacs-Guix Reference Manual}), after installing with it): @example -guix package -i emacs-guix +guix install emacs-guix @end example @menu @@ -2610,6 +2610,7 @@ is: @example guix package @var{options} @end example + @cindex transactions Primarily, @var{options} specifies the operations to be performed during the transaction. Upon completion, a new profile is created, but @@ -2623,6 +2624,22 @@ For example, to remove @code{lua} and install @code{guile} and guix package -r lua -i guile guile-cairo @end example +@cindex aliases, for @command{guix package} +For your convenience, we also provide the following aliases: + +@itemize +@item +@command{guix install} is an alias for @command{guix package -i}, +@item +@command{guix remove} is an alias for @command{guix package -r}, +@item +and @command{guix upgrade} is an alias for @command{guix package -u}. +@end itemize + +These aliases are less expressive than @command{guix package} and provide +fewer options, so in some cases you'll probably want to use @command{guix +package} directly. + @command{guix package} also supports a @dfn{declarative approach} whereby the user specifies the exact set of packages to be available and passes it @i{via} the @option{--manifest} option @@ -3312,7 +3329,7 @@ like to discuss this project, join us on @email{guix-devel@@gnu.org}. Often, packages defined in Guix have a single @dfn{output}---i.e., the source package leads to exactly one directory in the store. When running -@command{guix package -i glibc}, one installs the default output of the +@command{guix install glibc}, one installs the default output of the GNU libc package; the default output is called @code{out}, but its name can be omitted as shown in this command. In this particular case, the default output of @code{glibc} contains all the C header files, shared @@ -3328,14 +3345,14 @@ separate output, called @code{doc}. To install the main GLib output, which contains everything but the documentation, one would run: @example -guix package -i glib +guix install glib @end example @cindex documentation The command to install its documentation is: @example -guix package -i glib:doc +guix install glib:doc @end example Some packages install programs with different ``dependency footprints''. @@ -4986,7 +5003,7 @@ module exports a variable named @code{emacs}, which is bound to a The @code{(gnu packages @dots{})} module name space is automatically scanned for packages by the command-line tools. For -instance, when running @code{guix package -i emacs}, all the @code{(gnu +instance, when running @code{guix install emacs}, all the @code{(gnu packages @dots{})} modules are scanned until one that exports a package object whose name is @code{emacs} is found. This package search facility is implemented in the @code{(gnu packages)} module. @@ -23634,7 +23651,7 @@ pointed to by the @code{GIT_SSL_CAINFO} environment variable. Thus, you would typically run something like: @example -$ guix package -i nss-certs +$ guix install nss-certs $ export SSL_CERT_DIR="$HOME/.guix-profile/etc/ssl/certs" $ export SSL_CERT_FILE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt" $ export GIT_SSL_CAINFO="$SSL_CERT_FILE" @@ -23645,7 +23662,7 @@ variable to point to a certificate bundle, so you would have to run something like this: @example -$ guix package -i nss-certs +$ guix install nss-certs $ export CURL_CA_BUNDLE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt" @end example @@ -25427,7 +25444,7 @@ installs the debugging information for the GNU C Library and for GNU Guile: @example -guix package -i glibc:debug guile:debug +guix install glibc:debug guile:debug @end example GDB must then be told to look for debug files in the user's profile, by diff --git a/etc/completion/bash/guix b/etc/completion/bash/guix index 3d2b3ddda7..edfb627e87 100644 --- a/etc/completion/bash/guix +++ b/etc/completion/bash/guix @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès +# Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès # # This file is part of GNU Guix. # @@ -167,6 +167,15 @@ _guix_complete () else _guix_complete_available_package "$word_at_point" fi + elif _guix_is_command "install" + then + _guix_complete_available_package "$word_at_point" + elif _guix_is_command "remove" + then + _guix_complete_installed_package "$word_at_point" + elif _guix_is_command "upgrade" + then + _guix_complete_installed_package "$word_at_point" elif _guix_is_command "build" then if _guix_is_dash_L diff --git a/guix/scripts/install.scm b/guix/scripts/install.scm new file mode 100644 index 0000000000..d88e86e77a --- /dev/null +++ b/guix/scripts/install.scm @@ -0,0 +1,80 @@ +;;; 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 scripts install) + #:use-module (guix ui) + #:use-module (guix scripts package) + #:use-module (guix scripts build) + #:use-module (guix scripts) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:export (guix-install)) + +(define (show-help) + (display (G_ "Usage: guix install [OPTION] PACKAGES... +Install the given PACKAGES. +This is an alias for 'guix package -i'.\n")) + (display (G_ " + -p, --profile=PROFILE use PROFILE instead of the user's default profile")) + ;; '--bootstrap' not shown here. + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (newline) + (show-build-options-help) + (newline) + (show-transformation-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 + ;; 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 install"))) + + ;; Preserve some of the 'guix package' options. + (append (filter (lambda (option) + (any (cut member <> (option-names option)) + '("profile" "dry-run" "verbosity" "bootstrap"))) + %package-options) + + %transformation-options + %standard-build-options))) + +(define (guix-install . args) + (define (handle-argument arg result arg-handler) + ;; Treat all non-option arguments as package specs. + (values (alist-cons 'install arg result) + arg-handler)) + + (define opts + (parse-command-line args %options + (list %package-default-options #f) + #:argument-handler handle-argument)) + + (guix-package* opts)) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 564236988e..aa27984ea2 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -58,7 +58,11 @@ delete-generations delete-matching-generations display-search-paths - guix-package)) + guix-package + + (%options . %package-options) + (%default-options . %package-default-options) + guix-package*)) (define %store (make-parameter #f)) @@ -899,6 +903,11 @@ processed, #f otherwise." (parse-command-line args %options (list %default-options #f) #:argument-handler handle-argument)) + (guix-package* opts)) + +(define (guix-package* opts) + "Run the 'guix package' command on OPTS, an alist resulting for command-line +option processing with 'parse-command-line'." (with-error-handling (or (process-query opts) (parameterize ((%store (open-connection)) diff --git a/guix/scripts/remove.scm b/guix/scripts/remove.scm new file mode 100644 index 0000000000..2f06ea4f37 --- /dev/null +++ b/guix/scripts/remove.scm @@ -0,0 +1,77 @@ +;;; 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 scripts remove) + #:use-module (guix ui) + #:use-module (guix scripts package) + #:use-module (guix scripts build) + #:use-module (guix scripts) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:export (guix-remove)) + +(define (show-help) + (display (G_ "Usage: guix remove [OPTION] PACKAGES... +Remove the given PACKAGES. +This is an alias for 'guix package -r'.\n")) + (display (G_ " + -p, --profile=PROFILE use PROFILE instead of the user's default profile")) + ;; '--bootstrap' not shown here. + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (newline) + (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 + ;; 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 remove"))) + + ;; Preserve some of the 'guix package' options. + (append (filter (lambda (option) + (any (cut member <> (option-names option)) + '("profile" "dry-run" "verbosity" "bootstrap"))) + %package-options) + + %standard-build-options))) + +(define (guix-remove . args) + (define (handle-argument arg result arg-handler) + ;; Treat all non-option arguments as package specs. + (values (alist-cons 'remove arg result) + arg-handler)) + + (define opts + (parse-command-line args %options + (list %package-default-options #f) + #:argument-handler handle-argument)) + + (guix-package* opts)) diff --git a/guix/scripts/upgrade.scm b/guix/scripts/upgrade.scm new file mode 100644 index 0000000000..7f14a2fdbe --- /dev/null +++ b/guix/scripts/upgrade.scm @@ -0,0 +1,88 @@ +;;; 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 scripts upgrade) + #:use-module (guix ui) + #:use-module (guix scripts package) + #:use-module (guix scripts build) + #:use-module (guix scripts) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (guix-upgrade)) + +(define (show-help) + (display (G_ "Usage: guix upgrade [OPTION] [REGEXP] +Upgrade packages that match REGEXP. +This is an alias for 'guix package -u'.\n")) + (display (G_ " + -p, --profile=PROFILE use PROFILE instead of the user's default profile")) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (newline) + (show-build-options-help) + (newline) + (show-transformation-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 + ;; 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 upgrade"))) + + ;; Preserve some of the 'guix package' options. + (append (filter (lambda (option) + (any (cut member <> (option-names option)) + '("profile" "dry-run" "verbosity"))) + %package-options) + + %transformation-options + %standard-build-options))) + +(define (guix-upgrade . args) + (define (handle-argument arg result arg-handler) + ;; Accept at most one non-option argument, and treat it as an upgrade + ;; regexp. + (match (assq-ref result 'upgrade) + (#f + (values (alist-cons 'upgrade arg + (alist-delete 'upgrade result)) + arg-handler)) + (_ + (leave (G_ "~A: extraneous argument~%") arg)))) + + (define opts + (parse-command-line args %options + (list `((upgrade . #f) + ,@%package-default-options) + #f) + #:argument-handler handle-argument)) + + (guix-package* opts)) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index a2c89db981..91de60efc7 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -41,6 +41,9 @@ guix/scripts/build.scm guix/discovery.scm guix/scripts/download.scm guix/scripts/package.scm +guix/scripts/install.scm +guix/scripts/remove.scm +guix/scripts/upgrade.scm guix/scripts/gc.scm guix/scripts/hash.scm guix/scripts/import.scm diff --git a/tests/guix-package-aliases.sh b/tests/guix-package-aliases.sh new file mode 100644 index 0000000000..64ed2fbb67 --- /dev/null +++ b/tests/guix-package-aliases.sh @@ -0,0 +1,58 @@ +# 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 . + +# +# Test the `guix package' aliases. +# + +guix install --version + +readlink_base () +{ + basename `readlink "$1"` +} + +profile="t-profile-$$" +rm -f "$profile" + +trap 'rm -f "$profile" "$profile-"[0-9]*' EXIT + +guix install --bootstrap guile-bootstrap -p "$profile" +test -x "$profile/bin/guile" + +# Make sure '-r' isn't passed as-is to 'guix package'. +if guix install -r guile-bootstrap -p "$profile" --bootstrap +then false; else true; fi +test -x "$profile/bin/guile" + +guix upgrade --version +guix upgrade -n +guix upgrade gui.e -n +if guix upgrade foo bar -n; +then false; else true; fi + +guix remove --version +guix remove --bootstrap guile-bootstrap -p "$profile" +! test -x "$profile/bin/guile" +test `guix package -p "$profile" -I | wc -l` -eq 0 + +if guix remove -p "$profile" this-is-not-installed --bootstrap +then false; else true; fi + +if guix remove -i guile-bootstrap -p "$profile" --bootstrap +then false; else true; fi -- cgit v1.2.3 From da56f10971e0b6f32969b10e38ed043b2c99bb82 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 29 Apr 2019 10:41:11 +0200 Subject: guix package: Add 'guix search' alias. * guix/scripts/search.scm: New file. * Makefile.am (MODULES): Add it. * po/guix/POTFILES.in: Add it. * tests/guix-package-aliases.sh: Add test. * doc/guix.texi (Invoking guix package): Document it and use it in a couple of examples. --- Makefile.am | 1 + doc/guix.texi | 13 +++++---- guix/scripts/search.scm | 67 +++++++++++++++++++++++++++++++++++++++++++ po/guix/POTFILES.in | 1 + tests/guix-package-aliases.sh | 2 ++ 5 files changed, 79 insertions(+), 5 deletions(-) create mode 100644 guix/scripts/search.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 076f1c7a71..36f3bc5c27 100644 --- a/Makefile.am +++ b/Makefile.am @@ -227,6 +227,7 @@ MODULES = \ guix/scripts/install.scm \ guix/scripts/remove.scm \ guix/scripts/upgrade.scm \ + guix/scripts/search.scm \ guix/scripts/gc.scm \ guix/scripts/hash.scm \ guix/scripts/pack.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 39d2ee476a..fcee57d9cd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2630,6 +2630,8 @@ For your convenience, we also provide the following aliases: @itemize @item +@command{guix search} is an alias for @command{guix package -s}, +@item @command{guix install} is an alias for @command{guix package -i}, @item @command{guix remove} is an alias for @command{guix package -r}, @@ -2953,12 +2955,13 @@ name: gmp @dots{} @end example -It is also possible to refine search results using several @code{-s} -flags. For example, the following command returns a list of board -games: +It is also possible to refine search results using several @code{-s} flags to +@command{guix package}, or several arguments to @command{guix search}. For +example, the following command returns a list of board games (this time using +the @command{guix search} alias): @example -$ guix package -s '\' -s game | recsel -p name +$ guix search '\' game | recsel -p name name: gnubg @dots{} @end example @@ -2973,7 +2976,7 @@ for cryptographic libraries, filters out Haskell, Perl, Python, and Ruby libraries, and prints the name and synopsis of the matching packages: @example -$ guix package -s crypto -s library | \ +$ guix search crypto library | \ recsel -e '! (name ~ "^(ghc|perl|python|ruby)")' -p name,synopsis @end example diff --git a/guix/scripts/search.scm b/guix/scripts/search.scm new file mode 100644 index 0000000000..8fceb83668 --- /dev/null +++ b/guix/scripts/search.scm @@ -0,0 +1,67 @@ +;;; 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 scripts search) + #:use-module (guix ui) + #:use-module (guix scripts package) + #:use-module (guix scripts) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:export (guix-search)) + +(define (show-help) + (display (G_ "Usage: guix search [OPTION] REGEXPS... +Search for packages matching REGEXPS.")) + (display (G_" +This is an alias for 'guix package -s'.\n")) + (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 + ;; Specification of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix search"))))) + +(define (guix-search . args) + (define (handle-argument arg result) + ;; Treat all non-option arguments as regexps. + (cons `(query search ,(or arg "")) + result)) + + (define opts + (args-fold* args %options + (lambda (opt name arg . rest) + (leave (G_ "~A: unrecognized option~%") name)) + handle-argument + '())) + + (unless (assoc-ref opts 'query) + (leave (G_ "missing arguments: no regular expressions to search for~%"))) + + (guix-package* opts)) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 91de60efc7..ceee589b2e 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -44,6 +44,7 @@ guix/scripts/package.scm guix/scripts/install.scm guix/scripts/remove.scm guix/scripts/upgrade.scm +guix/scripts/search.scm guix/scripts/gc.scm guix/scripts/hash.scm guix/scripts/import.scm diff --git a/tests/guix-package-aliases.sh b/tests/guix-package-aliases.sh index 64ed2fbb67..5c68664093 100644 --- a/tests/guix-package-aliases.sh +++ b/tests/guix-package-aliases.sh @@ -56,3 +56,5 @@ then false; else true; fi if guix remove -i guile-bootstrap -p "$profile" --bootstrap then false; else true; fi + +guix search '\' game | grep '^name: gnubg' -- cgit v1.2.3