From ca87601dd97dd9d356409827802eb0f8a3a535f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 Jan 2022 17:20:43 +0100 Subject: git-authenticate: Ensure the target is a descendant of the introductory commit. Fixes a bug whereby authentication of a commit *not* descending from the introductory commit could succeed, provided the commit verifies the authorization invariant. In the example below, A is a common ancestor of the introductory commit I and of commit X. Authentication of X would succeed, even though it is not a descendant of I, as long as X is authorized according to the '.guix-authorizations' in A: X I \ / A This is because, 'authenticate-repository' would not check whether X descends from I, and the call (commit-difference X I) would return X. In practice that only affects forks because it means that ancestors of the introductory commit already contain a '.guix-authorizations' file. * guix/git-authenticate.scm (authenticate-repository): Add call to 'commit-descendant?'. * tests/channels.scm ("authenticate-channel, not a descendant of introductory commit"): New test. * tests/git-authenticate.scm ("authenticate-repository, target not a descendant of intro"): New test. * tests/guix-git-authenticate.sh: Expect earlier test to fail since 9549f0283a78fe36f2d4ff2a04ef8ad6b0c02604 is not a descendant of $intro_commit. Add new test targeting an ancestor of the introductory commit, and another test targeting the v1.2.0 commit. * doc/guix.texi (Specifying Channel Authorizations): Add a sentence. --- doc/guix.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 86dbe9f201..c116be8907 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5448,7 +5448,9 @@ commit of a channel that should be authenticated. The first time a channel is fetched with @command{guix pull} or @command{guix time-machine}, the command looks up the introductory commit and verifies that it is signed by the specified OpenPGP key. From then on, it -authenticates commits according to the rule above. +authenticates commits according to the rule above. Authentication fails +if the target commit is neither a descendant nor an ancestor of the +introductory commit. Additionally, your channel must provide all the OpenPGP keys that were ever mentioned in @file{.guix-authorizations}, stored as @file{.key} -- cgit v1.2.3 From b9df2e2b4d8a8efa5983aeb69a5ed394e7bcba60 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 9 Feb 2022 21:38:05 +0100 Subject: pull: '--list-generations' lists packages only with '--details'. * guix/scripts/pull.scm (show-help, %options): Add "--details". (process-query): Honor it. * doc/guix.texi (Invoking guix pull): Document it. --- doc/guix.texi | 15 +++++++++------ guix/scripts/pull.scm | 27 +++++++++++++++++++++++---- 2 files changed, 32 insertions(+), 10 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index c116be8907..a05f073c3d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4426,18 +4426,12 @@ Generation 2 Jun 11 2018 11:02:49 repository URL: https://git.savannah.gnu.org/git/guix.git branch: origin/master commit: e0cc7f669bec22c37481dd03a7941c7d11a64f1d - 2 new packages: keepalived, libnfnetlink - 6 packages upgraded: emacs-nix-mode@@2.0.4, - guile2.0-guix@@0.14.0-12.77a1aac, guix@@0.14.0-12.77a1aac, - heimdal@@7.5.0, milkytracker@@1.02.00, nix@@2.0.4 Generation 3 Jun 13 2018 23:31:07 (current) guix 844cc1c repository URL: https://git.savannah.gnu.org/git/guix.git branch: origin/master commit: 844cc1c8f394f03b404c5bb3aee086922373490c - 28 new packages: emacs-helm-ls-git, emacs-helm-mu, @dots{} - 69 packages upgraded: borg@@1.1.6, cheese@@3.28.0, @dots{} @end example @xref{Invoking guix describe, @command{guix describe}}, for other ways to @@ -4507,6 +4501,15 @@ is provided, the subset of generations that match @var{pattern}. The syntax of @var{pattern} is the same as with @code{guix package --list-generations} (@pxref{Invoking guix package}). +By default, this prints information about the channels used in each +revision as well as the corresponding news entries. If you pass +@option{--details}, it will also print the list of packages added and +upgraded in each generation compared to the previous one. + +@item --details +Instruct @option{--list-generations} to display more information about +the differences between subsequent generations---see above. + @item --roll-back @cindex rolling back @cindex undoing transactions diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index fb8ce50fa7..a3bb6db8c6 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2013-2015, 2017-2022 Ludovic Courtès ;;; Copyright © 2017 Marius Bakke ;;; Copyright © 2020, 2021 Tobias Geerinckx-Rice ;;; @@ -104,6 +104,8 @@ (define (show-help) (display (G_ " -l, --list-generations[=PATTERN] list generations matching PATTERN")) + (display (G_ " + --details show details when listing generations")) (display (G_ " --roll-back roll back to the previous generation")) (display (G_ " @@ -138,6 +140,17 @@ (define %options (lambda (opt name arg result) (cons `(query list-generations ,arg) result))) + (option '("details") #f #f + (lambda (opt name arg result) + (alist-cons 'details? #t + (match (find (match-lambda + (('query 'list-generations _) + #t) + (_ #f)) + result) + (#t result) + (#f (cons `(query list-generations #f) + result)))))) (option '("roll-back") #f #f (lambda (opt name arg result) (cons '(generation roll-back) @@ -640,17 +653,23 @@ (define (package-alist generation) (define (process-query opts profile) "Process any query on PROFILE specified by OPTS." + (define details? + (assoc-ref opts 'details?)) + (match (assoc-ref opts 'query) (('list-generations pattern) (define (list-generations profile numbers) (match numbers ((first rest ...) (display-profile-content profile first) + (let loop ((numbers numbers)) (match numbers ((first second rest ...) - (display-profile-content-diff profile - first second) + (if details? + (display-profile-content-diff profile + first second) + (display-profile-content profile second)) (display-channel-news (generation-file-name profile second) (generation-file-name profile first)) (loop (cons second rest))) @@ -754,7 +773,7 @@ (define (environment-variable) (define-command (guix-pull . args) (synopsis "pull the latest revision of Guix") - (define (no-arguments arg _‌) + (define (no-arguments arg _) (leave (G_ "~A: extraneous argument~%") arg)) (with-error-handling -- cgit v1.2.3 From cfa6fdc54c58280e49330438aecfb5046ee9e63a Mon Sep 17 00:00:00 2001 From: Josselin Poiret Date: Sun, 6 Feb 2022 22:20:45 +0100 Subject: doc: Clarify the Swap Space examples, and include an helper example. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Swap Space): The examples referred to variables defined outside of the snippets, and so were not very informative for people without much Guile knowledge. Instead, refer to mapped-devices for the first, and use the new helper file-systme-mount-point-predicate for the second. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index a05f073c3d..039b418038 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -15742,22 +15742,39 @@ Linux swap partition by running @command{swaplabel @var{device}}, where @lisp (swap-space (target (file-system-label "swap")) - (dependencies (list lvm-device))) + (dependencies mapped-devices)) @end lisp -Use the partition with label @code{swap}, which can be found after the -@var{lvm-device} mapped device has been opened. Again, the +Use the partition with label @code{swap}, which can be found after all +the @var{mapped-devices} mapped devices have been opened. Again, the @command{swaplabel} command allows you to view and change the label of a Linux swap partition. +Here's a more involved example with the corresponding @code{file-systems} part +of an @code{operating-system} declaration. + @lisp -(swap-space - (target "/btrfs/swapfile") - (dependencies (list btrfs-fs))) +(file-systems + (list (file-system + (device (file-system-label "root")) + (mount-point "/") + (type "ext4")) + (file-system + (device (file-system-label "btrfs")) + (mount-point "/btrfs") + (type "btrfs")))) + +(swap-devices + (list + (swap-space + (target "/btrfs/swapfile") + (dependencies (filter (file-system-mount-point-predicate "/btrfs") + file-systems))))) @end lisp -Use the file @file{/btrfs/swapfile} as swap space, which is present on the -@var{btrfs-fs} filesystem. +Use the file @file{/btrfs/swapfile} as swap space, which depends on the +file system mounted at @file{/btrfs}. Note how we use Guile's filter to +select the file system in an elegant fashion! @node User Accounts @section User Accounts -- cgit v1.2.3 From de65fd92d5724ace1cbc49f20ad49bffdc64d09d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 16 Feb 2022 15:37:04 +0100 Subject: doc: Document 'wrap-program' and 'wrap-script'. * doc/guix.texi (Build Utilities)[Wrappers]: New subsection. --- doc/guix.texi | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 039b418038..c8bb484d94 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9506,6 +9506,90 @@ executable files to be installed: @c TODO: Add more examples. +@subsection Wrappers + +@cindex program wrappers +@cindex wrapping programs +It is not unusual for a command to require certain environment variables +to be set for proper functioning, typically search paths (@pxref{Search +Paths}). Failing to do that, the command might fail to find files or +other commands it relies on, or it might pick the ``wrong'' +ones---depending on the environment in which it runs. Examples include: + +@itemize +@item +a shell script that assumes all the commands it uses are in @env{PATH}; + +@item +a Guile program that assumes all its modules are in @env{GUILE_LOAD_PATH} +and @env{GUILE_LOAD_COMPILED_PATH}; + +@item +a Qt application that expects to find certain plugins in +@env{QT_PLUGIN_PATH}. +@end itemize + +For a package writer, the goal is to make sure commands always work the +same rather than depend on some external settings. One way to achieve +that is to @dfn{wrap} commands in a thin script that sets those +environment variables, thereby ensuring that those run-time dependencies +are always found. The wrapper would be used to set @env{PATH}, +@env{GUILE_LOAD_PATH}, or @env{QT_PLUGIN_PATH} in the examples above. + +To ease that task, the @code{(guix build utils)} module provides a +couple of helpers to wrap commands. + +@deffn {Scheme Procedure} wrap-program @var{program} @ + [#:sh @var{sh}] [#:rest @var{variables}] +Make a wrapper for @var{program}. @var{variables} should look like this: + +@example +'(@var{variable} @var{delimiter} @var{position} @var{list-of-directories}) +@end example + +where @var{delimiter} is optional. @code{:} will be used if +@var{delimiter} is not given. + +For example, this call: + +@example +(wrap-program "foo" + '("PATH" ":" = ("/gnu/.../bar/bin")) + '("CERT_PATH" suffix ("/gnu/.../baz/certs" + "/qux/certs"))) +@end example + +will copy @file{foo} to @file{.foo-real} and create the file @file{foo} +with the following contents: + +@example +#!location/of/bin/bash +export PATH="/gnu/.../bar/bin" +export CERT_PATH="$CERT_PATH$@{CERT_PATH:+:@}/gnu/.../baz/certs:/qux/certs" +exec -a $0 location/of/.foo-real "$@@" +@end example + +If @var{program} has previously been wrapped by @code{wrap-program}, the +wrapper is extended with definitions for @var{variables}. If it is not, +@var{sh} will be used as the interpreter. +@end deffn + +@deffn {Scheme Procedure} wrap-script @var{program} @ + [#:guile @var{guile}] [#:rest @var{variables}] +Wrap the script @var{program} such that @var{variables} are set first. +The format of @var{variables} is the same as in the @code{wrap-program} +procedure. This procedure differs from @code{wrap-program} in that it +does not create a separate shell script. Instead, @var{program} is +modified directly by prepending a Guile script, which is interpreted as +a comment in the script's language. + +Special encoding comments as supported by Python are recreated on the +second line. + +Note that this procedure can only be used once per file as Guile scripts are +not supported. +@end deffn + @node Search Paths @section Search Paths -- cgit v1.2.3 From 9724da9abc3b5719a7cd5ba107444be6b2d50f4a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 16 Feb 2022 22:24:24 +0100 Subject: doc: Typographical tweaks. * doc/guix.texi (Build Utilities): Remove trailing #t from phases. Use @lisp for 'wrap-program' examples. --- doc/guix.texi | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index c8bb484d94..a4145af7fd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9480,8 +9480,7 @@ scripts so that they refer to @code{grep} by its absolute file name: (substitute* (list (string-append bin "/egrep") (string-append bin "/fgrep")) (("^exec grep") - (string-append "exec " bin "/grep"))) - #t)))) + (string-append "exec " bin "/grep"))))))) @end lisp In the example below, phases are modified in two ways: the standard @@ -9500,8 +9499,7 @@ executable files to be installed: (let ((bin (string-append (assoc-ref outputs "out") "/bin"))) (install-file "footswitch" bin) - (install-file "scythe" bin) - #t)))) + (install-file "scythe" bin))))) @end lisp @c TODO: Add more examples. @@ -9543,21 +9541,21 @@ couple of helpers to wrap commands. [#:sh @var{sh}] [#:rest @var{variables}] Make a wrapper for @var{program}. @var{variables} should look like this: -@example +@lisp '(@var{variable} @var{delimiter} @var{position} @var{list-of-directories}) -@end example +@end lisp where @var{delimiter} is optional. @code{:} will be used if @var{delimiter} is not given. For example, this call: -@example +@lisp (wrap-program "foo" '("PATH" ":" = ("/gnu/.../bar/bin")) '("CERT_PATH" suffix ("/gnu/.../baz/certs" "/qux/certs"))) -@end example +@end lisp will copy @file{foo} to @file{.foo-real} and create the file @file{foo} with the following contents: -- cgit v1.2.3 From c0bc08d82c73e464a419f213d5ae5545bc67e2bf Mon Sep 17 00:00:00 2001 From: Simon Streit Date: Tue, 22 Feb 2022 16:23:38 +0100 Subject: doc: Document virtlogd package variable. * doc/guix.texi (Virtualization Services): Document virtlogd package variable. Signed-off-by: Efraim Flashner --- doc/guix.texi | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index a4145af7fd..528760d7f6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -30888,6 +30888,10 @@ Its value must be a @code{virtlog-configuration}. @end lisp @end deffn +@deftypevar {@code{libvirt} parameter} package libvirt +Libvirt package. +@end deftypevar + @deftypevr {@code{virtlog-configuration} parameter} integer log-level Logging level. 4 errors, 3 warnings, 2 information, 1 debug. -- cgit v1.2.3 From 50311f338f2b68336d9197502d039fb5cf718906 Mon Sep 17 00:00:00 2001 From: John Kehayias Date: Tue, 15 Feb 2022 20:09:09 -0500 Subject: doc: Fix 'setuid-program' example. %setuid-programs was previously moved to be in the list sexp instead of just the append one. This causes an "invalid G-expression input" error. Error reported by: Kolev on #guix. * doc/guix.texi (Setuid Programs): Move %setuid-programs out to the append sexp. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 528760d7f6..2a08fa05a5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -34592,8 +34592,8 @@ previous example to your operating system declaration by appending it to ;; Some fields omitted... (setuid-programs (append (list (setuid-program - (program (file-append nfs-utils "/sbin/mount.nfs"))) - %setuid-programs)))) + (program (file-append nfs-utils "/sbin/mount.nfs")))) + %setuid-programs))) @end lisp @deftp {Data Type} setuid-program -- cgit v1.2.3 From ed17082d94bdcdb67713e95d181061d179299aad Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Fri, 25 Feb 2022 17:13:12 +0100 Subject: services: agetty: Add shepherd-requirement. * gnu/services/base.scm (): Add shepherd-requirement. * doc/guix.texi (agetty-configuration): Document it. --- doc/guix.texi | 4 ++++ gnu/services/base.scm | 8 ++++++-- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 2a08fa05a5..05c260d792 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16738,6 +16738,10 @@ This option accepts, as an integer, the nice value with which to run the This option provides an ``escape hatch'' for the user to provide arbitrary command-line arguments to @command{agetty} as a list of strings. +@item @code{shepherd-requirement} (default: @code{'()}) +The option can be used to provides extra shepherd requirements (for example +@code{'syslogd}) to the respective @code{'term-}* shepherd service. + @end table @end deftp diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 4c8a840156..308940ff14 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -876,6 +876,8 @@ (define-record-type* ;; "Escape hatch" for passing arbitrary command-line arguments. (extra-options agetty-extra-options ;list of strings (default '())) + (shepherd-requirement agetty-shepherd-requirement ;list of SHEPHERD requirements + (default '())) ;;; XXX Unimplemented for now! ;;; (issue-file agetty-issue-file ;file-like ;;; (default #f)) @@ -924,7 +926,8 @@ (define agetty-shepherd-service host no-issue? init-string no-clear? local-line extract-baud? skip-login? no-newline? login-options chroot hangup? keep-baud? timeout detect-case? wait-cr? no-hints? no-hostname? long-hostname? - erase-characters kill-characters chdir delay nice extra-options) + erase-characters kill-characters chdir delay nice extra-options + shepherd-requirement) (list (shepherd-service (documentation "Run agetty on a tty.") @@ -934,7 +937,8 @@ (define agetty-shepherd-service ;; service to be done. Also wait for udev essentially so that the tty ;; text is not lost in the middle of kernel messages (see also ;; mingetty-shepherd-service). - (requirement '(user-processes host-name udev)) + (requirement (cons* 'user-processes 'host-name 'udev + shepherd-requirement)) (modules '((ice-9 match) (gnu build linux-boot))) (start -- cgit v1.2.3 From 60cb647a2807c4ff1ec3eeae589bb985fe7bde28 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Mon, 31 Jan 2022 14:17:51 -0500 Subject: services: pulseaudio: Add an extra-script-files configuration field. * gnu/services/sound.scm () [extra-script-files]: Add field. (extra-script-files->file-union): New procedure. (append-include-directive): Likewise. (pulseaudio-etc): Use them. * doc/guix.texi: Document the new 'extra-script-files- configuration field. --- doc/guix.texi | 35 ++++++++++++++++++++++++++++++- gnu/services/sound.scm | 57 +++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 88 insertions(+), 4 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 05c260d792..a6437729ff 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21511,11 +21511,44 @@ List of settings to set in @file{daemon.conf}, formatted just like @var{client-conf}. @item @code{script-file} (default: @code{(file-append pulseaudio "/etc/pulse/default.pa")}) -Script file to use as @file{default.pa}. +Script file to use as @file{default.pa}. In case the +@code{extra-script-files} field below is used, an @code{.include} +directive pointing to @file{/etc/pulse/default.pa.d} is appended to the +provided script. + +@item @code{extra-script-files} (default: @code{'())}) +A list of file-like objects defining extra PulseAudio scripts to run at +the initialization of the @command{pulseaudio} daemon, after the main +@code{script-file}. The scripts are deployed to the +@file{/etc/pulse/default.pa.d} directory; they should have the +@samp{.pa} file name extension. For a reference of the available +commands, refer to @command{man pulse-cli-syntax}. @item @code{system-script-file} (default: @code{(file-append pulseaudio "/etc/pulse/system.pa")}) Script file to use as @file{system.pa}. @end table + +The example below sets the default PulseAudio card profile, the default +sink and the default source to use for a old SoundBlaster Audigy sound +card: +@lisp +(pulseaudio-configuration + (extra-script-files + (list (plain-file "audigy.pa" + (string-append "\ +set-card-profile alsa_card.pci-0000_01_01.0 \ + output:analog-surround-40+input:analog-mono +set-default-source alsa_input.pci-0000_01_01.0.analog-mono +set-default-sink alsa_output.pci-0000_01_01.0.analog-surround-40\n"))))) +@end lisp + +Note that @code{pulseaudio-service-type} is part of +@code{%desktop-services}; if your operating system declaration was +derived from one of the desktop templates, you'll want to adjust the +above example to modify the existing @code{pulseaudio-service-type} via +@code{modify-services} (@pxref{Service Reference, +@code{modify-services}}), instead of defining a new one. + @end deftp @deffn {Scheme Variable} ladspa-service-type diff --git a/gnu/services/sound.scm b/gnu/services/sound.scm index 9684e06d13..fca6f13dc5 100644 --- a/gnu/services/sound.scm +++ b/gnu/services/sound.scm @@ -26,14 +26,17 @@ (define-module (gnu services sound) #:use-module (gnu services) #:use-module (gnu system pam) #:use-module (gnu system shadow) + #:use-module (guix diagnostics) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix store) + #:use-module (guix ui) #:use-module (gnu packages audio) #:use-module (gnu packages linux) #:use-module (gnu packages pulseaudio) #:use-module (ice-9 match) + #:use-module (srfi srfi-1) #:export (alsa-configuration alsa-service-type @@ -125,6 +128,8 @@ (define-record-type* (default '((flat-volumes . no)))) (script-file pulseaudio-configuration-script-file (default (file-append pulseaudio "/etc/pulse/default.pa"))) + (extra-script-files pulseaudio-configuration-extra-script-files + (default '())) (system-script-file pulseaudio-configuration-system-script-file (default (file-append pulseaudio "/etc/pulse/system.pa")))) @@ -145,14 +150,60 @@ (define pulseaudio-environment ("PULSE_CLIENTCONFIG" . ,(apply mixed-text-file "client.conf" (map pulseaudio-conf-entry client-conf))))))) +(define (extra-script-files->file-union extra-script-files) + "Return a G-exp obtained by processing EXTRA-SCRIPT-FILES with FILE-UNION." + + (define (file-like->name file) + (match file + ((? local-file?) + (local-file-name file)) + ((? plain-file?) + (plain-file-name file)) + ((? computed-file?) + (computed-file-name file)) + (_ (leave (G_ "~a is not a local-file, plain-file or \ +computed-file object~%") file)))) + + (define (assert-pulseaudio-script-file-name name) + (unless (string-suffix? ".pa" name) + (leave (G_ "`~a' lacks the required `.pa' file name extension~%") name)) + name) + + (let ((labels (map (compose assert-pulseaudio-script-file-name + file-like->name) + extra-script-files))) + (file-union "default.pa.d" (zip labels extra-script-files)))) + +(define (append-include-directive script-file) + "Append an include directive to source scripts under /etc/pulse/default.pa.d." + (computed-file "default.pa" + #~(begin + (use-modules (ice-9 textual-ports)) + (define script-text + (call-with-input-file #$script-file get-string-all)) + (call-with-output-file #$output + (lambda (port) + (format port (string-append script-text " +### Added by Guix to include scripts specified in extra-script-files. +.nofail +.include /etc/pulse/default.pa.d~%"))))))) + (define pulseaudio-etc (match-lambda - (($ _ _ default-script-file system-script-file) + (($ _ _ default-script-file extra-script-files + system-script-file) `(("pulse" ,(file-union "pulse" - `(("default.pa" ,default-script-file) - ("system.pa" ,system-script-file)))))))) + `(("default.pa" + ,(if (null? extra-script-files) + default-script-file + (append-include-directive default-script-file))) + ("system.pa" ,system-script-file) + ,@(if (null? extra-script-files) + '() + `(("default.pa.d" ,(extra-script-files->file-union + extra-script-files))))))))))) (define pulseaudio-service-type (service-type -- cgit v1.2.3 From bc8bea1739294f2c939f3dbb663d834a4d1d5856 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 14 Feb 2022 16:27:52 +0100 Subject: pull: '--news' no longer shows package lists. * guix/scripts/pull.scm (display-channel-news): Return #t when news were displayed. (display-news): Add #:profile-news? parameter and honor it. Print something there were no news. (process-query): For 'display-news', call 'display-channel-news' directly. * doc/guix.texi (Invoking guix pull): Adjust accordingly. --- doc/guix.texi | 17 +++---- guix/scripts/pull.scm | 126 ++++++++++++++++++++++++++++---------------------- 2 files changed, 79 insertions(+), 64 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index a6437729ff..7596b0567b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4486,13 +4486,13 @@ information. @cindex channel news @item --news @itemx -N -Display the list of packages added or upgraded since the previous -generation, as well as, occasionally, news written by channel authors -for their users (@pxref{Channels, Writing Channel News}). +Display news written by channel authors for their users for changes made +since the previous generation (@pxref{Channels, Writing Channel News}). +When @option{--details} is passed, additionally display new and upgraded +packages. -The package information is the same as displayed upon @command{guix -pull} completion, but without ellipses; it is also similar to the output -of @command{guix pull -l} for the last generation (see below). +You can view that information for previous generations with +@command{guix pull -l}. @item --list-generations[=@var{pattern}] @itemx -l [@var{pattern}] @@ -4507,8 +4507,9 @@ revision as well as the corresponding news entries. If you pass upgraded in each generation compared to the previous one. @item --details -Instruct @option{--list-generations} to display more information about -the differences between subsequent generations---see above. +Instruct @option{--list-generations} or @option{--news} to display more +information about the differences between subsequent generations---see +above. @item --roll-back @cindex rolling back diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 205697b3bd..838ff24e9c 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -143,14 +143,10 @@ (define %options (option '("details") #f #f (lambda (opt name arg result) (alist-cons 'details? #t - (match (find (match-lambda - (('query 'list-generations _) - #t) - (_ #f)) - result) - (#t result) - (#f (cons `(query list-generations #f) - result)))))) + (if (assoc-ref result 'query) + result + (cons `(query list-generations #f) + result))))) (option '("roll-back") #f #f (lambda (opt name arg result) (cons '(generation roll-back) @@ -165,7 +161,8 @@ (define %options result))) (option '(#\N "news") #f #f (lambda (opt name arg result) - (cons '(query display-news) result))) + (cons '(query display-news) + (alist-delete 'query result)))) (option '("url") #t #f (lambda (opt name arg result) (alist-cons 'repository-url arg @@ -352,45 +349,48 @@ (define* (display-channel-news profile (previous (and=> (relative-generation profile -1) (cut generation-file-name profile <>)))) - "Display news about the channels of PROFILE compared to PREVIOUS." - (when previous - (let ((old-channels (profile-channels previous)) - (new-channels (profile-channels profile))) - (and (pair? old-channels) (pair? new-channels) - (begin - (match (lset-difference channel=? new-channels old-channels) - (() - #t) - (new - (let ((count (length new))) - (format (current-error-port) - (N_ " ~a new channel:~%" - " ~a new channels:~%" count) - count) - (for-each display-channel new)))) - (match (lset-difference channel=? old-channels new-channels) - (() - #t) - (removed - (let ((count (length removed))) - (format (current-error-port) - (N_ " ~a channel removed:~%" - " ~a channels removed:~%" count) - count) - (for-each display-channel removed)))) - - ;; Display channel-specific news for those channels that were - ;; here before and are still around afterwards. - (for-each (match-lambda - ((new old) - (display-channel-specific-news new old))) - (filter-map (lambda (new) - (define old - (find (cut channel=? new <>) - old-channels)) - - (and old (list new old))) - new-channels))))))) + "Display news about the channels of PROFILE compared to PREVIOUS. Return +true if news were displayed, false otherwise." + (and previous + (let ((old-channels (profile-channels previous)) + (new-channels (profile-channels profile))) + (and (pair? old-channels) (pair? new-channels) + (begin + (match (lset-difference channel=? new-channels old-channels) + (() + #t) + (new + (let ((count (length new))) + (format (current-error-port) + (N_ " ~a new channel:~%" + " ~a new channels:~%" count) + count) + (for-each display-channel new)))) + (match (lset-difference channel=? old-channels new-channels) + (() + #t) + (removed + (let ((count (length removed))) + (format (current-error-port) + (N_ " ~a channel removed:~%" + " ~a channels removed:~%" count) + count) + (for-each display-channel removed)))) + + ;; Display channel-specific news for those channels that were + ;; here before and are still around afterwards. + (fold (match-lambda* + (((new old) news?) + (or (display-channel-specific-news new old) + news?))) + #f + (filter-map (lambda (new) + (define old + (find (cut channel=? new <>) + old-channels)) + + (and old (list new old))) + new-channels))))))) (define* (display-channel-news-headlines profile) "Display the titles of news about the channels of PROFILE compared to its @@ -421,13 +421,26 @@ (define more? (any ->bool more?)))))) -(define (display-news profile) - ;; Display profile news, with the understanding that this process represents - ;; the newest generation. - (display-profile-news profile - #:current-is-newer? #t) - - (display-channel-news profile)) +(define* (display-news profile #:key (profile-news? #f)) + "Display channel news for PROFILE compared to its previous generation. When +PROFILE-NEWS? is true, display the list of added/upgraded packages since the +previous generation." + (define previous + (relative-generation profile -1)) + + (if previous + (begin + (when profile-news? + (display-profile-news profile + #:current-is-newer? #t)) + + (unless (display-channel-news profile + (generation-file-name profile previous)) + (info (G_ "no channel news since generation ~a~%") previous) + (display-hint (G_ "Run @command{guix pull -l} to view the +news for earlier generations.")))) + (leave (G_ "profile ~a does not have a previous generation~%") + profile))) (define* (build-and-install instances profile) "Build the tool from SOURCE, and install it in PROFILE. When DRY-RUN? is @@ -698,7 +711,8 @@ (define (list-generations profile numbers) (lambda () (list-generations profile numbers)))))))))) (('display-news) - (display-news profile)))) + (display-news profile + #:profile-news? (assoc-ref opts 'details?))))) (define (process-generation-change opts profile) "Process a request to change the current generation (roll-back, switch, delete)." -- cgit v1.2.3 From 61a847187d781bcecdc77fbec1fb75d1b9531e55 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sat, 26 Feb 2022 23:06:24 -0500 Subject: gnu: glibc-utf8-locales: Hide the package. This package has a long history of confusing users, due to containing only a small, arbitrary subset of UTF-8 locales. * gnu/packages/base.scm (glibc-utf8-locales): Define as a hidden package. * doc/guix.texi (Application Setup): Do not mention glibc-utf8-locales. Instead, provide an example for defining a custom locales package. --- doc/guix.texi | 20 ++++++++++++++++++-- gnu/packages/base.scm | 3 ++- 2 files changed, 20 insertions(+), 3 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 7596b0567b..1e8b23ad7e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1867,8 +1867,24 @@ $ export GUIX_LOCPATH=$HOME/.guix-profile/lib/locale Note that the @code{glibc-locales} package contains data for all the locales supported by the GNU@tie{}libc and weighs in at around -917@tie{}MiB@. Alternatively, the @code{glibc-utf8-locales} is smaller but -limited to a few UTF-8 locales. +930@tie{}MiB@footnote{The size of the @code{glibc-locales} package is +reduced down to about 213@tie{}MiB with store deduplication and further +down to about 67@tie{}MiB when using a zstd-compressed Btrfs file +system.}. If you only need a few locales, you can define your custom +locales package via the @code{make-glibc-utf8-locales} procedure from +the @code{(gnu packages base)} module. The following example defines a +package containing the various Canadian UTF-8 locales known to the +GNU@tie{}libc, that weighs around 14@tie{}MiB: + +@lisp +(use-modules (gnu packages base)) + +(define my-glibc-locales + (make-glibc-utf8-locales + glibc + #:locales (list "en_CA" "fr_CA" "ik_CA" "iu_CA" "shs_CA") + #:name "glibc-canadian-utf8-locales")) +@end lisp The @env{GUIX_LOCPATH} variable plays a role similar to @env{LOCPATH} (@pxref{Locale Names, @env{LOCPATH},, libc, The GNU C Library Reference diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 76a65f25b3..419ab6906a 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -1171,7 +1171,8 @@ (define file (define-public glibc-locales (make-glibc-locales glibc)) (define-public glibc-utf8-locales - (make-glibc-utf8-locales glibc)) + (hidden-package + (make-glibc-utf8-locales glibc))) ;; Packages provided to ease use of binaries linked against the previous libc. (define-public glibc-locales-2.29 -- cgit v1.2.3 From 0dc019e19a23fea614be5623360849ab9bc35e74 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 17 Feb 2022 23:28:07 -0500 Subject: initrd: Use non-hyphenated kernel command-line parameter names. This is to make it less surprising, given the common convention sets forth by the kernel Linux command-line parameters. * gnu/build/linux-boot.scm (boot-system): Rename '--load', '--repl', '--root' and '--system' to 'gnu.load', 'gnu.repl', 'root' and 'gnu.system', respectively. Adjust doc. (find-long-option): Adjust doc. * gnu/installer/parted.scm (installer-root-partition-path): Adjust accordingly. * gnu/system.scm (bootable-kernel-arguments): Add a VERSION argument and update doc. Use VERSION to conditionally return old style vs new style initrd arguments. (%boot-parameters-version): Increment to 1. (operating-system-boot-parameters): Adjust doc. (operating-system-boot-parameters-file): Likewise. * gnu/system/linux-initrd.scm (raw-initrd, base-initrd): Likewise. * doc/guix.texi: Adjust doc. * gnu/build/activation.scm (boot-time-system): Adjust accordingly. * gnu/build/hurd-boot.scm (boot-hurd-system): Likewise. * gnu/packages/commencement.scm (%final-inputs-riscv64): Adjust comment. --- doc/guix.texi | 12 +++++------ gnu/build/activation.scm | 4 ++-- gnu/build/hurd-boot.scm | 12 +++++------ gnu/build/linux-boot.scm | 31 ++++++++++++++-------------- gnu/installer/parted.scm | 2 +- gnu/machine/ssh.scm | 5 +++-- gnu/packages/commencement.scm | 4 ++-- gnu/system.scm | 48 ++++++++++++++++++++++++++++--------------- gnu/system/linux-initrd.scm | 4 ++-- 9 files changed, 69 insertions(+), 53 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 1e8b23ad7e..ce44eb3b47 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -34959,7 +34959,7 @@ honors several options passed on the Linux kernel command line @code{-append} option of QEMU), notably: @table @code -@item --load=@var{boot} +@item gnu.load=@var{boot} Tell the initial RAM disk to load @var{boot}, a file containing a Scheme program, once it has mounted the root file system. @@ -34967,7 +34967,7 @@ Guix uses this option to yield control to a boot program that runs the service activation programs and then spawns the GNU@tie{}Shepherd, the initialization system. -@item --root=@var{root} +@item root=@var{root} Mount @var{root} as the root file system. @var{root} can be a device name like @code{/dev/sda1}, a file system label, or a file system UUID. When unspecified, the device name from the root file system of the @@ -34992,7 +34992,7 @@ or @code{preen} to repair problems considered safe to repair automatically. @code{preen} is the default if this option is not present or if @var{level} is not one of the above. -@item --system=@var{system} +@item gnu.system=@var{system} Have @file{/run/booted-system} and @file{/run/current-system} point to @var{system}. @@ -35004,7 +35004,7 @@ Instruct the initial RAM disk as well as the @command{modprobe} command must be a comma-separated list of module names---e.g., @code{usbkbd,9pnet}. -@item --repl +@item gnu.repl Start a read-eval-print loop (REPL) from the initial RAM disk before it tries to load kernel modules and to mount the root file system. Our marketing team calls it @dfn{boot-to-Guile}. The Schemer in you will @@ -35025,7 +35025,7 @@ here is how to use it and customize it further. [#:helper-packages '()] [#:qemu-networking? #f] [#:volatile-root? #f] Return a derivation that builds a raw initrd. @var{file-systems} is a list of file systems to be mounted by the initrd, possibly in addition to -the root file system specified on the kernel command line via @option{--root}. +the root file system specified on the kernel command line via @option{root}. @var{linux-modules} is a list of kernel modules to be loaded at boot time. @var{mapped-devices} is a list of device mappings to realize before @var{file-systems} are mounted (@pxref{Mapped Devices}). @@ -35055,7 +35055,7 @@ to it are lost. Return as a file-like object a generic initrd, with kernel modules taken from @var{linux}. @var{file-systems} is a list of file-systems to be mounted by the initrd, possibly in addition to the root file system specified -on the kernel command line via @option{--root}. @var{mapped-devices} is a list of device +on the kernel command line via @option{root}. @var{mapped-devices} is a list of device mappings to realize before @var{file-systems} are mounted. When true, @var{keyboard-layout} is a @code{} record denoting diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 9f6126023c..10c9045740 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -389,8 +389,8 @@ (define %current-system "/run/current-system") (define (boot-time-system) - "Return the '--system' argument passed on the kernel command line." - (find-long-option "--system" (if (string-contains %host-type "linux-gnu") + "Return the 'gnu.system' argument passed on the kernel command line." + (find-long-option "gnu.system" (if (string-contains %host-type "linux-gnu") (linux-command-line) (command-line)))) diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm index ac36bd17d4..ad3c50d61e 100644 --- a/gnu/build/hurd-boot.scm +++ b/gnu/build/hurd-boot.scm @@ -254,7 +254,7 @@ (define* (boot-hurd-system #:key (on-error 'debug)) "This procedure is meant to be called from an early RC script. Install the relevant passive translators on the first boot. Then, run system -activation by using the kernel command-line options '--system' and '--load'; +activation by using the kernel command-line options 'gnu.system' and 'gnu.load'; starting the Shepherd. XXX TODO: see linux-boot.scm:boot-system. @@ -265,14 +265,14 @@ (define* (boot-hurd-system #:key (on-error 'debug)) " (display "Welcome, this is GNU's early boot Guile.\n") - (display "Use '--repl' for an initrd REPL.\n\n") + (display "Use 'gnu.repl' for an initrd REPL.\n\n") (call-with-error-handling (lambda () (let* ((args (command-line)) - (system (find-long-option "--system" args)) - (to-load (find-long-option "--load" args))) + (system (find-long-option "gnu.system" args)) + (to-load (find-long-option "gnu.load" args))) (format #t "Setting-up essential translators...\n") (setenv "PATH" (string-append system "/profile/bin")) @@ -286,7 +286,7 @@ (define* (boot-hurd-system #:key (on-error 'debug)) (unless (zero? (system* "/hurd/mach-defpager")) (format #t "FAILED...Good luck!\n")) - (cond ((member "--repl" args) + (cond ((member "gnu.repl" args) (format #t "Starting repl...\n") (start-repl)) (to-load @@ -298,7 +298,7 @@ (define* (boot-hurd-system #:key (on-error 'debug)) (sleep 2) (reboot)) (else - (display "no boot file passed via '--load'\n") + (display "no boot file passed via 'gnu.load'\n") (display "entering a warm and cozy REPL\n") (start-repl))))) #:on-error on-error)) diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 0ae316849e..cfa1ab2fcb 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016, 2017, 2019–2021 Tobias Geerinckx-Rice ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Guillaume Le Vaillant +;;; Copyright © 2020, 2022 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -93,7 +94,7 @@ (define (linux-command-line) get-string-all))) (define (find-long-option option arguments) - "Find OPTION among ARGUMENTS, where OPTION is something like \"--load\". + "Find OPTION among ARGUMENTS, where OPTION is something like \"gnu.load\". Return the value associated with OPTION, or #f on failure." (let ((opt (string-append option "="))) (and=> (find (cut string-prefix? opt <>) @@ -499,12 +500,12 @@ (define* (boot-system #:key KEYMAP-FILE is true), then setting up QEMU guest networking if QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems specified in MOUNTS, and finally booting into the new root if any. The initrd -supports kernel command-line options '--load', '--root', and '--repl'. It -also honors a subset of the documented Linux kernel command-line parameters -such as 'fsck.mode', 'resume' and 'rootdelay'. +supports kernel command-line parameters 'gnu.load' and 'gnu.repl'. It also +honors a subset of the Linux kernel command-line parameters such as +'fsck.mode', 'resume', 'root' and 'rootdelay'. -Mount the root file system, specified by the '--root' command-line argument, -if any. +Mount the root file system, specified by the 'root' command-line argument, if +any. MOUNTS must be a list of objects. @@ -517,25 +518,25 @@ (define (root-mount-point? fs) (string=? (file-system-mount-point fs) "/")) (define (device-string->file-system-device device-string) - ;; The "--root=SPEC" kernel command-line option always provides a - ;; string, but the string can represent a device, an nfs-root, a UUID, or a - ;; label. So check for all four. + ;; The "root=SPEC" kernel command-line option always provides a string, + ;; but the string can represent a device, an nfs-root, a UUID, or a label. + ;; So check for all four. (cond ((string-prefix? "/" device-string) device-string) ((string-contains device-string ":/") device-string) ; nfs-root ((uuid device-string) => identity) (else (file-system-label device-string)))) (display "Welcome, this is GNU's early boot Guile.\n") - (display "Use '--repl' for an initrd REPL.\n\n") + (display "Use 'gnu.repl' for an initrd REPL.\n\n") (call-with-error-handling (lambda () (mount-essential-file-systems) (let* ((args (linux-command-line)) - (to-load (find-long-option "--load" args)) - ;; If present, ‘--root’ on the kernel command line takes precedence + (to-load (find-long-option "gnu.load" args)) + ;; If present, ‘root’ on the kernel command line takes precedence ;; over the ‘device’ field of the root record. - (root-device (and=> (find-long-option "--root" args) + (root-device (and=> (find-long-option "root" args) device-string->file-system-device)) (root-fs (or (find root-mount-point? mounts) ;; Fall back to fictitious defaults. @@ -564,7 +565,7 @@ (define (repair fs) (_ 'preen)) (file-system-repair fs)))) - (when (member "--repl" args) + (when (member "gnu.repl" args) (start-repl)) (display "loading kernel modules...\n") @@ -652,7 +653,7 @@ (define (repair fs) (sleep 2) (reboot)) (begin - (display "no boot file passed via '--load'\n") + (display "no boot file passed via 'gnu.load'\n") (display "entering a warm and cozy REPL\n") (start-repl))))) #:on-error on-error)) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index e33ef5f8fd..94ef9b42bc 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -348,7 +348,7 @@ (define (remove-logical-devices) (define (installer-root-partition-path) "Return the root partition path, or #f if it could not be detected." (let* ((cmdline (linux-command-line)) - (root (find-long-option "--root" cmdline))) + (root (find-long-option "root" cmdline))) (and root (or (and (access? root F_OK) root) (find-partition-by-label root) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 0dc8933c82..550c989c34 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -422,7 +422,8 @@ (define (read-file path) (let* ((params (call-with-input-string serialized-params read-boot-parameters)) (root (boot-parameters-root-device params)) - (label (boot-parameters-label params))) + (label (boot-parameters-label params)) + (version (boot-parameters-version params))) (boot-parameters (inherit params) (label @@ -433,7 +434,7 @@ (define (read-file path) "~Y-~m-~d ~H:~M")) ")")) (kernel-arguments - (append (bootable-kernel-arguments system-path root) + (append (bootable-kernel-arguments system-path root version) (boot-parameters-kernel-arguments params)))))))) generations)))) diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm index cdc9c1d621..9b495d8d84 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -3740,10 +3740,10 @@ (define-public %final-inputs (define-public %final-inputs-riscv64 ;; This is similar to the added (list gcc "lib") elsewhere in this file, but ;; due to how (%current-system) is re-defined when performing builds with the - ;; '--system' flag, %final-inputs is too early in the evaulation pipeline to + ;; 'gnu.system' flag, %final-inputs is too early in the evaulation pipeline to ;; correctly identify the system for which a derivation will be built. Thus, ;; since (%current-system) is re-determined by (guix build-system gnu) after - ;; loading %final-inputs but before taking into account the '--system' flag, + ;; loading %final-inputs but before taking into account the 'gnu.system' flag, ;; the test for (target-riscv64?) needs to be in (guix build-system gnu), ;; with %final-inputs-riscv64 already available at the same time that ;; %final-inputs is available. diff --git a/gnu/system.scm b/gnu/system.scm index 95c42d33f6..432330c915 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -187,16 +187,23 @@ (define-module (gnu system) ;;; ;;; Code: -(define (bootable-kernel-arguments system root-device) - "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE." - (list (string-append "--root=" +(define* (bootable-kernel-arguments system root-device version) + "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE. +VERSION is the target version of the boot-parameters record." + ;; If the version is newer than 0, we use the new style initrd parameter + ;; names, otherwise we use the legacy ones. This is to maintain backward + ;; compatibility when producing bootloader configurations for older + ;; generations. + (define version>0? (> version 0)) + (list (string-append (if version>0? "root=" "--root=") ;; Note: Always use the DCE format because that's what - ;; (gnu build linux-boot) expects for the '--root' + ;; (gnu build linux-boot) expects for the 'root' ;; kernel command-line option. (file-system-device->string root-device #:uuid-type 'dce)) - #~(string-append "--system=" #$system) - #~(string-append "--load=" #$system "/boot"))) + #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system) + #~(string-append (if #$version>0? "gnu.load=" "--load=") + #$system "/boot"))) ;; System-wide configuration. ;; TODO: Add per-field docstrings/stexi. @@ -286,10 +293,12 @@ (define-record-type* operating-system source-properties->location)) (innate))) -(define (operating-system-kernel-arguments os root-device) - "Return all the kernel arguments, including the ones not specified -directly by the user." - (append (bootable-kernel-arguments os root-device) +(define* (operating-system-kernel-arguments + os root-device #:key (version %boot-parameters-version)) + "Return all the kernel arguments, including the ones not specified directly +by the user. VERSION should match that of the target record +object that will contain the kernel parameters." + (append (bootable-kernel-arguments os root-device version) (operating-system-user-kernel-arguments os))) @@ -297,8 +306,12 @@ (define (operating-system-kernel-arguments os root-device) ;;; Boot parameters ;;; +;;; Version 1 was introduced early 2022 to mark the departure from long option +;;; names such as '--load' to the more conventional initrd option names like +;;; 'gnu.load'. +;;; ;;; When bumping the boot-parameters version, increment it by one (1). -(define %boot-parameters-version 0) +(define %boot-parameters-version 1) (define-record-type* boot-parameters make-boot-parameters boot-parameters? @@ -479,10 +492,11 @@ (define (read-boot-parameters-file system) The object has its kernel-arguments extended in order to make it bootable." (let* ((file (string-append system "/parameters")) (params (call-with-input-file file read-boot-parameters)) - (root (boot-parameters-root-device params))) + (root (boot-parameters-root-device params)) + (version (boot-parameters-version params))) (boot-parameters (inherit params) - (kernel-arguments (append (bootable-kernel-arguments system root) + (kernel-arguments (append (bootable-kernel-arguments system root version) (boot-parameters-kernel-arguments params)))))) (define (boot-parameters->menu-entry conf) @@ -1453,10 +1467,10 @@ (define (hurd-multiboot-modules os) (define* (operating-system-boot-parameters os root-device #:key system-kernel-arguments?) "Return a monadic record that describes the boot -parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments -such as '--root' and '--load' to . The -SYSTEM-KERNEL-ARGUMENTS? should only be used in necessity, as the '--load' and -'--system' values are self-referential (they refer to the system), thus +parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add the kernel +arguments 'root', 'gnu.load' and 'gnu.system' to . The +SYSTEM-KERNEL-ARGUMENTS? should only be used in necessity, as the 'gnu.load' +and 'gnu.system' values are self-referential (they refer to the system), thus susceptible to introduce a cyclic dependency." (let* ((initrd (and (not (operating-system-hurd os)) (operating-system-initrd-file os))) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 329cd38cd6..4c4c78e444 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -181,7 +181,7 @@ (define* (raw-initrd file-systems "Return as a file-like object a raw initrd, with kernel modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be mounted by the initrd, possibly in addition to the root file system specified -on the kernel command line via '--root'. LINUX-MODULES is a list of kernel +on the kernel command line via 'root'. LINUX-MODULES is a list of kernel modules to be loaded at boot time. MAPPED-DEVICES is a list of device mappings to realize before FILE-SYSTEMS are mounted. HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include @@ -375,7 +375,7 @@ (define* (base-initrd file-systems "Return as a file-like object a generic initrd, with kernel modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be mounted by the initrd, possibly in addition to the root file system specified -on the kernel command line via '--root'. MAPPED-DEVICES is a list of device +on the kernel command line via 'root'. MAPPED-DEVICES is a list of device mappings to realize before FILE-SYSTEMS are mounted. When true, KEYBOARD-LAYOUT is a record denoting the desired -- cgit v1.2.3 From 6d9d616113cf051d80567b584a5b0a6489ddc065 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 18 Feb 2022 00:09:05 -0500 Subject: initrd: Honor rootfstype and rootflags command-line parameters. * gnu/build/linux-boot.scm (boot-system): Honor rootfstype and rootflags arguments. Update doc. Error out in case there is insufficient information with regard to the root file system. Restore the behavior of inferring the root device from the root file system from the operating system in case the root argument is not provided. * doc/guix.texi (Initial RAM Disk): Document the new command-line parameters. --- doc/guix.texi | 10 +++++++++ gnu/build/linux-boot.scm | 55 +++++++++++++++++++++++++++++++----------------- 2 files changed, 46 insertions(+), 19 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index ce44eb3b47..dc6cb9842e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -34973,6 +34973,16 @@ name like @code{/dev/sda1}, a file system label, or a file system UUID. When unspecified, the device name from the root file system of the operating system declaration is used. +@item rootfstype=@var{type} +Set the type of the root file system. It overrides the @code{type} +field of the root file system specified via the @code{operating-system} +declaration, if any. + +@item rootflags=@var{options} +Set the mount @emph{options} of the root file system. It overrides the +@code{options} field of the root file system specified via the +@code{operating-system} declaration, if any. + @item fsck.mode=@var{mode} Whether to check the @var{root} file system for errors before mounting it. @var{mode} is one of @code{skip} (never check), @code{force} (always diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index cfa1ab2fcb..7d41537652 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -500,9 +500,9 @@ (define* (boot-system #:key KEYMAP-FILE is true), then setting up QEMU guest networking if QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems specified in MOUNTS, and finally booting into the new root if any. The initrd -supports kernel command-line parameters 'gnu.load' and 'gnu.repl'. It also +supports the kernel command-line options 'gnu.load' and 'gnu.repl'. It also honors a subset of the Linux kernel command-line parameters such as -'fsck.mode', 'resume', 'root' and 'rootdelay'. +'fsck.mode', 'resume', 'rootdelay', rootflags and rootfstype. Mount the root file system, specified by the 'root' command-line argument, if any. @@ -538,13 +538,30 @@ (define (device-string->file-system-device device-string) ;; over the ‘device’ field of the root record. (root-device (and=> (find-long-option "root" args) device-string->file-system-device)) - (root-fs (or (find root-mount-point? mounts) - ;; Fall back to fictitious defaults. - (file-system (device (or root-device "/dev/root")) - (mount-point "/") - (type "ext4")))) + (rootfstype (find-long-option "rootfstype" args)) + (rootflags (find-long-option "rootflags" args)) + (root-fs* (find root-mount-point? mounts)) (fsck.mode (find-long-option "fsck.mode" args))) + (unless (or root-fs* (and root-device rootfstype)) + (error "no root file system or 'root' and 'rootfstype' parameters")) + + ;; If present, ‘root’ on the kernel command line takes precedence over + ;; the ‘device’ field of the root record; likewise for + ;; the 'rootfstype' and 'rootflags' arguments. + (define root-fs + (if root-fs* + (file-system + (inherit root-fs*) + (device (or root-device (file-system-device root-fs*))) + (type (or rootfstype (file-system-type root-fs*))) + (options (or rootflags (file-system-options root-fs*)))) + (file-system + (device root-device) + (mount-point "/") + (type rootfstype) + (options rootflags)))) + (define (check? fs) (match fsck.mode ("skip" #f) @@ -616,18 +633,18 @@ (define (repair fs) (setenv "EXT2FS_NO_MTAB_OK" "1") - (if root-device - (mount-root-file-system (canonicalize-device-spec root-device) - (file-system-type root-fs) - #:volatile-root? volatile-root? - #:flags (mount-flags->bit-mask - (file-system-flags root-fs)) - #:options (file-system-options root-fs) - #:check? (check? root-fs) - #:skip-check-if-clean? - (skip-check-if-clean? root-fs) - #:repair (repair root-fs)) - (mount "none" "/root" "tmpfs")) + ;; Mount the root file system. + (mount-root-file-system (canonicalize-device-spec + (file-system-device root-fs)) + (file-system-type root-fs) + #:volatile-root? volatile-root? + #:flags (mount-flags->bit-mask + (file-system-flags root-fs)) + #:options (file-system-options root-fs) + #:check? (check? root-fs) + #:skip-check-if-clean? + (skip-check-if-clean? root-fs) + #:repair (repair root-fs)) ;; Mount the specified non-root file systems. (for-each (lambda (fs) -- cgit v1.2.3 From f0efa6afc5f180f778eb320631a71f42bf1b211f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 2 Mar 2022 10:44:35 +0100 Subject: doc: Add "Using TeX and LaTeX" chapter. * doc/guix.texi (Using TeX and LaTeX): New node. --- doc/guix.texi | 142 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 142 insertions(+) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index dc6cb9842e..b83871bf0e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -175,6 +175,7 @@ Weblate} (@pxref{Translating Guix}). * Home Configuration:: Configuring the home environment. * Documentation:: Browsing software user manuals. * Installing Debugging Files:: Feeding the debugger. +* Using TeX and LaTeX:: Typesetting. * Security Updates:: Deploying security fixes quickly. * Bootstrapping:: GNU/Linux built from scratch. * Porting:: Targeting another platform or kernel. @@ -38632,6 +38633,147 @@ Note that there can be packages for which @option{--with-debug-info} will not have the desired effect. @xref{Package Transformation Options, @option{--with-debug-info}}, for more information. +@node Using TeX and LaTeX +@chapter Using @TeX{} and @LaTeX{} + +@cindex @TeX{} packages +@cindex @LaTeX{} packages +Guix provides packages for the @TeX{}, @LaTeX{}, ConTeXt, LuaTeX, and +related typesetting systems, taken from the +@uref{https://www.tug.org/texlive/, @TeX{} Live distribution}. However, +because @TeX{} Live is so huge and because finding your way in this maze +is tricky, we thought that you, dear user, would welcome guidance on how +to deploy the relevant packages so you can compile your @TeX{} and +@LaTeX{} documents. + +@TeX{} Live currently comes in two flavors in Guix: + +@itemize +@item +The ``monolithic'' @code{texlive} package: it comes with @emph{every +single @TeX{} Live package} (more than 7,000 of them), but it is huge +(more than 4@tie{}GiB for a single package!). + +@item +The ``modular'' @code{texlive-} packages: you install +@code{texlive-base}, which provides core functionality and the main +commands---@command{pdflatex}, @command{dvips}, @command{luatex}, +@command{mf}, etc.---together with individual packages that provide just +the features you need---@code{texlive-listings} for the +@code{listings} package, @code{texlive-hyperref} for @code{hyperref}, +@code{texlive-beamer} for Beamer, @code{texlive-pgf} for PGF/TikZ, +and so on. +@end itemize + +We recommend using the modular package set because it is much less +resource-hungry. To build your documents, you would use commands such +as: + +@example +guix shell texlive-base texlive-wrapfig \ + texlive-hyperref texlive-cm-super -- pdflatex doc.tex +@end example + +You can quickly end up with unreasonably long command lines though. The +solution is to instead write a manifest, for example like this one: + +@lisp +(specifications->manifest + '("rubber" + + "texlive-base" + "texlive-wrapfig" + + "texlive-microtype" + "texlive-listings" "texlive-hyperref" + + ;; PGF/TikZ + "texlive-pgf" + + ;; Additional fonts. + "texlive-cm-super" "texlive-amsfonts" + "texlive-times" "texlive-helvetic" "texlive-courier")) +@end lisp + +You can then pass it to any command with the @option{-m} option: + +@example +guix shell -m manifest.scm -- pdflatex doc.tex +@end example + +@xref{Invoking guix package, @option{--manifest}}, for more on +manifests. In the future, we plan to provide packages for @TeX{} Live +@dfn{collections}---``meta-packages'' such as @code{fontsrecommended}, +@code{humanities}, or @code{langarabic} that provide the set of packages +needed in this particular domain. That will allow you to list fewer +packages. + +The main difficulty here is that using the modular package set forces +you to select precisely the packages that you need. You can use +@command{guix search}, but finding the right package can prove to be +tedious. When a package is missing, @command{pdflatex} and similar +commands fail with an obscure message along the lines of: + +@example +doc.tex: File `tikz.sty' not found. +doc.tex:7: Emergency stop. +@end example + +@noindent +or, for a missing font: + +@example +kpathsea: Running mktexmf phvr7t +! I can't find file `phvr7t'. +@end example + +How do you determine what the missing package is? In the first case, +you'll find the answer by running: + +@example +$ guix search texlive tikz +name: texlive-pgf +version: 59745 +@dots{} +@end example + +In the second case, @command{guix search} turns up nothing. Instead, +you can search the @TeX{} Live package database using the @command{tlmgr} +command: + +@example +$ guix shell texlive-base -- tlmgr info phvr7t +tlmgr: cannot find package phvr7t, searching for other matches: + +Packages containing `phvr7t' in their title/description: + +Packages containing files matching `phvr7t': +helvetic: + texmf-dist/fonts/tfm/adobe/helvetic/phvr7t.tfm + texmf-dist/fonts/tfm/adobe/helvetic/phvr7tn.tfm + texmf-dist/fonts/vf/adobe/helvetic/phvr7t.vf + texmf-dist/fonts/vf/adobe/helvetic/phvr7tn.vf +tex4ht: + texmf-dist/tex4ht/ht-fonts/alias/adobe/helvetic/phvr7t.htf +@end example + +The file is available in the @TeX{} Live @code{helvetic} package, which is +known in Guix as @code{texlive-helvetic}. Quite a ride, but we found +it! + +There is one important limitation though: Guix currently provides a +subset of the @TeX{} Live packages. If you stumble upon a missing +package, you can try and import it (@pxref{Invoking guix import}): + +@example +guix import texlive @var{package} +@end example + +@quotation Note +@TeX{} Live packaging is still very much work in progress, but you can +help! @xref{Contributing}, for more information. +@end quotation + @node Security Updates @chapter Security Updates -- cgit v1.2.3 From 878578c0faaa97edebe506bc96a3db955983c95f Mon Sep 17 00:00:00 2001 From: Demis Balbach Date: Sun, 19 Dec 2021 17:41:46 +0100 Subject: services: bluetooth: Add missing config parameters. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Desktop Services): Document 'bluetooth-service-type' and 'bluetooth-configuration'. * gnu/services/desktop.scm (): Add many fields. (bluetooth-configuration-file): Handle them. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 443 ++++++++++++++++++++++++++++++++++++++++++++++- gnu/services/desktop.scm | 376 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 814 insertions(+), 5 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index b83871bf0e..f479fe05ff 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21378,6 +21378,448 @@ bluetooth keyboard or mouse. Users need to be in the @code{lp} group to access the D-Bus service. @end deffn +@deffn {Scheme Variable} bluetooth-service-type +This is the type for the @uref{https://bluez.org/, Linux Bluetooth Protocol +Stack} (BlueZ) system, which generates the @file{/etc/bluetooth/main.conf} +configuration file. The value for this type is a @command{bluetooth-configuration} +record as in this example: + +@lisp +(service bluetooth-service-type) +@end lisp + +See below for details about @code{bluetooth-configuration}. +@end deffn + +@deftp {Data Type} bluetooth-configuration +Data type representing the configuration for @code{bluetooth-service}. + +@table @asis +@item @code{bluez} (default: @code{bluez}) +@code{bluez} package to use. + +@item @code{name} (default: @code{"BlueZ"}) +Default adapter name. + +@item @code{class} (default: @code{#x000000}) +Default device class. Only the major and minor device class bits are considered. + +@item @code{discoverable-timeout} (default: @code{180}) +How long to stay in discoverable mode before going back to non-discoverable. The +value is in seconds. + +@item @code{always-pairable?} (default: @code{#f}) +Always allow pairing even if there are no agents registered. + +@item @code{pairable-timeout} (default: @code{0}) +How long to stay in pairable mode before going back to non-discoverable. The +value is in seconds. + +@item @code{device-id} (default: @code{#f}) +Use vendor id source (assigner), vendor, product and version information for +DID profile support. The values are separated by ":" and @var{assigner}, @var{VID}, +@var{PID} and @var{version}. + +Possible values are: + +@itemize @bullet +@item +@code{#f} to disable it, + +@item +@code{"assigner:1234:5678:abcd"}, where @var{assigner} is either @code{usb} (default) +or @code{bluetooth}. + +@end itemize + +@item @code{reverse-service-discovery?} (default: @code{#t}) +Do reverse service discovery for previously unknown devices that connect to +us. For BR/EDR this option is really only needed for qualification since the +BITE tester doesn't like us doing reverse SDP for some test cases, for LE +this disables the GATT client functionally so it can be used in system which +can only operate as peripheral. + +@item @code{name-resolving?} (default: @code{#t}) +Enable name resolving after inquiry. Set it to @code{#f} if you don't need +remote devices name and want shorter discovery cycle. + +@item @code{debug-keys?} (default: @code{#f}) +Enable runtime persistency of debug link keys. Default is false which makes +debug link keys valid only for the duration of the connection that they were +created for. + +@item @code{controller-mode} (default: @code{'dual}) +Restricts all controllers to the specified transport. @code{'dual} means both +BR/EDR and LE are enabled (if supported by the hardware). + +Possible values are: + +@itemize @bullet +@item +@code{'dual} + +@item +@code{'bredr} + +@item +@code{'le} + +@end itemize + +@item @code{multi-profile} (default: @code{'off}) +Enables Multi Profile Specification support. This allows to specify if system +supports only Multiple Profiles Single Device (MPSD) configuration or both +Multiple Profiles Single Device (MPSD) and Multiple Profiles Multiple Devices +(MPMD) configurations. + +Possible values are: + +@itemize @bullet +@item +@code{'off} + +@item +@code{'single} + +@item +@code{'multiple} + +@end itemize + +@item @code{fast-connectable?} (default: @code{#f}) +Permanently enables the Fast Connectable setting for adapters that support +it. When enabled other devices can connect faster to us, however the +tradeoff is increased power consumptions. This feature will fully work only +on kernel version 4.1 and newer. + +@item @code{privacy} (default: @code{'off}) +Default privacy settings. + +@itemize @bullet +@item +@code{'off}: Disable local privacy + +@item +@code{'network/on}: A device will only accept advertising packets from peer +devices that contain private addresses. It may not be compatible with some +legacy devices since it requires the use of RPA(s) all the time + +@item +@code{'device}: A device in device privacy mode is only concerned about the +privacy of the device and will accept advertising packets from peer devices +that contain their Identity Address as well as ones that contain a private +address, even if the peer device has distributed its IRK in the past + +@end itemize + +and additionally, if @var{controller-mode} is set to @code{'dual}: + +@itemize @bullet +@item +@code{'limited-network}: Apply Limited Discoverable Mode to advertising, which +follows the same policy as to BR/EDR that publishes the identity address when +discoverable, and Network Privacy Mode for scanning + +@item +@code{'limited-device}: Apply Limited Discoverable Mode to advertising, which +follows the same policy as to BR/EDR that publishes the identity address when +discoverable, and Device Privacy Mode for scanning. + +@end itemize + +@item @code{just-works-repairing} (default: @code{'never}) +Specify the policy to the JUST-WORKS repairing initiated by peer. + +Possible values: +@itemize @bullet +@item +@code{'never} + +@item +@code{'confirm} + +@item +@code{'always} + +@end itemize + +@item @code{temporary-timeout} (default: @code{30}) +How long to keep temporary devices around. The value is in seconds. @code{0} +disables the timer completely. + +@item @code{refresh-discovery?} (default: @code{#t}) +Enables the device to issue an SDP request to update known services when +profile is connected. + +@item @code{experimental} (default: @code{#f}) +Enables experimental features and interfaces, alternatively a list of UUIDs +can be given. + +Possible values: + +@itemize @bullet +@item +@code{#t} + +@item +@code{#f} + +@item +@code{(list (uuid ) (uuid ) ...)}. +@end itemize + +List of possible UUIDs: +@itemize @bullet +@item +@code{d4992530-b9ec-469f-ab01-6c481c47da1c}: BlueZ Experimental Debug, + +@item +@code{671b10b5-42c0-4696-9227-eb28d1b049d6}: BlueZ Experimental Simultaneous Central and Peripheral, + +@item +@code{"15c0a148-c273-11ea-b3de-0242ac130004}: BlueZ Experimental LL privacy, + +@item +@code{330859bc-7506-492d-9370-9a6f0614037f}: BlueZ Experimental Bluetooth Quality Report, + +@item +@code{a6695ace-ee7f-4fb9-881a-5fac66c629af}: BlueZ Experimental Offload Codecs. +@end itemize + +@item @code{remote-name-request-retry-delay} (default: @code{300}) +The duration to avoid retrying to resolve a peer's name, if the previous +try failed. + +@item @code{page-scan-type} (default: @code{#f}) +BR/EDR Page scan activity type. + +@item @code{page-scan-interval} (default: @code{#f}) +BR/EDR Page scan activity interval. + +@item @code{page-scan-window} (default: @code{#f}) +BR/EDR Page scan activity window. + +@item @code{inquiry-scan-type} (default: @code{#f}) +BR/EDR Inquiry scan activity type. + +@item @code{inquiry-scan-interval} (default: @code{#f}) +BR/EDR Inquiry scan activity interval. + +@item @code{inquiry-scan-window} (default: @code{#f}) +BR/EDR Inquiry scan activity window. + +@item @code{link-supervision-timeout} (default: @code{#f}) +BR/EDR Link supervision timeout. + +@item @code{page-timeout} (default: @code{#f}) +BR/EDR Page timeout. + +@item @code{min-sniff-interval} (default: @code{#f}) +BR/EDR minimum sniff interval. + +@item @code{max-sniff-interval} (default: @code{#f}) +BR/EDR maximum sniff interval. + +@item @code{min-advertisement-interval} (default: @code{#f}) +LE minimum advertisement interval (used for legacy advertisement only). + +@item @code{max-advertisement-interval} (default: @code{#f}) +LE maximum advertisement interval (used for legacy advertisement only). + +@item @code{multi-advertisement-rotation-interval} (default: @code{#f}) +LE multiple advertisement rotation interval. + +@item @code{scan-interval-auto-connect} (default: @code{#f}) +LE scanning interval used for passive scanning supporting auto connect. + +@item @code{scan-window-auto-connect} (default: @code{#f}) +LE scanning window used for passive scanning supporting auto connect. + +@item @code{scan-interval-suspend} (default: @code{#f}) +LE scanning interval used for active scanning supporting wake from suspend. + +@item @code{scan-window-suspend} (default: @code{#f}) +LE scanning window used for active scanning supporting wake from suspend. + +@item @code{scan-interval-discovery} (default: @code{#f}) +LE scanning interval used for active scanning supporting discovery. + +@item @code{scan-window-discovery} (default: @code{#f}) +LE scanning window used for active scanning supporting discovery. + +@item @code{scan-interval-adv-monitor} (default: @code{#f}) +LE scanning interval used for passive scanning supporting the advertisement monitor APIs. + +@item @code{scan-window-adv-monitor} (default: @code{#f}) +LE scanning window used for passive scanning supporting the advertisement monitor APIs. + +@item @code{scan-interval-connect} (default: @code{#f}) +LE scanning interval used for connection establishment. + +@item @code{scan-window-connect} (default: @code{#f}) +LE scanning window used for connection establishment. + +@item @code{min-connection-interval} (default: @code{#f}) +LE default minimum connection interval. This value is superceeded by any specific +value provided via the Load Connection Parameters interface. + +@item @code{max-connection-interval} (default: @code{#f}) +LE default maximum connection interval. This value is superceeded by any specific +value provided via the Load Connection Parameters interface. + +@item @code{connection-latency} (default: @code{#f}) +LE default connection latency. This value is superceeded by any specific +value provided via the Load Connection Parameters interface. + +@item @code{connection-supervision-timeout} (default: @code{#f}) +LE default connection supervision timeout. This value is superceeded by any specific +value provided via the Load Connection Parameters interface. + +@item @code{autoconnect-timeout} (default: @code{#f}) +LE default autoconnect timeout. This value is superceeded by any specific +value provided via the Load Connection Parameters interface. + +@item @code{adv-mon-allowlist-scan-duration} (default: @code{300}) +Allowlist scan duration during interleaving scan. Only used when scanning for ADV +monitors. The units are msec. + +@item @code{adv-mon-no-filter-scan-duration} (default: @code{500}) +No filter scan duration during interleaving scan. Only used when scanning for ADV +monitors. The units are msec. + +@item @code{enable-adv-mon-interleave-scan?} (default: @code{#t}) +Enable/Disable Advertisement Monitor interleave scan for power saving. + +@item @code{cache} (default: @code{'always}) +GATT attribute cache. + +Possible values are: +@itemize @bullet +@item +@code{'always}: Always cache attributes even for devices not paired, this is +recommended as it is best for interoperability, with more consistent +reconnection times and enables proper tracking of notifications for all +devices + +@item +@code{'yes}: Only cache attributes of paired devices + +@item +@code{'no}: Never cache attributes. +@end itemize + +@item @code{key-size} (default: @code{0}) +Minimum required Encryption Key Size for accessing secured characteristics. + +Possible values are: +@itemize @bullet +@item +@code{0}: Don't care + +@item +@code{7 <= N <= 16} +@end itemize + +@item @code{exchange-mtu} (default: @code{517}) +Exchange MTU size. Possible values are: + +@itemize @bullet +@item +@code{23 <= N <= 517} +@end itemize + +@item @code{att-channels} (default: @code{3}) +Number of ATT channels. Possible values are: + +@itemize @bullet +@item +@code{1}: Disables EATT + +@item +@code{2 <= N <= 5} +@end itemize + +@item @code{session-mode} (default: @code{'basic}) +AVDTP L2CAP signalling channel mode. + +Possible values are: + +@itemize @bullet +@item +@code{'basic}: Use L2CAP basic mode + +@item +@code{'ertm}: Use L2CAP enhanced retransmission mode. +@end itemize + +@item @code{stream-mode} (default: @code{'basic}) +AVDTP L2CAP transport channel mode. + +Possible values are: + +@itemize @bullet +@item +@code{'basic}: Use L2CAP basic mode + +@item +@code{'streaming}: Use L2CAP streaming mode. +@end itemize + +@item @code{reconnect-uuids} (default: @code{'()}) +The ReconnectUUIDs defines the set of remote services that should try +to be reconnected to in case of a link loss (link supervision +timeout). The policy plugin should contain a sane set of values by +default, but this list can be overridden here. By setting the list to +empty the reconnection feature gets disabled. + +Possible values: + +@itemize @bullet +@item +@code{'()} + +@item +@code{(list (uuid ) (uuid ) ...)}. +@end itemize + +@item @code{reconnect-attempts} (default: @code{7}) +Defines the number of attempts to reconnect after a link lost. Setting +the value to 0 disables reconnecting feature. + +@item @code{reconnect-intervals} (default: @code{'(1 2 4 8 16 32 64)}) +Defines a list of intervals in seconds to use in between attempts. If +the number of attempts defined in @var{reconnect-attempts} is bigger than +the list of intervals the last interval is repeated until the last attempt. + +@item @code{auto-enable?} (default: @code{#f}) +Defines option to enable all controllers when they are found. This includes +adapters present on start as well as adapters that are plugged in later on. + +@item @code{resume-delay} (default: @code{2}) +Audio devices that were disconnected due to suspend will be reconnected on +resume. @var{resume-delay} determines the delay between when the controller +resumes from suspend and a connection attempt is made. A longer delay is +better for better co-existence with Wi-Fi. The value is in seconds. + +@item @code{rssi-sampling-period} (default: @code{#xFF}) +Default RSSI Sampling Period. This is used when a client registers an +advertisement monitor and leaves the RSSISamplingPeriod unset. + +Possible values are: +@itemize @bullet +@item +@code{#x0}: Report all advertisements + +@item +@code{N = #xXX}: Report advertisements every N x 100 msec (range: #x01 to #xFE) + +@item +@code{#xFF}: Report only one advertisement per device during monitoring period. +@end itemize + +@end table +@end deftp + @defvr {Scheme Variable} gnome-keyring-service-type This is the type of the service that adds the @uref{https://wiki.gnome.org/Projects/GnomeKeyring, GNOME Keyring}. Its @@ -21412,7 +21854,6 @@ and ``passwd'' is with the value @code{passwd}. @end table @end deftp - @node Sound Services @subsection Sound Services diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index c2ee3a3d80..ecadb16b2f 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -44,6 +44,7 @@ (define-module (gnu services desktop) #:use-module (gnu system) #:use-module (gnu system setuid) #:use-module (gnu system shadow) + #:use-module (gnu system uuid) #:use-module (gnu system pam) #:use-module (gnu packages glib) #:use-module (gnu packages admin) @@ -68,6 +69,7 @@ (define-module (gnu services desktop) #:use-module (guix utils) #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export ( upower-configuration @@ -403,14 +405,380 @@ (define-record-type* bluetooth-configuration make-bluetooth-configuration bluetooth-configuration? (bluez bluetooth-configuration-bluez (default bluez)) - (auto-enable? bluetooth-configuration-auto-enable? (default #f))) + + ;;; [General] + (name bluetooth-configuration-name (default "BlueZ")) + (class bluetooth-configuration-class (default #x000000)) + (discoverable-timeout + bluetooth-configuration-discoverable-timeout (default 180)) + (always-pairable? bluetooth-configuration-always-pairable? (default #f)) + (pairable-timeout bluetooth-configuration-pairable-timeout (default 0)) + + ;;; MAYBE: Exclude into separate record-type? + (device-id bluetooth-configuration-device-id (default #f)) + (reverse-service-discovery? + bluetooth-configuration-reverse-service-discovery (default #t)) + (name-resolving? bluetooth-configuration-name-resolving? (default #t)) + (debug-keys? bluetooth-configuration-debug-keys? (default #f)) + + ;;; Possible values: + ;;; 'dual, 'bredr, 'le + (controller-mode bluetooth-configuration-controller-mode (default 'dual)) + + ;;; Possible values: + ;;; 'off, 'single, 'multiple + (multi-profile bluetooth-configuration-multi-profile (default 'off)) + (fast-connectable? bluetooth-configuration-fast-connectable? (default #f)) + + ;;; Possible values: + ;;; for LE mode: 'off, 'network/on, 'device + ;;; for Dual mode: 'off, 'network/on', 'device, 'limited-network, 'limited-device + ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n68 + (privacy bluetooth-configuration-privacy (default 'off)) + + ;;; Possible values: + ;;; 'never, 'confirm, 'always + (just-works-repairing + bluetooth-configuration-just-works-repairing (default 'never)) + (temporary-timeout bluetooth-configuration-temporary-timeout (default 30)) + (refresh-discovery? bluetooth-configuration-refresh-discovery (default #t)) + + ;;; Possible values: #t, #f, (uuid ) + ;;; Possible UUIDs: + ;;; d4992530-b9ec-469f-ab01-6c481c47da1c (BlueZ Experimental Debug) + ;;; 671b10b5-42c0-4696-9227-eb28d1b049d6 (BlueZ Experimental Simultaneous Central and Peripheral) + ;;; 15c0a148-c273-11ea-b3de-0242ac130004 (BlueZ Experimental LL privacy) + ;;; 330859bc-7506-492d-9370-9a6f0614037f (BlueZ Experimental Bluetooth Quality Report) + ;;; a6695ace-ee7f-4fb9-881a-5fac66c629af (BlueZ Experimental Offload Codecs) + ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n110 + (experimental bluetooth-configuration-experimental (default #f)) + (remote-name-request-retry-delay + bluetooth-configuration-remote-name-request-retry-delay (default 300)) + + ;;; [BR] + (page-scan-type bluetooth-configuration-page-scan-type (default #f)) + (page-scan-interval bluetooth-configuration-page-scan-interval (default #f)) + (page-scan-window bluetooth-configuration-page-scan-window (default #f)) + (inquiry-scan-type bluetooth-configuration-inquiry-scan-type (default #f)) + (inquiry-scan-interval bluetooth-configuration-inquiry-scan-interval (default #f)) + (inquiry-scan-window bluetooth-configuration-inquiry-scan-window (default #f)) + (link-supervision-timeout bluetooth-configuration-link-supervision-timeout (default #f)) + (page-timeout bluetooth-configuration-page-timeout (default #f)) + (min-sniff-interval bluetooth-configuration-min-sniff-interval (default #f)) + (max-sniff-interval bluetooth-configuration-max-sniff-interval (default #f)) + + ;;; [LE] + (min-advertisement-interval + bluetooth-configuration-min-advertisement-interval (default #f)) + (max-advertisement-interval + bluetooth-configuration-max-advertisement-interval (default #f)) + (multi-advertisement-rotation-interval + bluetooth-configuration-multi-advertisement-rotation-interval (default #f)) + (scan-interval-auto-connect + bluetooth-configuration-scan-interval-auto-connect (default #f)) + (scan-window-auto-connect + bluetooth-configuration-scan-window-auto-connect (default #f)) + (scan-interval-suspend + bluetooth-configuration-scan-interval-suspend (default #f)) + (scan-window-suspend + bluetooth-configuration-scan-window-suspend (default #f)) + (scan-interval-discovery + bluetooth-configuration-scan-interval-discovery (default #f)) + (scan-window-discovery + bluetooth-configuration-scan-window-discovery (default #f)) + (scan-interval-adv-monitor + bluetooth-configuration-scan-interval-adv-monitor (default #f)) + (scan-window-adv-monitor + bluetooth-configuration-scan-window-adv-monitor (default #f)) + (scan-interval-connect + bluetooth-configuration-scan-interval-connect (default #f)) + (scan-window-connect + bluetooth-configuration-scan-window-connect (default #f)) + (min-connection-interval + bluetooth-configuration-min-connection-interval (default #f)) + (max-connection-interval + bluetooth-configuration-max-connection-interval (default #f)) + (connection-latency + bluetooth-configuration-connection-latency (default #f)) + (connection-supervision-timeout + bluetooth-configuration-connection-supervision-timeout (default #f)) + (autoconnect-timeout + bluetooth-configuration-autoconnect-timeout (default #f)) + (adv-mon-allowlist-scan-duration + bluetooth-configuration-adv-mon-allowlist-scan-duration (default 300)) + (adv-mon-no-filter-scan-duration + bluetooth-configuration-adv-mon-no-filter-scan-duration (default 500)) + (enable-adv-mon-interleave-scan? + bluetooth-configuration-enable-adv-mon-interleave-scan (default #t)) + + ;;; [GATT] + ;;; Possible values: 'yes, 'no, 'always + (cache bluetooth-configuration-cache (default 'always)) + + ;;; Possible values: 7 ... 16, 0 (don't care) + (key-size bluetooth-configuration-key-size (default 0)) + + ;;; Possible values: 23 ... 517 + (exchange-mtu bluetooth-configuration-exchange-mtu (default 517)) + + ;;; Possible values: 1 ... 5 + (att-channels bluetooth-configuration-att-channels (default 3)) + + ;;; [AVDTP] + ;;; Possible values: 'basic, 'ertm + (session-mode bluetooth-configuration-session-mode (default 'basic)) + + ;;; Possible values: 'basic, 'streaming + (stream-mode bluetooth-configuration-stream-mode (default 'basic)) + + ;;; [Policy] + (reconnect-uuids bluetooth-configuration-reconnect-uuids (default '())) + (reconnect-attempts bluetooth-configuration-reconnect-attempts (default 7)) + (reconnect-intervals bluetooth-configuration-reconnect-intervals + (default (list 1 2 4 8 16 32 64))) + (auto-enable? bluetooth-configuration-auto-enable? (default #f)) + (resume-delay bluetooth-configuration-resume-delay (default 2)) + + ;;; [AdvMon] + ;;; Possible values: + ;;; "0x00", "0xFF", + ;;; "N = 0x00" ... "N = 0xFF" + ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n286 + (rssi-sampling-period bluetooth-configuration-rssi-sampling-period + (default #xFF))) (define (bluetooth-configuration-file config) "Return a configuration file for the systemd bluetooth service, as a string." (string-append - "[Policy]\n" - "AutoEnable=" (bool (bluetooth-configuration-auto-enable? - config)))) + "[General]" + "\nName = " (bluetooth-configuration-name config) + "\nClass = " (string-append + "0x" + (format #f "~6,'0x" (bluetooth-configuration-class config))) + "\nDiscoverableTimeout = " (number->string + (bluetooth-configuration-discoverable-timeout + config)) + "\nAlwaysPairable = " (bool (bluetooth-configuration-always-pairable? + config)) + "\nPairableTimeout = " (number->string + (bluetooth-configuration-pairable-timeout + config)) + (if (bluetooth-configuration-device-id config) + (string-append "\nDeviceID = " (bluetooth-configuration-device-id config)) + "") + "\nReverseServiceDiscovery = " (bool + (bluetooth-configuration-reverse-service-discovery + config)) + "\nNameResolving = " (bool (bluetooth-configuration-name-resolving? config)) + "\nDebugKeys = " (bool (bluetooth-configuration-debug-keys? config)) + "\nControllerMode = " (symbol->string + (bluetooth-configuration-controller-mode config)) + "\nMultiProfile = " (symbol->string (bluetooth-configuration-multi-profile + config)) + "\nFastConnectable = " (bool (bluetooth-configuration-fast-connectable? config)) + "\nPrivacy = " (symbol->string (bluetooth-configuration-privacy config)) + "\nJustWorksRepairing = " (symbol->string + (bluetooth-configuration-just-works-repairing config)) + "\nTemporaryTimeout = " (number->string + (bluetooth-configuration-temporary-timeout config)) + "\nRefreshDiscovery = " (bool (bluetooth-configuration-refresh-discovery config)) + "\nExperimental = " (let ((experimental (bluetooth-configuration-experimental config))) + (cond ((or (eq? experimental #t) + (eq? experimental #f)) (bool experimental)) + ((list? experimental) + (string-join (map uuid->string experimental) ",")))) + "\nRemoteNameRequestRetryDelay = " (number->string + (bluetooth-configuration-remote-name-request-retry-delay + config)) + "\n[BR]" + (if (bluetooth-configuration-page-scan-type config) + (string-append + "\nPageScanType = " + (number->string (bluetooth-configuration-page-scan-type config))) + "") + (if (bluetooth-configuration-page-scan-interval config) + (string-append + "\nPageScanInterval = " + (number->string (bluetooth-configuration-page-scan-interval config))) + "") + (if (bluetooth-configuration-page-scan-window config) + (string-append + "\nPageScanWindow = " + (number->string (bluetooth-configuration-page-scan-window config))) + "") + (if (bluetooth-configuration-inquiry-scan-type config) + (string-append + "\nInquiryScanType = " + (number->string (bluetooth-configuration-inquiry-scan-type config))) + "") + (if (bluetooth-configuration-inquiry-scan-interval config) + (string-append + "\nInquiryScanInterval = " + (number->string (bluetooth-configuration-inquiry-scan-interval config))) + "") + (if (bluetooth-configuration-inquiry-scan-window config) + (string-append + "\nInquiryScanWindow = " + (number->string (bluetooth-configuration-inquiry-scan-window config))) + "") + (if (bluetooth-configuration-link-supervision-timeout config) + (string-append + "\nLinkSupervisionTimeout = " + (number->string (bluetooth-configuration-link-supervision-timeout config))) + "") + (if (bluetooth-configuration-page-timeout config) + (string-append + "\nPageTimeout = " + (number->string (bluetooth-configuration-page-timeout config))) + "") + (if (bluetooth-configuration-min-sniff-interval config) + (string-append + "\nMinSniffInterval = " + (number->string (bluetooth-configuration-min-sniff-interval config))) + "") + (if (bluetooth-configuration-max-sniff-interval config) + (string-append + "\nMaxSniffInterval = " + (number->string (bluetooth-configuration-max-sniff-interval config))) + "") + + "\n[LE]" + (if (bluetooth-configuration-min-advertisement-interval config) + (string-append + "\nMinAdvertisementInterval = " + (number->string (bluetooth-configuration-min-advertisement-interval config))) + "") + (if (bluetooth-configuration-max-advertisement-interval config) + (string-append + "\nMaxAdvertisementInterval = " + (number->string (bluetooth-configuration-max-advertisement-interval config))) + "") + (if (bluetooth-configuration-multi-advertisement-rotation-interval config) + (string-append + "\nMultiAdvertisementRotationInterval = " + (number->string + (bluetooth-configuration-multi-advertisement-rotation-interval config))) + "") + (if (bluetooth-configuration-scan-interval-auto-connect config) + (string-append + "\nScanIntervalAutoConnect = " + (number->string (bluetooth-configuration-scan-interval-auto-connect config))) + "") + (if (bluetooth-configuration-scan-window-auto-connect config) + (string-append + "\nScanWindowAutoConnect = " + (number->string (bluetooth-configuration-scan-window-auto-connect config))) + "") + (if (bluetooth-configuration-scan-interval-suspend config) + (string-append + "\nScanIntervalSuspend = " + (number->string (bluetooth-configuration-scan-interval-suspend config))) + "") + (if (bluetooth-configuration-scan-window-suspend config) + (string-append + "\nScanWindowSuspend = " + (number->string (bluetooth-configuration-scan-window-suspend config))) + "") + (if (bluetooth-configuration-scan-interval-discovery config) + (string-append + "\nScanIntervalDiscovery = " + (number->string (bluetooth-configuration-scan-interval-discovery config))) + "") + (if (bluetooth-configuration-scan-window-discovery config) + (string-append + "\nScanWindowDiscovery = " + (number->string (bluetooth-configuration-scan-window-discovery config))) + "") + (if (bluetooth-configuration-scan-interval-adv-monitor config) + (string-append + "\nScanIntervalAdvMonitor = " + (number->string (bluetooth-configuration-scan-interval-adv-monitor config))) + "") + (if (bluetooth-configuration-scan-window-adv-monitor config) + (string-append + "\nScanWindowAdvMonitor = " + (number->string (bluetooth-configuration-scan-window-adv-monitor config))) + "") + (if (bluetooth-configuration-scan-interval-connect config) + (string-append + "\nScanIntervalConnect = " + (number->string (bluetooth-configuration-scan-interval-connect config))) + "") + (if (bluetooth-configuration-scan-window-connect config) + (string-append + "\nScanWindowConnect = " + (number->string (bluetooth-configuration-scan-window-connect config))) + "") + (if (bluetooth-configuration-min-connection-interval config) + (string-append + "\nMinConnectionInterval = " + (number->string (bluetooth-configuration-min-connection-interval config))) + "") + (if (bluetooth-configuration-max-connection-interval config) + (string-append + "\nMaxConnectionInterval = " + (number->string (bluetooth-configuration-max-connection-interval config))) + "") + (if (bluetooth-configuration-connection-latency config) + (string-append + "\nConnectionLatency = " + (number->string (bluetooth-configuration-connection-latency config))) + "") + (if (bluetooth-configuration-connection-supervision-timeout config) + (string-append + "\nConnectionSupervisionTimeout = " + (number->string (bluetooth-configuration-connection-supervision-timeout config))) + "") + (if (bluetooth-configuration-autoconnect-timeout config) + (string-append + "\nAutoconnecttimeout = " + (number->string (bluetooth-configuration-autoconnect-timeout config))) + "") + "\nAdvMonAllowlistScanDuration = " (number->string + (bluetooth-configuration-adv-mon-allowlist-scan-duration + config)) + "\nAdvMonNoFilterScanDuration = " (number->string + (bluetooth-configuration-adv-mon-no-filter-scan-duration + config)) + "\nEnableAdvMonInterleaveScan = " (number->string + (if (eq? #t + (bluetooth-configuration-enable-adv-mon-interleave-scan + config)) + 1 0)) + + "\n[GATT]" + "\nCache = " (symbol->string (bluetooth-configuration-cache config)) + "\nKeySize = " (number->string (bluetooth-configuration-key-size config)) + "\nExchangeMTU = " (number->string (bluetooth-configuration-exchange-mtu config)) + "\nChannels = " (number->string (bluetooth-configuration-att-channels config)) + + "\n[AVDTP]" + "\nSessionMode = " (symbol->string (bluetooth-configuration-session-mode config)) + "\nStreamMode = " (symbol->string (bluetooth-configuration-stream-mode config)) + + "\n[Policy]" + (let ((uuids (bluetooth-configuration-reconnect-uuids config))) + (if (not (eq? '() uuids)) + (string-append + "\nReconnectUUIDs = " + (string-join (map uuid->string uuids) ",")) + "")) + "\nReconnectAttempts = " (number->string + (bluetooth-configuration-reconnect-attempts config)) + "\nReconnectIntervals = " (string-join + (map number->string + (bluetooth-configuration-reconnect-intervals + config)) + ",") + "\nAutoEnable = " (bool (bluetooth-configuration-auto-enable? + config)) + "\nResumeDelay = " (number->string (bluetooth-configuration-resume-delay config)) + + "\n[AdvMon]" + "\nRSSISamplingPeriod = " (string-append + "0x" + (format #f "~2,'0x" + (bluetooth-configuration-rssi-sampling-period config))))) (define (bluetooth-directory config) (computed-file "etc-bluetooth" -- cgit v1.2.3 From 5e34e873af088ef9aa417290bcddf5b095501614 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 10 Mar 2022 22:27:04 +0100 Subject: services: guix: Add 'generate-substitute-key?' field. * gnu/services/base.scm ()[generate-substitute-key?]: New field. (guix-activation): Honor it. * doc/guix.texi (Base Services): Document it. --- doc/guix.texi | 12 ++++++++++++ gnu/services/base.scm | 8 ++++++-- 2 files changed, 18 insertions(+), 2 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index f479fe05ff..01c16ba85d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17030,6 +17030,18 @@ This example assumes that the file @file{./guix.example.org-key.pub} contains the public key that @code{guix.example.org} uses to sign substitutes. +@item @code{generate-substitute-key?} (default: @code{#t}) +Whether to generate a @dfn{substitute key pair} under +@file{/etc/guix/signing-key.pub} and @file{/etc/guix/signing-key.sec} if +there is not already one. + +This key pair is used when exporting store items, for instance with +@command{guix publish} (@pxref{Invoking guix publish}) or @command{guix +archive} (@pxref{Invoking guix archive}). Generating a key pair takes a +few seconds when enough entropy is available and is only done once; you +might want to turn it off for instance in a virtual machine that does +not need it and where the extra boot time is a problem. + @item @code{max-silent-time} (default: @code{0}) @itemx @code{timeout} (default: @code{0}) The number of seconds of silence and the number of seconds of activity, diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 463f034305..f278cb76de 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -183,6 +183,7 @@ (define-module (gnu services base) guix-configuration-authorized-keys guix-configuration-use-substitutes? guix-configuration-substitute-urls + guix-configuration-generate-substitute-key? guix-configuration-extra-options guix-configuration-log-file @@ -1565,6 +1566,8 @@ (define-record-type* (default #t)) (substitute-urls guix-configuration-substitute-urls ;list of strings (default %default-substitute-urls)) + (generate-substitute-key? guix-configuration-generate-substitute-key? + (default #t)) ;Boolean (chroot-directories guix-configuration-chroot-directories ;list of file-like/strings (default '())) (max-silent-time guix-configuration-max-silent-time ;integer @@ -1749,14 +1752,15 @@ (define (guix-accounts config) (define (guix-activation config) "Return the activation gexp for CONFIG." (match-record config - (guix authorize-key? authorized-keys) + (guix generate-substitute-key? authorize-key? authorized-keys) #~(begin ;; Assume that the store has BUILD-GROUP as its group. We could ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs, ;; chown leads to an entire copy of the tree, which is a bad idea. ;; Generate a key pair and optionally authorize substitute server keys. - (unless (file-exists? "/etc/guix/signing-key.pub") + (unless (or #$(not generate-substitute-key?) + (file-exists? "/etc/guix/signing-key.pub")) (system* #$(file-append guix "/bin/guix") "archive" "--generate-key")) -- cgit v1.2.3 From 0691ab67797ff94daf73bc816a46ae507775d0e2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 10 Mar 2022 22:33:58 +0100 Subject: services: openssh: Add 'generate-host-keys?' field. * gnu/services/ssh.scm ()[generate-host-keys?]: New field. (openssh-activation): Honor it. * doc/guix.texi (Networking Services): Document it. --- doc/guix.texi | 12 +++++++++++- gnu/services/ssh.scm | 13 +++++++++---- 2 files changed, 20 insertions(+), 5 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 01c16ba85d..4b71fb7010 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18857,7 +18857,7 @@ This is the configuration record for OpenSSH's @command{sshd}. @table @asis @item @code{openssh} (default @var{openssh}) -The Openssh package to use. +The OpenSSH package to use. @item @code{pid-file} (default: @code{"/var/run/sshd.pid"}) Name of the file where @command{sshd} writes its PID. @@ -18978,6 +18978,16 @@ Additional authorized keys can be specified @i{via} Note that this does @emph{not} interfere with the use of @file{~/.ssh/authorized_keys}. +@item @code{generate-host-keys?} (default: @code{#t}) +Whether to generate host key pairs with @command{ssh-keygen -A} under +@file{/etc/ssh} if there are none. + +Generating key pairs takes a few seconds when enough entropy is +available and is only done once. You might want to turn it off for +instance in a virtual machine that does not need it because host keys +are provided in some other way, and where the extra boot time is a +problem. + @item @code{log-level} (default: @code{'info}) This is a symbol specifying the logging level: @code{quiet}, @code{fatal}, @code{error}, @code{info}, @code{verbose}, @code{debug}, etc. See the man diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 97f74a00f7..433a0e8f91 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2014-2019, 2022 Ludovic Courtès ;;; Copyright © 2016 David Craven ;;; Copyright © 2016 Julien Lepiller ;;; Copyright © 2017 Clément Lassieur @@ -351,6 +351,10 @@ (define-record-type* (authorized-keys openssh-authorized-keys (default '())) + ;; Boolean + (generate-host-keys? openssh-configuration-generate-host-keys? + (default #t)) + ;; Boolean ;; XXX: This should really be handled in an orthogonal way, for instance as ;; proposed in . Keep it internal/undocumented @@ -402,9 +406,10 @@ (define (touch file-name) (unless (file-exists? lastlog) (touch lastlog)))) - ;; Generate missing host keys. - (system* (string-append #$(openssh-configuration-openssh config) - "/bin/ssh-keygen") "-A")))) + (when #$(openssh-configuration-generate-host-keys? config) + ;; Generate missing host keys. + (system* (string-append #$(openssh-configuration-openssh config) + "/bin/ssh-keygen") "-A"))))) (define (authorized-key-directory keys) "Return a directory containing the authorized keys specified in KEYS, a list -- cgit v1.2.3 From 101ba6490437334b65bed8d5f879ef8946847b2d Mon Sep 17 00:00:00 2001 From: Florian Pelz Date: Sun, 13 Mar 2022 12:26:47 +0100 Subject: doc: Fix inappropriate escapes. * doc/guix.texi (Shells Home Services): Change \" to ". --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 4b71fb7010..dbe281ead7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -38364,13 +38364,13 @@ put in the @file{.bashrc} file. The alias will automatically be quoted, so something line this: @lisp -'((\"ls\" . \"ls -alF\")) +'(("ls" . "ls -alF")) @end lisp turns into @example -alias ls=\"ls -alF\" +alias ls="ls -alF" @end example @item @code{bash-profile} (default: @code{()}) (type: text-config) -- cgit v1.2.3 From 25261cbf96a3bf58abc6e836d71bdabe9154a83c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 11 Mar 2022 22:15:47 +0100 Subject: guix home: Implement the 'extension-graph' and 'shepherd-graph' actions. Until now these two actions were silently ignored. * guix/scripts/home.scm (show-help, %options): Add "--graph-backend". (%default-options): Add 'graph-backend' key. (export-extension-graph, export-shepherd-graph): New procedures. (perform-action): Add #:graph-backend parameter. Add cases for the 'extension-graph' and 'shepherd-graph' actions. (process-action): Pass #:graph-backend to 'perform-action'. * guix/scripts/system.scm (service-node-type) (shepherd-service-node-type): Export * tests/guix-home.sh: Add tests. * doc/guix.texi (Invoking guix home): Document it. --- doc/guix.texi | 31 ++++++++++++ guix/scripts/home.scm | 123 +++++++++++++++++++++++++++++++++++------------- guix/scripts/system.scm | 5 +- tests/guix-home.sh | 8 ++++ 4 files changed, 134 insertions(+), 33 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index dbe281ead7..cb09978fab 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -38848,7 +38848,38 @@ environment. Note that not every home service that exists is supported $ guix home import ~/guix-config guix home: '/home/alice/guix-config' populated with all the Home configuration files @end example +@end table + +And there's more! @command{guix home} also provides the following +sub-commands to visualize how the services of your home environment +relate to one another: + +@table @code +@cindex service extension graph, of a home environment +@item extension-graph +Emit to standard output the @dfn{service extension graph} of the home +environment defined in @var{file} (@pxref{Service Composition}, for more +information on service extensions). By default the output is in +Dot/Graphviz format, but you can choose a different format with +@option{--graph-backend}, as with @command{guix graph} (@pxref{Invoking +guix graph, @option{--backend}}): + +The command: + +@example +guix home extension-graph @var{file} | xdot - +@end example + +shows the extension relations among services. +@cindex Shepherd dependency graph, for a home environment +@item shepherd-graph +Emit to standard output the @dfn{dependency graph} of shepherd services +of the home environment defined in @var{file}. @xref{Shepherd +Services}, for more information and for an example graph. + +Again, the default output format is Dot/Graphviz, but you can pass +@option{--graph-backend} to select a different one. @end table @var{options} can contain any of the common build options (@pxref{Common diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index 837fd96361..e95e4a90e4 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2021 Pierre Langlois ;;; Copyright © 2021 Oleg Pykhalov +;;; Copyright © 2022 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,9 @@ (define-module (guix scripts home) #:use-module (gnu packages) #:use-module (gnu home) #:use-module (gnu home services) + #:autoload (gnu home services shepherd) (home-shepherd-service-type + home-shepherd-configuration-services + shepherd-service-requirement) #:use-module (guix channels) #:use-module (guix derivations) #:use-module (guix ui) @@ -33,13 +37,16 @@ (define-module (guix scripts home) #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix utils) + #:autoload (guix graph) (lookup-backend export-graph) #:use-module (guix scripts) #:use-module (guix scripts package) #:use-module (guix scripts build) #:autoload (guix scripts system search) (service-type->recutils) #:use-module (guix scripts system reconfigure) #:autoload (guix scripts pull) (channel-commit-hyperlink) - #:use-module (guix scripts home import) + #:autoload (guix scripts system) (service-node-type + shepherd-service-node-type) + #:autoload (guix scripts home import) (import-manifest) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module (guix gexp) @@ -87,6 +94,10 @@ (define (show-help) build build the home environment without installing anything\n")) (display (G_ "\ import generates a home environment definition from dotfiles\n")) + (display (G_ "\ + extension-graph emit the service extension graph\n")) + (display (G_ "\ + shepherd-graph emit the graph of shepherd services\n")) (show-build-options-help) (display (G_ " @@ -97,6 +108,9 @@ (define (show-help) channel revisions")) (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " + --graph-backend=BACKEND + use BACKEND for 'extension-graph' and 'shepherd-graph'")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -136,6 +150,10 @@ (define %options (alist-cons 'validate-reconfigure warn-about-backward-reconfigure result))) + (option '("graph-backend") #t #f + (lambda (opt name arg result) + (alist-cons 'graph-backend arg result))) + %standard-build-options)) (define %default-options @@ -147,18 +165,49 @@ (define %default-options (multiplexed-build-output? . #t) (verbosity . #f) ;default (debug . 0) - (validate-reconfigure . ,ensure-forward-reconfigure))) + (validate-reconfigure . ,ensure-forward-reconfigure) + (graph-backend . "graphviz"))) ;;; ;;; Actions. ;;; +(define* (export-extension-graph home port + #:key (backend (lookup-backend "graphviz"))) + "Export the service extension graph of HOME to PORT using BACKEND." + (let* ((services (home-environment-services home)) + (home (find (lambda (service) + (eq? (service-kind service) home-service-type)) + services))) + (export-graph (list home) port + #:backend backend + #:node-type (service-node-type services) + #:reverse-edges? #t))) + +(define* (export-shepherd-graph home port + #:key (backend (lookup-backend "graphviz"))) + "Export the graph of shepherd services of HOME to PORT using BACKEND." + (let* ((services (home-environment-services home)) + (root (fold-services services + #:target-type home-shepherd-service-type)) + ;; Get the list of . + (shepherds (home-shepherd-configuration-services + (service-value root))) + (sinks (filter (lambda (service) + (null? (shepherd-service-requirement service))) + shepherds))) + (export-graph sinks port + #:backend backend + #:node-type (shepherd-service-node-type shepherds) + #:reverse-edges? #t))) + (define* (perform-action action he #:key dry-run? derivations-only? use-substitutes? + (graph-backend "graphviz") (validate-reconfigure ensure-forward-reconfigure)) "Perform ACTION for home environment. " @@ -169,35 +218,43 @@ (define println (check-forward-update validate-reconfigure #:current-channels (home-provenance %guix-home))) - (mlet* %store-monad - ((he-drv (home-environment-derivation he)) - (drvs (mapm/accumulate-builds lower-object (list he-drv))) - (% (if derivations-only? - (return - (for-each (compose println derivation-file-name) drvs)) - (built-derivations drvs))) - - (he-out-path -> (derivation->output-path he-drv))) - (if (or dry-run? derivations-only?) - (return #f) - (begin - (for-each (compose println derivation->output-path) drvs) - - (case action - ((reconfigure) - (let* ((number (generation-number %guix-home)) - (generation (generation-file-name - %guix-home (+ 1 number)))) - - (switch-symlinks generation he-out-path) - (switch-symlinks %guix-home generation) - (setenv "GUIX_NEW_HOME" he-out-path) - (primitive-load (string-append he-out-path "/activate")) - (setenv "GUIX_NEW_HOME" #f) - (return he-out-path))) - (else - (newline) - (return he-out-path))))))) + (case action + ((extension-graph) + (export-extension-graph he (current-output-port) + #:backend (lookup-backend graph-backend))) + ((shepherd-graph) + (export-shepherd-graph he (current-output-port) + #:backend (lookup-backend graph-backend))) + (else + (mlet* %store-monad + ((he-drv (home-environment-derivation he)) + (drvs (mapm/accumulate-builds lower-object (list he-drv))) + (% (if derivations-only? + (return + (for-each (compose println derivation-file-name) drvs)) + (built-derivations drvs))) + + (he-out-path -> (derivation->output-path he-drv))) + (if (or dry-run? derivations-only?) + (return #f) + (begin + (for-each (compose println derivation->output-path) drvs) + + (case action + ((reconfigure) + (let* ((number (generation-number %guix-home)) + (generation (generation-file-name + %guix-home (+ 1 number)))) + + (switch-symlinks generation he-out-path) + (switch-symlinks %guix-home generation) + (setenv "GUIX_NEW_HOME" he-out-path) + (primitive-load (string-append he-out-path "/activate")) + (setenv "GUIX_NEW_HOME" #f) + (return he-out-path))) + (else + (newline) + (return he-out-path))))))))) (define (process-action action args opts) "Process ACTION, a sub-command, with the arguments are listed in ARGS. @@ -256,7 +313,9 @@ (define (ensure-home-environment file-or-exp obj) #:derivations-only? (assoc-ref opts 'derivations-only?) #:use-substitutes? (assoc-ref opts 'substitutes?) #:validate-reconfigure - (assoc-ref opts 'validate-reconfigure)))))) + (assoc-ref opts 'validate-reconfigure) + #:graph-backend + (assoc-ref opts 'graph-backend)))))) (warn-about-disk-space))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6f7dcd4643..55e9b8ba30 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -88,7 +88,10 @@ (define-module (guix scripts system) #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:export (guix-system - read-operating-system)) + read-operating-system + + service-node-type + shepherd-service-node-type)) ;;; diff --git a/tests/guix-home.sh b/tests/guix-home.sh index f054d15172..48dbcbd28f 100644 --- a/tests/guix-home.sh +++ b/tests/guix-home.sh @@ -93,6 +93,14 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT "# the content of bashrc-test-config.sh")))))))) EOF + # Check whether the graph commands work as expected. + guix home extension-graph "home.scm" | grep 'label = "home-activation"' + guix home extension-graph "home.scm" | grep 'label = "home-symlink-manager"' + guix home extension-graph "home.scm" | grep 'label = "home"' + + # There are no Shepherd services so the one below must fail. + ! guix home shepherd-graph "home.scm" + guix home reconfigure "${test_directory}/home.scm" test -d "${HOME}/.guix-home" test -h "${HOME}/.bash_profile" -- cgit v1.2.3 From 3a91c9254798b3555c1ed4cddd07911afe4e3839 Mon Sep 17 00:00:00 2001 From: angryrectangle Date: Sat, 12 Mar 2022 15:28:15 -0500 Subject: home: services: Fix bash aliases without guix-defaults. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/home/services/shells.scm: Fix bash aliases not being added if guix-defaults? was #f. Also fix inaccuracy in documentation about placement of defaults. * doc/guix.texi (Shells Home Services): Adjust accordingly. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 2 +- gnu/home/services/shells.scm | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index cb09978fab..46e65129ae 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -38349,7 +38349,7 @@ The Bash package to use. @item @code{guix-defaults?} (default: @code{#t}) (type: boolean) Add sane defaults like reading @file{/etc/bashrc} and coloring the output of -@command{ls} to the end of the @file{.bashrc} file. +@command{ls} to the top of the @file{.bashrc} file. @item @code{environment-variables} (default: @code{()}) (type: alist) Association list of environment variables to set for the Bash session. The diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm index ca7f4ac0ad..9a79db484a 100644 --- a/gnu/home/services/shells.scm +++ b/gnu/home/services/shells.scm @@ -324,7 +324,7 @@ (define-configuration home-bash-configuration (guix-defaults? (boolean #t) "Add sane defaults like reading @file{/etc/bashrc} and coloring the output of -@command{ls} to the end of the @file{.bashrc} file.") +@command{ls} to the top of the @file{.bashrc} file.") (environment-variables (alist '()) "Association list of environment variables to set for the Bash session. The @@ -448,7 +448,7 @@ (define* (file-if-not-empty field #:optional (extra-content #f)) 'bashrc (if (home-bash-configuration-guix-defaults? config) (list (serialize-field 'aliases) guix-bashrc) - (list (serialize-field 'alises)))) + (list (serialize-field 'aliases)))) (file-if-not-empty 'bash-logout))))) (define (add-bash-packages config) -- cgit v1.2.3 From 465259be78600d17d83f0cee6b06b8a83babda16 Mon Sep 17 00:00:00 2001 From: EuAndreh Date: Wed, 16 Mar 2022 20:14:23 -0300 Subject: doc: Fix wrong variable name. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Mail services): use correct variable name. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 46e65129ae..1ecb3c7e3d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -23822,7 +23822,7 @@ Data type representing the configuration of opensmtpd. @item @code{package} (default: @var{opensmtpd}) Package object of the OpenSMTPD SMTP server. -@item @code{config-file} (default: @code{%default-opensmtpd-file}) +@item @code{config-file} (default: @code{%default-opensmtpd-config-file}) File-like object of the OpenSMTPD configuration file to use. By default it listens on the loopback network interface, and allows for mail from users and daemons on the local machine, as well as permitting email to -- cgit v1.2.3 From 094a2cfbe45c104d0da30ff9d975d052ca0c118c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 13 Mar 2022 22:44:54 +0100 Subject: guix home: Add 'container' command. * guix/scripts/home.scm (show-help, %options): Add '--network', '--share', and '--expose'. (not-config?, user-shell, spawn-home-container): New procedures. (%default-system-profile): New variable. (perform-action): Add #:file-system-mappings, #:container-command, and #:network?; honor them. (process-action): Adjust accordingly. (guix-home)[parse-sub-command]: Add "container". [parse-args]: New procedure. Use it instead of 'parse-command-line'. * tests/guix-home.sh: Add tests. * doc/guix.texi (Declaring the Home Environment): Mention 'guix home container' as a way to test configuration. (Invoking guix home): Document it. --- doc/guix.texi | 58 +++++++++++ guix/scripts/home.scm | 272 +++++++++++++++++++++++++++++++++++++++++++++----- tests/guix-home.sh | 57 ++++++++--- 3 files changed, 348 insertions(+), 39 deletions(-) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 1ecb3c7e3d..15ab97699c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -38071,6 +38071,21 @@ be confused with Shepherd services (@pxref{Shepherd Services}). Using this exte mechanism and some Scheme code that glues things together gives the user the freedom to declare their own, very custom, home environments. +@cindex container, for @command{guix home} +Once the configuration looks good, you can first test it in a throw-away +``container'': + +@example +guix home container config.scm +@end example + +The command above spawns a shell where your home environment is running. +The shell runs in a container, meaning it's isolated from the rest of +the system, so it's a good way to try out your configuration---you can +see if configuration bits are missing or misbehaving, if daemons get +started, and so on. Once you exit that shell, you're back to the prompt +of your original shell ``in the real world''. + Once you have a configuration file that suits your needs, you can reconfigure your home by running: @@ -38699,6 +38714,49 @@ As for @command{guix 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}). +@cindex container, for @command{guix home} +@item container +Spawn a shell in an isolated environment---a +@dfn{container}---containing your home as specified by @var{file}. + +For example, this is how you would start an interactive shell in a +container with your home: + +@example +guix home container config.scm +@end example + +This is a throw-away container where you can lightheartedly fiddle with +files; any changes made within the container, any process started---all +this disappears as soon as you exit that shell. + +As with @command{guix shell}, several options control that container: + +@table @option +@item --network +@itemx -N +Enable networking within the container (it is disabled by default). + +@item --expose=@var{source}[=@var{target}] +@itemx --share=@var{source}[=@var{target}] +As with @command{guix shell}, make directory @var{source} of the host +system available as @var{target} inside the container---read-only if you +pass @option{--expose}, and writable if you pass @option{--share} +(@pxref{Invoking guix shell, @option{--expose} and @option{--share}}). +@end table + +Additionally, you can run a command in that container, instead of +spawning an interactive shell. For instance, here is how you would +check which Shepherd services are started in a throw-away home +container: + +@example +guix home container config.scm -- herd status +@end example + +The command to run in the container must come after @code{--} (double +hyphen). + @item reconfigure Build the home environment described in @var{file}, and switch to it. Switching means that the activation script will be evaluated and (in diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index e95e4a90e4..1902562f60 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -24,11 +24,24 @@ (define-module (guix scripts home) #:use-module (gnu packages admin) #:use-module ((gnu services) #:hide (delete)) #:use-module (gnu packages) + #:autoload (gnu packages base) (coreutils) + #:autoload (gnu packages bash) (bash) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:autoload (gnu packages shells) (fish gash zsh) #:use-module (gnu home) #:use-module (gnu home services) #:autoload (gnu home services shepherd) (home-shepherd-service-type home-shepherd-configuration-services shepherd-service-requirement) + #:autoload (guix modules) (source-module-closure) + #:autoload (gnu build linux-container) (call-with-container %namespaces) + #:autoload (gnu system linux-container) (eval/container) + #:autoload (gnu system file-systems) (file-system-mapping + file-system-mapping-source + file-system-mapping->bind-mount + specification->file-system-mapping + %network-file-mappings) + #:autoload (guix self) (make-config.scm) #:use-module (guix channels) #:use-module (guix derivations) #:use-module (guix ui) @@ -55,6 +68,7 @@ (define-module (guix scripts home) #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:export (guix-home)) @@ -106,6 +120,16 @@ (define (show-help) (display (G_ " --allow-downgrades for 'reconfigure', allow downgrades to earlier channel revisions")) + (newline) + (display (G_ " + -N, --network allow containers to access the network")) + (display (G_ " + --share=SPEC for containers, share writable host file system + according to SPEC")) + (display (G_ " + --expose=SPEC for containers, expose read-only host file system + according to SPEC")) + (newline) (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " @@ -154,6 +178,21 @@ (define %options (lambda (opt name arg result) (alist-cons 'graph-backend arg result))) + ;; Container options. + (option '(#\N "network") #f #f + (lambda (opt name arg result) + (alist-cons 'network? #t result))) + (option '("share") #t #f + (lambda (opt name arg result) + (alist-cons 'file-system-mapping + (specification->file-system-mapping arg #t) + result))) + (option '("expose") #t #f + (lambda (opt name arg result) + (alist-cons 'file-system-mapping + (specification->file-system-mapping arg #f) + result))) + %standard-build-options)) (define %default-options @@ -168,6 +207,146 @@ (define %default-options (validate-reconfigure . ,ensure-forward-reconfigure) (graph-backend . "graphviz"))) + +;;; +;;; Container. +;;; + +(define not-config? + ;; Select (guix …) and (gnu …) modules, except (guix config). + (match-lambda + (('guix 'config) #f) + (('guix _ ...) #t) + (('gnu _ ...) #t) + (_ #f))) + +(define (user-shell) + (match (and=> (or (getenv "SHELL") + (passwd:shell (getpwuid (getuid)))) + basename) + ("zsh" (file-append zsh "/bin/zsh")) + ("fish" (file-append fish "/bin/fish")) + ("gash" (file-append gash "/bin/gash")) + (_ (file-append bash "/bin/bash")))) + +(define %default-system-profile + ;; The "system" profile available when running 'guix home container'. The + ;; activation script currently expects to run "env -0" (XXX), so provide + ;; Coreutils by default. + (delay (profile + (name "home-system-profile") + (content (packages->manifest (list coreutils)))))) + +(define* (spawn-home-container home + #:key + network? + (command '()) + (mappings '()) + (system-profile + (force %default-system-profile))) + "Spawn a login shell within a container running HOME, a home environment. +When COMMAND is a non-empty list, execute it in the container and exit +immediately. Return the exit status of the process in the container." + (define passwd (getpwuid (getuid))) + (define home-directory (or (getenv "HOME") (passwd:dir passwd))) + (define host (gethostname)) + (define uid 1000) + (define gid 1000) + (define user-name (passwd:name passwd)) + (define user-real-name (passwd:gecos passwd)) + + (define (optional-mapping mapping) + (and (file-exists? (file-system-mapping-source mapping)) + mapping)) + + (define network-mappings + (if network? + (filter-map optional-mapping %network-file-mappings) + '())) + + (eval/container + (with-extensions (list guile-gcrypt) + (with-imported-modules `(((guix config) => ,(make-config.scm)) + ,@(source-module-closure + '((gnu build accounts) + (guix profiles) + (guix build utils) + (guix build syscalls)) + #:select? not-config?)) + #~(begin + (use-modules (guix build utils) + (gnu build accounts) + ((guix build syscalls) + #:select (set-network-interface-up))) + + (define shell + #$(user-shell)) + + (define term + #$(getenv "TERM")) + + (define passwd + (password-entry + (name #$user-name) + (real-name #$user-real-name) + (uid #$uid) (gid #$gid) (shell shell) + (directory #$home-directory))) + + (define groups + (list (group-entry (name "users") (gid #$gid)) + (group-entry (gid 65534) ;the overflow GID + (name "overflow")))) + + ;; (guix profiles) loads (guix utils), which calls 'getpw' from the + ;; top level. Thus, arrange so that it's loaded after /etc/passwd + ;; has been created. + (module-autoload! (current-module) + '(guix profiles) '(load-profile)) + + ;; Create /etc/passwd for applications that need it, such as mcron. + (mkdir-p "/etc") + (write-passwd (list passwd)) + (write-group groups) + + (unless #$network? + ;; When isolated from the network, provide a minimal /etc/hosts + ;; to resolve "localhost". + (call-with-output-file "/etc/hosts" + (lambda (port) + (display "127.0.0.1 localhost\n" port) + (chmod port #o444)))) + + ;; Set PATH for things that the activation script might expect, such + ;; as "env". + (load-profile #$system-profile) + + (mkdir-p #$home-directory) + (setenv "HOME" #$home-directory) + (setenv "GUIX_NEW_HOME" #$home) + (primitive-load (string-append #$home "/activate")) + (setenv "GUIX_NEW_HOME" #f) + + (when term + ;; Preserve TERM for proper interactive use. + (setenv "TERM" term)) + + (chdir #$home-directory) + + ;; Invoke SHELL with argv[0] starting with "-": that's how shells + ;; figure out that they are login shells! + (execl shell (string-append "-" (basename shell)) + #$@(match command + (() #~()) + ((_ ...) + #~("-c" #$(string-join command)))))))) + + #:namespaces (if network? + (delq 'net %namespaces) ; share host network + %namespaces) + #:mappings (append network-mappings mappings) + #:guest-uid uid + #:guest-gid gid)) + ;;; ;;; Actions. @@ -208,7 +387,12 @@ (define* (perform-action action he derivations-only? use-substitutes? (graph-backend "graphviz") - (validate-reconfigure ensure-forward-reconfigure)) + (validate-reconfigure ensure-forward-reconfigure) + + ;; Container options. + (file-system-mappings '()) + (container-command '()) + network?) "Perform ACTION for home environment. " (define println @@ -237,24 +421,37 @@ (define println (he-out-path -> (derivation->output-path he-drv))) (if (or dry-run? derivations-only?) (return #f) - (begin - (for-each (compose println derivation->output-path) drvs) - - (case action - ((reconfigure) - (let* ((number (generation-number %guix-home)) - (generation (generation-file-name - %guix-home (+ 1 number)))) - - (switch-symlinks generation he-out-path) - (switch-symlinks %guix-home generation) - (setenv "GUIX_NEW_HOME" he-out-path) - (primitive-load (string-append he-out-path "/activate")) - (setenv "GUIX_NEW_HOME" #f) - (return he-out-path))) - (else - (newline) - (return he-out-path))))))))) + (case action + ((reconfigure) + (let* ((number (generation-number %guix-home)) + (generation (generation-file-name + %guix-home (+ 1 number)))) + + (switch-symlinks generation he-out-path) + (switch-symlinks %guix-home generation) + (setenv "GUIX_NEW_HOME" he-out-path) + (primitive-load (string-append he-out-path "/activate")) + (setenv "GUIX_NEW_HOME" #f) + (return he-out-path))) + ((container) + (mlet %store-monad ((status (spawn-home-container + he + #:network? network? + #:mappings file-system-mappings + #:command + container-command))) + (match (status:exit-val status) + (0 (return #t)) + ((? integer? n) (return (exit n))) + (#f + (if (status:term-sig status) + (leave (G_ "process terminated with signal ~a~%") + (status:term-sig status)) + (leave (G_ "process stopped with signal ~a~%") + (status:stop-sig status))))))) + (else + (for-each (compose println derivation->output-path) drvs) + (return he-out-path)))))))) (define (process-action action args opts) "Process ACTION, a sub-command, with the arguments are listed in ARGS. @@ -293,6 +490,10 @@ (define (ensure-home-environment file-or-exp obj) (else (leave (G_ "no configuration specified~%"))))))) + (mappings (filter-map (match-lambda + (('file-system-mapping . mapping) mapping) + (_ #f)) + opts)) (dry? (assoc-ref opts 'dry-run?))) (with-store store @@ -315,7 +516,11 @@ (define (ensure-home-environment file-or-exp obj) #:validate-reconfigure (assoc-ref opts 'validate-reconfigure) #:graph-backend - (assoc-ref opts 'graph-backend)))))) + (assoc-ref opts 'graph-backend) + #:network? (assoc-ref opts 'network?) + #:file-system-mappings mappings + #:container-command + (or (assoc-ref opts 'container-command) '())))))) (warn-about-disk-space))) @@ -404,7 +609,7 @@ (define (parse-sub-command arg result) list-generations describe delete-generations roll-back switch-generation search - import) + import container) (alist-cons 'action action result)) (else (leave (G_ "~a: unknown action~%") action)))))) @@ -442,11 +647,28 @@ (define (fail) (fail)))) args)) + (define (parse-args args) + ;; Parse the list of command line arguments ARGS. + + ;; The '--' token is used to separate the command to run from the rest of + ;; the operands. + (let* ((args rest (break (cut string=? "--" <>) args)) + (opts (parse-command-line args %options (list %default-options) + #:argument-handler + parse-sub-command))) + (match rest + (() opts) + (("--") opts) + (("--" command ...) + (match (assoc-ref opts 'action) + ('container + (alist-cons 'container-command command opts)) + (_ + (leave (G_ "~a: extraneous command~%") + (string-join command)))))))) + (with-error-handling - (let* ((opts (parse-command-line args %options - (list %default-options) - #:argument-handler - parse-sub-command)) + (let* ((opts (parse-args args)) (args (option-arguments opts)) (command (assoc-ref opts 'action))) (parameterize ((%graft? (assoc-ref opts 'graft?))) diff --git a/tests/guix-home.sh b/tests/guix-home.sh index 48dbcbd28f..0f68484ef4 100644 --- a/tests/guix-home.sh +++ b/tests/guix-home.sh @@ -26,6 +26,16 @@ set -e guix home --version +container_supported () +{ + if guile -c '((@ (guix scripts environment) assert-container-features))' + then + return 0 + else + return 1 + fi +} + NIX_STORE_DIR="$(guile -c '(use-modules (guix config))(display %storedir)')" localstatedir="$(guile -c '(use-modules (guix config))(display %localstatedir)')" GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket" @@ -47,20 +57,6 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT ( cd "$test_directory" || exit 77 - HOME="$test_directory" - export HOME - - # - # Test 'guix home reconfigure'. - # - - echo "# This file will be overridden and backed up." > "$HOME/.bashrc" - mkdir "$HOME/.config" - echo "This file will be overridden too." > "$HOME/.config/test.conf" - echo "This file will stay around." > "$HOME/.config/random-file" - - echo -n "# dot-bashrc test file for guix home" > "dot-bashrc" - cat > "home.scm" <<'EOF' (use-modules (guix gexp) (gnu home) @@ -93,6 +89,8 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT "# the content of bashrc-test-config.sh")))))))) EOF + echo -n "# dot-bashrc test file for guix home" > "dot-bashrc" + # Check whether the graph commands work as expected. guix home extension-graph "home.scm" | grep 'label = "home-activation"' guix home extension-graph "home.scm" | grep 'label = "home-symlink-manager"' @@ -101,6 +99,37 @@ EOF # There are no Shepherd services so the one below must fail. ! guix home shepherd-graph "home.scm" + if container_supported + then + # Run the home in a container. + guix home container home.scm -- true + ! guix home container home.scm -- false + test "$(guix home container home.scm -- echo '$HOME')" = "$HOME" + guix home container home.scm -- cat '~/.config/test.conf' | \ + grep "the content of" + guix home container home.scm -- test -h '~/.bashrc' + test "$(guix home container home.scm -- id -u)" = 1000 + ! guix home container home.scm -- test -f '$HOME/sample/home.scm' + guix home container home.scm --expose="$PWD=$HOME/sample" -- \ + test -f '$HOME/sample/home.scm' + ! guix home container home.scm --expose="$PWD=$HOME/sample" -- \ + rm -v '$HOME/sample/home.scm' + else + echo "'guix home container' test SKIPPED" >&2 + fi + + HOME="$test_directory" + export HOME + + # + # Test 'guix home reconfigure'. + # + + echo "# This file will be overridden and backed up." > "$HOME/.bashrc" + mkdir "$HOME/.config" + echo "This file will be overridden too." > "$HOME/.config/test.conf" + echo "This file will stay around." > "$HOME/.config/random-file" + guix home reconfigure "${test_directory}/home.scm" test -d "${HOME}/.guix-home" test -h "${HOME}/.bash_profile" -- cgit v1.2.3 From 10d865aa921f559562fb543d7796c7a08e17f016 Mon Sep 17 00:00:00 2001 From: Jelle Licht Date: Sat, 12 Mar 2022 21:34:09 +0100 Subject: services: thermald: Add 'adaptive?' field. * gnu/services/pm.scm (): Add 'adaptive?' field. (thermald-shepherd-service): Use it to pass --adaptive to thermald. * doc/guix.texi (Power Management Services): Document the 'adaptive?' field of 'thermald-configuration'. --- doc/guix.texi | 4 ++++ gnu/services/pm.scm | 5 +++++ 2 files changed, 9 insertions(+) (limited to 'doc/guix.texi') diff --git a/doc/guix.texi b/doc/guix.texi index 15ab97699c..44b0f9f1ea 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -30687,6 +30687,10 @@ of processors and preventing overheating. Data type representing the configuration of @code{thermald-service-type}. @table @asis +@item @code{adaptive?} (default: @code{#f}) +Use @acronym{DPTF, Dynamic Power and Thermal Framework} adaptive tables +when present. + @item @code{ignore-cpuid-check?} (default: @code{#f}) Ignore cpuid check for supported CPU models. diff --git a/gnu/services/pm.scm b/gnu/services/pm.scm index 3da3c0b961..e48236dbca 100644 --- a/gnu/services/pm.scm +++ b/gnu/services/pm.scm @@ -435,6 +435,8 @@ (define (generate-tlp-documentation) (define-record-type* thermald-configuration make-thermald-configuration thermald-configuration? + (adaptive? thermald-adaptive? ;boolean + (default #f)) (ignore-cpuid-check? thermald-ignore-cpuid-check? ;boolean (default #f)) (thermald thermald-thermald ;file-like @@ -448,6 +450,9 @@ (define (thermald-shepherd-service config) (start #~(make-forkexec-constructor '(#$(file-append (thermald-thermald config) "/sbin/thermald") "--no-daemon" + #$@(if (thermald-adaptive? config) + '("--adaptive") + '()) #$@(if (thermald-ignore-cpuid-check? config) '("--ignore-cpuid-check") '())))) -- cgit v1.2.3