From 5741e3e5520998f93b59848b3e58f99c0357e9a5 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 2 Sep 2016 20:54:21 +0300 Subject: doc: Fix typos. * doc/guix.texi: Fix typo. * doc/emacs.texi: Fix multiple typos. --- doc/emacs.texi | 6 +++--- doc/guix.texi | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'doc') diff --git a/doc/emacs.texi b/doc/emacs.texi index d124eca3c..c7a8881ef 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -225,7 +225,7 @@ guix pull}) from Emacs using: With @kbd{C-u}, make it verbose. @end table -Once @command{guix pull} has succeeded, the Guix REPL is restared. This +Once @command{guix pull} has succeeded, the Guix REPL is restarted. This allows you to keep using the Emacs interface with the updated Guix. @@ -266,7 +266,7 @@ Describe current mode to see all available bindings. @end table @emph{Hint:} If you need several ``list'' or ``info'' buffers, you can -simlpy @kbd{M-x clone-buffer} them, and each buffer will have its own +simply @kbd{M-x clone-buffer} them, and each buffer will have its own history. @emph{Warning:} Name/version pairs cannot be used to identify packages @@ -310,7 +310,7 @@ Mark the current package for upgrading. @item ^ Mark all obsolete packages for upgrading. @item e -Edit the definition of the curent package (go to its location). This is +Edit the definition of the current package (go to its location). This is similar to @command{guix edit} command (@pxref{Invoking guix edit}), but for opening a package recipe in the current Emacs instance. @item x diff --git a/doc/guix.texi b/doc/guix.texi index 2a7fd4d04..d6c041862 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8324,7 +8324,7 @@ profile, and extends polkit with the actions from @deffn {Scheme Procedure} xfce-desktop-service Return a service that adds the @code{xfce} package to the system profile, -and extends polkit with the abilit for @code{thunar} to manipulate the +and extends polkit with the ability for @code{thunar} to manipulate the file system as root from within a user session, after the user has authenticated with the administrator's password. @end deffn -- cgit v1.3 From 7ca87354db53fd1e1a7a3dfeddb9a598ea064bbe Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 4 Sep 2016 23:41:53 +0200 Subject: Add (guix modules). * guix/modules.scm, tests/modules.scm: New files. * Makefile.am (MODULES, SCM_TESTS): Add them. * doc/guix.texi (G-Expressions): Add an example of 'source-module-closure'. --- Makefile.am | 2 + doc/guix.texi | 22 ++++++++ guix/modules.scm | 155 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ tests/modules.scm | 45 ++++++++++++++++ 4 files changed, 224 insertions(+) create mode 100644 guix/modules.scm create mode 100644 tests/modules.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index 165dfe972..1a34e0d5c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -41,6 +41,7 @@ MODULES = \ guix/combinators.scm \ guix/utils.scm \ guix/sets.scm \ + guix/modules.scm \ guix/download.scm \ guix/git-download.scm \ guix/hg-download.scm \ @@ -222,6 +223,7 @@ SCM_TESTS = \ tests/pk-crypto.scm \ tests/pki.scm \ tests/sets.scm \ + tests/modules.scm \ tests/gnu-maintenance.scm \ tests/substitute.scm \ tests/builders.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index d6c041862..b6ca34a2f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3825,6 +3825,28 @@ In this example, the @code{(guix build utils)} module is automatically pulled into the isolated build environment of our gexp, such that @code{(use-modules (guix build utils))} works as expected. +@cindex module closure +@findex source-module-closure +Usually you want the @emph{closure} of the module to be imported---i.e., +the module itself and all the modules it depends on---rather than just +the module; failing to do that, attempts to use the module will fail +because of missing dependent modules. The @code{source-module-closure} +procedure computes the closure of a module by looking at its source file +headers, which comes in handy in this case: + +@example +(use-modules (guix modules)) ;for 'source-module-closure' + +(with-imported-modules (source-module-closure + '((guix build utils) + (gnu build vm))) + (gexp->derivation "something-with-vms" + #~(begin + (use-modules (guix build utils) + (gnu build vm)) + @dots{}))) +@end example + The syntactic form to construct gexps is summarized below. @deffn {Scheme Syntax} #~@var{exp} diff --git a/guix/modules.scm b/guix/modules.scm new file mode 100644 index 000000000..24f613ff4 --- /dev/null +++ b/guix/modules.scm @@ -0,0 +1,155 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix modules) + #:use-module ((guix utils) #:select (memoize)) + #:use-module (guix sets) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:export (source-module-closure + live-module-closure + guix-module-name?)) + +;;; Commentary: +;;; +;;; This module provides introspection tools for Guile modules at the source +;;; level. Namely, it allows you to determine the closure of a module; it +;;; does so just by reading the 'define-module' clause of the module and its +;;; dependencies. This is primarily useful as an argument to +;;; 'with-imported-modules'. +;;; +;;; Code: + +(define (colon-symbol? obj) + "Return true if OBJ is a symbol that starts with a colon." + (and (symbol? obj) + (string-prefix? ":" (symbol->string obj)))) + +(define (colon-symbol->keyword symbol) + "Convert SYMBOL to a keyword after stripping its initial ':'." + (symbol->keyword + (string->symbol (string-drop (symbol->string symbol) 1)))) + +(define (extract-dependencies clauses) + "Return the list of modules imported according to the given 'define-module' +CLAUSES." + (let loop ((clauses clauses) + (result '())) + (match clauses + (() + (reverse result)) + ((#:use-module (module (or #:select #:hide #:prefix #:renamer) _) + rest ...) + (loop rest (cons module result))) + ((#:use-module module rest ...) + (loop rest (cons module result))) + ((#:autoload module _ rest ...) + (loop rest (cons module result))) + (((or #:export #:re-export #:export-syntax #:re-export-syntax + #:replace #:version) + _ rest ...) + (loop rest result)) + (((or #:pure #:no-backtrace) rest ...) + (loop rest result)) + (((? colon-symbol? symbol) rest ...) + (loop (cons (colon-symbol->keyword symbol) rest) + result))))) + +(define module-file-dependencies + (memoize + (lambda (file) + "Return the list of the names of modules that the Guile module in FILE +depends on." + (call-with-input-file file + (lambda (port) + (match (read port) + (('define-module name clauses ...) + (extract-dependencies clauses)) + ;; XXX: R6RS 'library' form is ignored. + (_ + '()))))))) + +(define (module-name->file-name module) + "Return the file name for MODULE." + (string-append (string-join (map symbol->string module) "/") + ".scm")) + +(define (guix-module-name? name) + "Return true if NAME (a list of symbols) denotes a Guix or GuixSD module." + (match name + (('guix _ ...) #t) + (('gnu _ ...) #t) + (_ #f))) + +(define* (source-module-dependencies module #:optional (load-path %load-path)) + "Return the modules used by MODULE by looking at its source code." + ;; The (system syntax) module is a special-case because it has no + ;; corresponding source file (as of Guile 2.0.) + (if (equal? module '(system syntax)) + '() + (module-file-dependencies + (search-path load-path + (module-name->file-name module))))) + +(define* (module-closure modules + #:key + (select? guix-module-name?) + (dependencies source-module-dependencies)) + "Return the closure of MODULES, calling DEPENDENCIES to determine the list +of modules used by a given module. MODULES and the result are a list of Guile +module names. Only modules that match SELECT? are considered." + (let loop ((modules modules) + (result '()) + (visited (set))) + (match modules + (() + (reverse result)) + ((module rest ...) + (cond ((set-contains? visited module) + (loop rest result visited)) + ((select? module) + (loop (append (dependencies module) rest) + (cons module result) + (set-insert module visited))) + (else + (loop rest result visited))))))) + +(define* (source-module-closure modules + #:optional (load-path %load-path) + #:key (select? guix-module-name?)) + "Return the closure of MODULES by reading 'define-module' forms in their +source code. MODULES and the result are a list of Guile module names. Only +modules that match SELECT? are considered." + (module-closure modules + #:dependencies (cut source-module-dependencies <> load-path) + #:select? select?)) + +(define* (live-module-closure modules + #:key (select? guix-module-name?)) + "Return the closure of MODULES, determined by looking at live (loaded) +module information. MODULES and the result are a list of Guile module names. +Only modules that match SELECT? are considered." + (define (dependencies module) + (map module-name + (delq the-scm-module (module-uses (resolve-module module))))) + + (module-closure modules + #:dependencies dependencies + #:select? select?)) + +;;; modules.scm ends here diff --git a/tests/modules.scm b/tests/modules.scm new file mode 100644 index 000000000..04945e531 --- /dev/null +++ b/tests/modules.scm @@ -0,0 +1,45 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-modules) + #:use-module (guix modules) + #:use-module ((guix build-system gnu) #:select (%gnu-build-system-modules)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +(test-begin "modules") + +(test-assert "closure of (guix build gnu-build-system)" + (lset= equal? + (live-module-closure '((guix build gnu-build-system))) + (source-module-closure '((guix build gnu-build-system))) + %gnu-build-system-modules + (source-module-closure %gnu-build-system-modules) + (live-module-closure %gnu-build-system-modules))) + +(test-assert "closure of (gnu build install)" + (lset= equal? + (live-module-closure '((gnu build install))) + (source-module-closure '((gnu build install))))) + +(test-assert "closure of (gnu build vm)" + (lset= equal? + (live-module-closure '((gnu build vm))) + (source-module-closure '((gnu build vm))))) + +(test-end) -- cgit v1.3 From ec2e2f6ce2f808de20f4770748db43aefd46f0bf Mon Sep 17 00:00:00 2001 From: David Craven Date: Sat, 27 Aug 2016 15:38:55 +0200 Subject: services: syslog: Use syslog-configuration. * gnu/services/base.scm (): New variable. (syslog-service-type): Use . (syslog-service): Use . * gnu/tests/base.scm (%avahi-os): Use . * doc/guix.texi (syslog-configuration-type): Add @deftp. (syslog-service): Update @deffn. --- doc/guix.texi | 21 ++++++++++++++++----- gnu/services/base.scm | 29 +++++++++++++++++++++-------- gnu/tests/base.scm | 9 ++++++--- 3 files changed, 43 insertions(+), 16 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index b6ca34a2f..2abb7b231 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7719,12 +7719,23 @@ privacy---often the result of host name lookups is in local cache, so external name servers do not even need to be queried. @end defvr +@anchor{syslog-configuration-type} +@deftp {Data Type} syslog-configuration +This data type represents the configuration of the syslog daemon. -@deffn {Scheme Procedure} syslog-service @ - [#:config-file @var{%default-syslog.conf}] -Return a service that runs @command{syslogd}. If the configuration file -name @var{config-file} is not specified, use some reasonable default -settings. +@table @asis +@item @code{syslogd} (default: @code{#~(string-append #$inetutils "/libexec/syslogd")}) +The syslog daemon to use. + +@item @code{config-file} (default: @code{%default-syslog.conf}) +The syslog configuration file to use. + +@end table +@end deftp + +@anchor{syslog-service} +@deffn {Scheme Procedure} syslog-service @var{config} +Return a service that runs a syslog daemon according to @var{config}. @xref{syslogd invocation,,, inetutils, GNU Inetutils}, for more information on the configuration file syntax. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index f3f640868..2c2962cd8 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -82,6 +82,9 @@ nscd-service-type nscd-service + + syslog-configuration + syslog-configuration? syslog-service syslog-service-type %default-syslog.conf @@ -885,17 +888,27 @@ given @var{config}---an @code{} object. @xref{Name Service Switch}, for an example." (service nscd-service-type config)) + +(define-record-type* + syslog-configuration make-syslog-configuration + syslog-configuration? + (syslogd syslog-configuration-syslogd + (default #~(string-append #$inetutils "/libexec/syslogd"))) + (config-file syslog-configuration-config-file + (default %default-syslog.conf))) + (define syslog-service-type (shepherd-service-type 'syslog - (lambda (config-file) + (lambda (config) (shepherd-service (documentation "Run the syslog daemon (syslogd).") (provision '(syslogd)) (requirement '(user-processes)) (start #~(make-forkexec-constructor - (list (string-append #$inetutils "/libexec/syslogd") - "--no-detach" "--rcfile" #$config-file))) + (list #$(syslog-configuration-syslogd config) + "--no-detach" + "--rcfile" #$(syslog-configuration-config-file config)))) (stop #~(make-kill-destructor)))))) ;; Snippet adapted from the GNU inetutils manual. @@ -921,14 +934,14 @@ Service Switch}, for an example." mail.* /var/log/maillog ")) -(define* (syslog-service #:key (config-file %default-syslog.conf)) - "Return a service that runs @command{syslogd}. If configuration file -name @var{config-file} is not specified, use some reasonable default -settings. +(define* (syslog-service #:optional (config (syslog-configuration))) + "Return a service that runs @command{syslogd} and takes +@var{} as a parameter. @xref{syslogd invocation,,, inetutils, GNU Inetutils}, for more information on the configuration file syntax." - (service syslog-service-type config-file)) + (service syslog-service-type config)) + (define pam-limits-service-type (let ((security-limits diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 41f50c0e7..5c2af5b6d 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -384,9 +384,12 @@ functionality tests.") (log-file "/dev/console"))) (syslog-service-type config => - (plain-file - "syslog.conf" - "*.* /dev/console\n"))))))) + (syslog-configuration + (inherit config) + (config-file + (plain-file + "syslog.conf" + "*.* /dev/console\n"))))))))) (define (run-nss-mdns-test) ;; Test resolution of '.local' names via libc. Start the marionette service -- cgit v1.3 From 935644c01ade149f33e1eeea9ed8647f229aa4d6 Mon Sep 17 00:00:00 2001 From: David Craven Date: Wed, 20 Jul 2016 13:17:48 +0200 Subject: services: Add sddm service. * gnu/services/sddm.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (@deftp, @deffn): Add documentation. --- doc/guix.texi | 103 ++++++++++++++++ gnu/local.mk | 1 + gnu/services/sddm.scm | 318 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 422 insertions(+) create mode 100644 gnu/services/sddm.scm (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 2abb7b231..59bc5d8ee 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8226,6 +8226,109 @@ Xorg---is provided by the @code{(gnu services xorg)} module. Note that there is no @code{xorg-service} procedure. Instead, the X server is started by the @dfn{login manager}, currently SLiM. +@deftp {Data Type} sddm-configuration +This is the data type representing the sddm service configuration. + +@table @asis +@item @code{display-server} (default: "x11") +Select display server to use for the greeter. Valid values are "x11" +or "wayland". + +@item @code{numlock} (default: "on") +Valid values are "on", "off" or "none". + +@item @code{halt-command} (default @code{#~(string-apppend #$shepherd "/sbin/halt")}) +Command to run when halting. + +@item @code{reboot-command} (default @code{#~(string-append #$shepherd "/sbin/reboot")}) +Command to run when rebooting. + +@item @code{theme} (default "maldives") +Theme to use. Default themes provided by SDDM are "elarun" or "maldives". + +@item @code{themes-directory} (default "/run/current-system/profile/share/sddm/themes") +Directory to look for themes. + +@item @code{faces-directory} (default "/run/current-system/profile/share/sddm/faces") +Directory to look for faces. + +@item @code{default-path} (default "/run/current-system/profile/bin") +Default PATH to use. + +@item @code{minimum-uid} (default 1000) +Minimum UID to display in SDDM. + +@item @code{maximum-uid} (default 2000) +Maximum UID to display in SDDM + +@item @code{remember-last-user?} (default #t) +Remember last user. + +@item @code{remember-last-session?} (default #t) +Remember last session. + +@item @code{hide-users} (default "") +Usernames to hide from SDDM greeter. + +@item @code{hide-shells} (default @code{#~(string-append #$shadow "/sbin/nologin")}) +Users with shells listed will be hidden from the SDDM greeter. + +@item @code{session-command} (default @code{#~(string-append #$sddm "/share/sddm/scripts/wayland-session")}) +Script to run before starting a wayland session. + +@item @code{sessions-directory} (default "/run/current-system/profile/share/wayland-sessions") +Directory to look for desktop files starting wayland sessions. + +@item @code{xorg-server-path} (default @code{xorg-start-command}) +Path to xorg-server. + +@item @code{xauth-path} (default @code{#~(string-append #$xauth "/bin/xauth")}) +Path to xauth. + +@item @code{xephyr-path} (default @code{#~(string-append #$xorg-server "/bin/Xephyr")}) +Path to Xephyr. + +@item @code{xdisplay-start} (default @code{#~(string-append #$sddm "/share/sddm/scripts/Xsetup")}) +Script to run after starting xorg-server. + +@item @code{xdisplay-stop} (default @code{#~(string-append #$sddm "/share/sddm/scripts/Xstop")}) +Script to run before stopping xorg-server. + +@item @code{xsession-command} (default: @code{xinitr }) +Script to run before starting a X session. + +@item @code{xsessions-directory} (default: "/run/current-system/profile/share/xsessions") +Directory to look for desktop files starting X sessions. + +@item @code{minimum-vt} (default: 7) +Minimum VT to use. + +@item @code{xserver-arguments} (default "-nolisten tcp") +Arguments to pass to xorg-server. + +@item @code{auto-login-user} (default "") +User to use for auto-login. + +@item @code{auto-login-session} (default "") +Desktop file to use for auto-login. + +@item @code{relogin?} (default #f) +Relogin after logout. + +@end table +@end deftp + +@deffn {Scheme Procedure} sddm-service config +Return a service that spawns the SDDM graphical login manager for config of +type @code{}. + +@example + (sddm-service (sddm-configuration + (auto-login-user "Alice") + (auto-login-session "xfce.desktop"))) +@end example +@end deffn + @deffn {Scheme Procedure} slim-service [#:allow-empty-passwords? #f] @ [#:auto-login? #f] [#:default-user ""] [#:startx] @ [#:theme @var{%default-slim-theme}] @ diff --git a/gnu/local.mk b/gnu/local.mk index 50363ef02..0a9b831aa 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -391,6 +391,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/networking.scm \ %D%/services/shepherd.scm \ %D%/services/herd.scm \ + %D%/services/sddm.scm \ %D%/services/spice.scm \ %D%/services/ssh.scm \ %D%/services/web.scm \ diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm new file mode 100644 index 000000000..ab6672b0e --- /dev/null +++ b/gnu/services/sddm.scm @@ -0,0 +1,318 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 David Craven +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services sddm) + #:use-module (gnu packages admin) + #:use-module (gnu packages display-managers) + #:use-module (gnu packages freedesktop) + #:use-module (gnu packages xorg) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu services xorg) + #:use-module (gnu system pam) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix records) + #:export (sddm-configuration + sddm-confiugration? + sddm-service-type + sddm-service)) + +(define-record-type* + sddm-configuration make-sddm-configuration + sddm-configuration? + (sddm sddm-configuration-sddm + (default sddm)) + + ;; [General] + ;; valid values are x11 and wayland + ;; currently doesn't do anything is enabled by wayland greeter PR + (display-server sddm-configuration-display-server + (default "x11")) + ;; valid values are on, off or none + (numlock sddm-configuration-numlock + (default "on")) + (halt-command sddm-configuration-halt-command + (default #~(string-append #$shepherd "/sbin/halt"))) + (reboot-command sddm-configuration-reboot-command + (default #~(string-append #$shepherd "/sbin/reboot"))) + + ;; [Theme] + ;; valid values are elarun or maldives + (theme sddm-configuration-theme + (default "maldives")) + (themes-directory sddm-configuration-themes-directory + (default "/run/current-system/profile/share/sddm/themes")) + (faces-directory sddm-configuration-faces-directory + (default "/run/current-system/profile/share/sddm/faces")) + + ;; [Users] + (default-path sddm-configuration-default-path + (default "/run/current-system/profile/bin")) + (minimum-uid sddm-configuration-minimum-uid + (default 1000)) + (maximum-uid sddm-configuration-maximum-uid + (default 2000)) + (remember-last-user? sddm-configuration-remember-last-user? + (default #t)) + (remember-last-session? sddm-configuration-remember-last-session? + (default #t)) + (hide-users sddm-configuration-hide-users + (default "")) + (hide-shells sddm-configuration-hide-shells + (default #~(string-append #$shadow "/sbin/nologin"))) + + ;; [Wayland] + (session-command sddm-configuration-session-command + (default #~(string-append #$sddm "/share/sddm/scripts/wayland-session"))) + (sessions-directory sddm-configuration-sessions-directory + (default "/run/current-system/profile/share/wayland-sessions")) + ;; [X11] + (xorg-server-path sddm-configuration-xorg-server-path + (default (xorg-start-command))) + (xauth-path sddm-configuration-xauth-path + (default #~(string-append #$xauth "/bin/xauth"))) + (xephyr-path sddm-configuration-xephyr-path + (default #~(string-append #$xorg-server "/bin/Xephyr"))) + (xdisplay-start sddm-configuration-xdisplay-start + (default #~(string-append #$sddm "/share/sddm/scripts/Xsetup"))) + (xdisplay-stop sddm-configuration-xdisplay-stop + (default #~(string-append #$sddm "/share/sddm/scripts/Xstop"))) + (xsession-command sddm-configuration-xsession-command + (default (xinitrc))) + (xsessions-directory sddm-configuration-xsessions-directory + (default "/run/current-system/profile/share/xsessions")) + (minimum-vt sddm-configuration-minimum-vt + (default 7)) + (xserver-arguments sddm-configuration-xserver-arguments + (default "-nolisten tcp")) + + ;; [Autologin] + (auto-login-user sddm-configuration-auto-login-user + (default "")) + ;; valid values are xfce.desktop gnome.desktop weston.desktop hawaii.desktop + (auto-login-session sddm-configuration-auto-login-session + (default "")) + (relogin? sddm-configuration-relogin? + (default #f))) + +(define (sddm-configuration-file config) + (mixed-text-file "sddm.conf" " +[General] +DisplayServer=" (sddm-configuration-display-server config) " +Numlock=" (sddm-configuration-numlock config) " +HaltCommand=" (sddm-configuration-halt-command config) " +RebootCommand=" (sddm-configuration-reboot-command config) " + +[Users] +DefaultPath=" (sddm-configuration-default-path config) " +MinimumUid=" (number->string (sddm-configuration-minimum-uid config))" +MaximumUid=" (number->string (sddm-configuration-maximum-uid config))" +RememberLastUser=" (if (sddm-configuration-remember-last-user? config) + "true" "false") " +RememberLastSession=" (if (sddm-configuration-remember-last-session? config) + "true" "false") " +HideUsers=" (sddm-configuration-hide-users config) " +Hideshells=" (sddm-configuration-hide-shells config) " + +[Theme] +Current=" (sddm-configuration-theme config) " +ThemeDir=" (sddm-configuration-themes-directory config) " +FacesDir=" (sddm-configuration-faces-directory config) " + +[Wayland] +SessionCommand=" (sddm-configuration-session-command config) " +SessionDir=" (sddm-configuration-sessions-directory config) " + +[X11] +ServerPath=" (sddm-configuration-xorg-server-path config) " +XauthPath=" (sddm-configuration-xauth-path config) " +XephyrPath=" (sddm-configuration-xephyr-path config) " +DisplayCommand=" (sddm-configuration-xdisplay-start config) " +DisplayStopCommand=" (sddm-configuration-xdisplay-stop config) " +SessionCommand=" (sddm-configuration-xsession-command config) " +SessionDir=" (sddm-configuration-xsessions-directory config) " +MinimumVT=" (number->string (sddm-configuration-minimum-vt config)) " +ServerArguments=" (sddm-configuration-xserver-arguments config) " + +[Autologin] +User=" (sddm-configuration-auto-login-user config) " +Session=" (sddm-configuration-auto-login-session config) " +Relogin=" (if (sddm-configuration-relogin? config) + "true" "false") " +")) + +(define (sddm-shepherd-service config) + "Return a for sddm with CONFIG." + + (define sddm-command + #~(list (string-append #$(sddm-configuration-sddm config) "/bin/sddm"))) + + (list (shepherd-service + (documentation "SDDM display manager.") + (requirement '(user-processes)) + (provision '(display-manager)) + (start #~(make-forkexec-constructor #$sddm-command)) + (stop #~(make-kill-destructor))))) + +(define (sddm-etc-service config) + (list `("sddm.conf" ,(sddm-configuration-file config)))) + +(define (sddm-pam-service) + "Return a PAM service for @command{sddm}." + (pam-service + (name "sddm") + (auth + (list + (pam-entry + (control "requisite") + (module "pam_nologin.so")) + (pam-entry + (control "required") + (module "pam_env.so")) + (pam-entry + (control "required") + (module "pam_succeed_if.so") + (arguments (list "uid >= 1000" "quiet"))) + ;; should be factored out into system-auth + (pam-entry + (control "required") + (module "pam_unix.so")))) + (account + (list + ;; should be factored out into system-account + (pam-entry + (control "required") + (module "pam_unix.so")))) + (password + (list + ;; should be factored out into system-password + (pam-entry + (control "required") + (module "pam_unix.so") + (arguments (list "sha512" "shadow" "try_first_pass"))))) + (session + (list + ;; lfs has a required pam_limits.so + ;; should be factored out into system-session + (pam-entry + (control "required") + (module "pam_unix.so")))))) + +(define (sddm-greeter-pam-service) + "Return a PAM service for @command{sddm-greeter}." + (pam-service + (name "sddm-greeter") + (auth + (list + ;; Load environment form /etc/environment and ~/.pam_environment + (pam-entry + (control "required") + (module "pam_env.so")) + ;; Always let the greeter start without authentication + (pam-entry + (control "required") + (module "pam_permit.so")))) + (account + (list + ;; No action required for account management + (pam-entry + (control "required") + (module "pam_permit.so")))) + (password + (list + ;; Can't change password + (pam-entry + (control "required") + (module "pam_deny.so")))) + (session + (list + ;; Setup session + (pam-entry + (control "required") + (module "pam_unix.so")))))) + +(define (sddm-autologin-pam-service) + "Return a PAM service for @command{sddm-autologin}" + (pam-service + (name "sddm-autologin") + (auth + (list + (pam-entry + (control "requisite") + (module "pam_nologin.so")) + (pam-entry + (control "required") + (module "pam_succeed_if.so") + (arguments (list "uid >= 1000" "quiet"))) + (pam-entry + (control "required") + (module "pam_permit.so")))) + (account + (list + (pam-entry + (control "include") + (module "sddm")))) + (password + (list + (pam-entry + (control "required") + (module "pam_deny.so")))) + (session + (list + (pam-entry + (control "include") + (module "sddm")))))) + +(define (sddm-pam-services config) + (list (sddm-pam-service) + (sddm-greeter-pam-service) + (sddm-autologin-pam-service))) + +(define %sddm-accounts + (list (user-group (name "sddm") (system? #t)) + (user-account + (name "sddm") + (group "sddm") + (system? #t) + (comment "SDDM user") + (home-directory "/var/lib/sddm") + (shell #~(string-append #$shadow "/sbin/nologin"))))) + +;; Add default themes to profile +(define sddm-profile-service + (compose list sddm-configuration-sddm)) + +(define sddm-service-type + (service-type (name 'sddm) + (extensions + (list (service-extension shepherd-root-service-type + sddm-shepherd-service) + (service-extension etc-service-type + sddm-etc-service) + (service-extension pam-root-service-type + sddm-pam-services) + (service-extension account-service-type + (const %sddm-accounts)) + (service-extension profile-service-type + sddm-profile-service))))) + +(define* (sddm-service #:optional (config (sddm-configuration))) + "Run the @uref{https://github.com/sddm/sddm,SSDM display manager} +with the given @var{config}, a @code{} object." + (service sddm-service-type config)) -- cgit v1.3 From 392a4e122350367c4b4ac331db5ec28360c7f38c Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 6 Sep 2016 08:28:33 +0200 Subject: guix hash: Add --exclude-vcs option. * guix/scripts/hash.scm (show-help): Add help text for --exclude-vcs option. (%options): Add --exclude-vcs option. (guix-hash): Handle exclude-vcs option. * doc/guix.texi ("Invoking guix hash"): Update doc. * tests/guix-hash.sh: Add test. Co-authored-by: Ludovic Courtès --- doc/guix.texi | 10 +++++++--- guix/scripts/hash.scm | 25 ++++++++++++++++++++----- tests/guix-hash.sh | 16 ++++++++++++++++ 3 files changed, 43 insertions(+), 8 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 59bc5d8ee..655dcfa27 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4678,7 +4678,7 @@ The general syntax is: guix hash @var{option} @var{file} @end example -@command{guix hash} has the following option: +@command{guix hash} has the following options: @table @code @@ -4706,6 +4706,11 @@ hash (@pxref{Invoking guix archive}). @c FIXME: Replace xref above with xref to an ``Archive'' section when @c it exists. +@item --exclude-vcs +@itemx -x +When combined with @option{--recursive}, exclude version control system +directories (@file{.bzr}, @file{.git}, @file{.hg}, etc.) + @vindex git-fetch As an example, here is how you would compute the hash of a Git checkout, which is useful when using the @code{git-fetch} method (@pxref{origin @@ -4714,8 +4719,7 @@ Reference}): @example $ git clone http://example.org/foo.git $ cd foo -$ rm -rf .git -$ guix hash -r . +$ guix hash -rx . @end example @end table diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index d44095377..a57602ab5 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2016 Jan Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -48,6 +49,8 @@ Return the cryptographic hash of FILE. Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex' and 'hexadecimal' can be used as well).\n")) + (format #t (_ " + -x, --exclude-vcs exclude version control directories")) (format #t (_ " -f, --format=FMT write the hash in the given format")) (format #t (_ " @@ -62,7 +65,10 @@ and 'hexadecimal' can be used as well).\n")) (define %options ;; Specification of the command-line options. - (list (option '(#\f "format") #t #f + (list (option '(#\x "exclude-vcs") #f #f + (lambda (opt name arg result) + (alist-cons 'exclude-vcs? #t result))) + (option '(#\f "format") #t #f (lambda (opt name arg result) (define fmt-proc (match arg @@ -81,7 +87,6 @@ and 'hexadecimal' can be used as well).\n")) (option '(#\r "recursive") #f #f (lambda (opt name arg result) (alist-cons 'recursive? #t result))) - (option '(#\h "help") #f #f (lambda args (show-help) @@ -107,13 +112,23 @@ and 'hexadecimal' can be used as well).\n")) (alist-cons 'argument arg result)) %default-options)) + (define (vcs-file? file stat) + (case (stat:type stat) + ((directory) + (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) + (else + #f))) + (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) value) (_ #f)) (reverse opts))) - (fmt (assq-ref opts 'format))) + (fmt (assq-ref opts 'format)) + (select? (if (assq-ref opts 'exclude-vcs?) + (negate vcs-file?) + (const #t)))) (define (file-hash file) ;; Compute the hash of FILE. @@ -121,7 +136,7 @@ and 'hexadecimal' can be used as well).\n")) (with-error-handling (if (assoc-ref opts 'recursive?) (let-values (((port get-hash) (open-sha256-port))) - (write-file file port) + (write-file file port #:select? select?) (flush-output-port port) (get-hash)) (call-with-input-file file port-sha256)))) diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh index 23df01d41..44213d51a 100644 --- a/tests/guix-hash.sh +++ b/tests/guix-hash.sh @@ -1,5 +1,6 @@ # GNU Guix --- Functional package management for GNU # Copyright © 2013, 2014 Ludovic Courtès +# Copyright © 2016 Jan Nieuwenhuizen # # This file is part of GNU Guix. # @@ -46,3 +47,18 @@ then false; else true; fi # the archive format doesn't support. if guix hash -r /dev/null then false; else true; fi + +# Adding a .git directory +mkdir "$tmpdir/.git" +touch "$tmpdir/.git/foo" + +# ...changes the hash +test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59 + +# ...but remains the same when using `-x' +test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p + +# Without '-r', this should fail. +if guix hash "$tmpdir" +then false; else true; fi + -- cgit v1.3 From d6a07ee6751cdd414d702194dbeb0fd71f0781c9 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sat, 3 Sep 2016 08:26:05 +0200 Subject: gnu: Add rpc-daemon service * gnu/services/nfs.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- doc/guix.texi | 26 +++++++++++++++++++++++++ gnu/local.mk | 1 + gnu/services/nfs.scm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 81 insertions(+) create mode 100644 gnu/services/nfs.scm (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 655dcfa27..fb7284eb2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -25,6 +25,7 @@ Copyright @copyright{} 2015, 2016 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* Copyright @copyright{} 2016 Chris Marusich@* Copyright @copyright{} 2016 Efraim Flashner@* +Copyright @copyright{} 2016 John Darrington@* Copyright @copyright{} 2016 ng0 Permission is granted to copy, distribute and/or modify this document @@ -10093,6 +10094,31 @@ directories are created when the service is activated. @node Various Services @subsubsection Various Services + +@subsubheading RPC Bind Service +@cindex rpcbind + +The @code{(gnu services nfs)} module provides the following: + +@defvr {Scheme Variable} rpcbind-service-type +A service type for the RPC portmapper daemon. +@end defvr + + +@deftp {Data Type} rpcbind-configuration +Data type representing the configuration of the RPC Bind Service. +This type has the following parameters: +@table @asis +@item @code{rpcbind} (default: @code{rpcbind}) +The rpcbind package to use. + +@item @code{warm-start?} (default: @code{#t}) +If this parameter is @code{#t}, then the daemon will read a +state file on startup thus reloading state information saved by a previous +instance. +@end table +@end deftp + @cindex lirc @subsubheading Lirc Service diff --git a/gnu/local.mk b/gnu/local.mk index 12578cad6..8b042d597 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -389,6 +389,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/mail.scm \ %D%/services/mcron.scm \ %D%/services/networking.scm \ + %D%/services/nfs.scm \ %D%/services/shepherd.scm \ %D%/services/herd.scm \ %D%/services/sddm.scm \ diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm new file mode 100644 index 000000000..82713d813 --- /dev/null +++ b/gnu/services/nfs.scm @@ -0,0 +1,54 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 John Darrington +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services nfs) + #:use-module (gnu) + #:use-module (gnu services shepherd) + #:use-module (gnu packages onc-rpc) + #:use-module (guix) + #:use-module (guix records) + #:export (rpcbind-service-type + rpcbind-configuration + rpcbind-configuration?)) + +(define-record-type* + rpcbind-configuration make-rpcbind-configuration + rpcbind-configuration? + (rpcbind rpcbind-configuration-rpcbind + (default rpcbind)) + (warm-start? rpcbind-configuration-warm-start? + (default #t))) + +(define rpcbind-service-type + (shepherd-service-type + 'rpcbind + (lambda (config) + (define pkg + (rpcbind-configuration-rpcbind config)) + + (define rpcbind-command + #~(list (string-append #$pkg "/bin/rpcbind") "-f" + #$@(if (rpcbind-configuration-warm-start? config) '("-w") '()))) + + (shepherd-service + (documentation "Start the RPC bind daemon.") + (requirement '(networking)) + (provision '(rpcbind-daemon)) + + (start #~(make-forkexec-constructor #$rpcbind-command)) + (stop #~(make-kill-destructor)))))) -- cgit v1.3 From 29e53b95f7db941296f7ff8f05e7525010362af6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 7 Sep 2016 22:55:43 +0200 Subject: doc: Update package count. * doc/guix.texi (Limitations): Update package count. --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index fb7284eb2..3923627c7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6156,7 +6156,7 @@ Few system services are currently supported out-of-the-box (@pxref{Services}). @item -More than 3,200 packages are available, but you may +More than 4,000 packages are available, but you may occasionally find that a useful package is missing. @item -- cgit v1.3 From a9e5e92f940381e3a4ee828c6d8ff22a73067e17 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 9 Sep 2016 22:46:36 +0200 Subject: gexp: Add 'file-append'. * guix/gexp.scm (): New record type. (file-append): New procedure. (file-append-compiler): New gexp compiler. * tests/gexp.scm ("file-append", "file-append, output") ("file-append, nested", "gexp->file + file-append"): New tests. * doc/guix.texi (G-Expressions): Use it in 'nscd' and 'list-files' examples. Document 'file-append'. --- doc/guix.texi | 35 +++++++++++++++++++++++++++++++---- guix/gexp.scm | 29 +++++++++++++++++++++++++++++ tests/gexp.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 113 insertions(+), 4 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 3923627c7..6d3361878 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3985,7 +3985,7 @@ The @code{local-file}, @code{plain-file}, @code{computed-file}, these objects lead to a file in the store. Consider this G-expression: @example -#~(system* (string-append #$glibc "/sbin/nscd") "-f" +#~(system* #$(file-append glibc "/sbin/nscd") "-f" #$(local-file "/tmp/my-nscd.conf")) @end example @@ -4044,7 +4044,7 @@ command: (use-modules (guix gexp) (gnu packages base)) (gexp->script "list-files" - #~(execl (string-append #$coreutils "/bin/ls") + #~(execl #$(file-append coreutils "/bin/ls") "ls")) @end example @@ -4055,8 +4055,7 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines: @example #!/gnu/store/@dots{}-guile-2.0.11/bin/guile -ds !# -(execl (string-append "/gnu/store/@dots{}-coreutils-8.22"/bin/ls") - "ls") +(execl "/gnu/store/@dots{}-coreutils-8.22"/bin/ls" "ls") @end example @end deffn @@ -4126,6 +4125,34 @@ as in: This is the declarative counterpart of @code{text-file*}. @end deffn +@deffn {Scheme Procedure} file-append @var{obj} @var{suffix} @dots{} +Return a file-like object that expands to the concatenation of @var{obj} +and @var{suffix}, where @var{obj} is a lowerable object and each +@var{suffix} is a string. + +As an example, consider this gexp: + +@example +(gexp->script "run-uname" + #~(system* #$(file-append coreutils + "/bin/uname"))) +@end example + +The same effect could be achieved with: + +@example +(gexp->script "run-uname" + #~(system* (string-append #$coreutils + "/bin/uname"))) +@end example + +There is one difference though: in the @code{file-append} case, the +resulting script contains the absolute file name as a string, whereas in +the second case, the resulting script contains a @code{(string-append +@dots{})} expression to construct the file name @emph{at run time}. +@end deffn + + Of course, in addition to gexps embedded in ``host'' code, there are also modules containing build tools. To make it clear that they are meant to be used in the build stratum, these modules are kept in the diff --git a/guix/gexp.scm b/guix/gexp.scm index 8d380ec95..7e2ecf6c3 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -63,6 +63,11 @@ scheme-file-name scheme-file-gexp + file-append + file-append? + file-append-base + file-append-suffix + gexp->derivation gexp->file gexp->script @@ -368,6 +373,30 @@ This is the declarative counterpart of 'gexp->file'." (($ name gexp) (gexp->file name gexp)))) +;; Appending SUFFIX to BASE's output file name. +(define-record-type + (%file-append base suffix) + file-append? + (base file-append-base) ; | | ... + (suffix file-append-suffix)) ;list of strings + +(define (file-append base . suffix) + "Return a object that expands to the concatenation of BASE and +SUFFIX." + (%file-append base suffix)) + +(define-gexp-compiler file-append-compiler file-append? + compiler => (lambda (obj system target) + (match obj + (($ base _) + (lower-object base system #:target target)))) + expander => (lambda (obj lowered output) + (match obj + (($ base suffix) + (let* ((expand (lookup-expander base)) + (base (expand base lowered output))) + (string-append base (string-concatenate suffix))))))) + ;;; ;;; Inputs & outputs. diff --git a/tests/gexp.scm b/tests/gexp.scm index 03a64fa6b..214e7a530 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -207,6 +207,47 @@ (e3 `(display ,txt))) (equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp)))))) +(test-assert "file-append" + (let* ((drv (package-derivation %store %bootstrap-guile)) + (fa (file-append %bootstrap-guile "/bin/guile")) + (exp #~(here we go #$fa))) + (and (match (gexp->sexp* exp) + (('here 'we 'go (? string? result)) + (string=? result + (string-append (derivation->output-path drv) + "/bin/guile")))) + (match (gexp-inputs exp) + (((thing "out")) + (eq? thing fa)))))) + +(test-assert "file-append, output" + (let* ((drv (package-derivation %store glibc)) + (fa (file-append glibc "/lib" "/debug")) + (exp #~(foo #$fa:debug))) + (and (match (gexp->sexp* exp) + (('foo (? string? result)) + (string=? result + (string-append (derivation->output-path drv "debug") + "/lib/debug")))) + (match (gexp-inputs exp) + (((thing "debug")) + (eq? thing fa)))))) + +(test-assert "file-append, nested" + (let* ((drv (package-derivation %store glibc)) + (dir (file-append glibc "/bin")) + (slash (file-append dir "/")) + (file (file-append slash "getent")) + (exp #~(foo #$file))) + (and (match (gexp->sexp* exp) + (('foo (? string? result)) + (string=? result + (string-append (derivation->output-path drv) + "/bin/getent")))) + (match (gexp-inputs exp) + (((thing "out")) + (eq? thing file)))))) + (test-assert "ungexp + ungexp-native" (let* ((exp (gexp (list (ungexp-native %bootstrap-guile) (ungexp coreutils) @@ -338,6 +379,18 @@ (return (and (equal? sexp (call-with-input-file out read)) (equal? (list guile) refs))))) +(test-assertm "gexp->file + file-append" + (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile + "/bin/guile")) + (guile (package-file %bootstrap-guile)) + (drv (gexp->file "foo" exp)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv))) + (refs ((store-lift references) out))) + (return (and (equal? (string-append guile "/bin/guile") + (call-with-input-file out read)) + (equal? (list guile) refs))))) + (test-assertm "gexp->derivation" (mlet* %store-monad ((file (text-file "foo" "Hello, world!")) (exp -> (gexp -- cgit v1.3 From 44d5f54e31039d78f156bd9562dca293124eaa76 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 9 Sep 2016 23:27:00 +0200 Subject: system: grub: Allow arbitrary kernel file names in 'menu-entry'. Fixes . Reported by Tomáš Čech . * gnu/system.scm (system-linux-image-file-name) (operating-system-kernel-file): New procedures. (operating-system-grub.cfg): Use 'operating-system-kernel-file' for the 'kernel' field of 'menu-entry'. (operating-system-parameters-file): Likewise for the 'kernel' entry. (read-boot-parameters): Adjust 'kernel' field so that it contains the absolute file name of the image. * gnu/system/grub.scm (grub-configuration-file)[linux-image-name]: Remove. [entry->gexp]: Assume LINUX is the absolute file name of the kernel image. * doc/guix.texi (GRUB Configuration): Add an example, and adjust 'kernel' field documentation accordingly. --- doc/guix.texi | 22 ++++++++++++++++++++-- gnu/system.scm | 30 ++++++++++++++++++++++++++---- gnu/system/grub.scm | 13 +++---------- 3 files changed, 49 insertions(+), 16 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 6d3361878..7ed8ee813 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10622,9 +10622,23 @@ The @code{grub-theme} object describing the theme to use. @end deftp +@cindex dual boot +@cindex boot menu Should you want to list additional boot menu entries @i{via} the @code{menu-entries} field above, you will need to create them with the -@code{menu-entry} form: +@code{menu-entry} form. For example, imagine you want to be able to +boot another distro (hard to imagine!), you can define a menu entry +along these lines: + +@example +(menu-entry + (label "The Other Distro") + (linux "/boot/old/vmlinux-2.6.32") + (linux-arguments '("root=/dev/sda2")) + (initrd "/boot/old/initrd")) +@end example + +Details below. @deftp {Data Type} menu-entry The type of an entry in the GRUB boot menu. @@ -10635,7 +10649,11 @@ The type of an entry in the GRUB boot menu. The label to show in the menu---e.g., @code{"GNU"}. @item @code{linux} -The Linux kernel to boot. +The Linux kernel image to boot, for example: + +@example +(file-append linux-libre "/bzImage") +@end example @item @code{linux-arguments} (default: @code{()}) The list of extra Linux kernel command-line arguments---e.g., diff --git a/gnu/system.scm b/gnu/system.scm index 080201011..18b2806fe 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -69,6 +69,7 @@ operating-system-host-name operating-system-hosts-file operating-system-kernel + operating-system-kernel-file operating-system-kernel-arguments operating-system-initrd operating-system-users @@ -246,6 +247,19 @@ from the initrd." "Return the list of swap services for OS." (map swap-service (operating-system-swap-devices os))) +(define* (system-linux-image-file-name #:optional (system (%current-system))) + "Return the basename of the kernel image file for SYSTEM." + ;; FIXME: Evaluate the conditional based on the actual current system. + (if (string-prefix? "mips" (%current-system)) + "vmlinuz" + "bzImage")) + +(define (operating-system-kernel-file os) + "Return an object representing the absolute file name of the kernel image of +OS." + (file-append (operating-system-kernel os) + "/" (system-linux-image-file-name os))) + (define* (operating-system-directory-base-entries os #:key container?) "Return the basic entries of the 'system' directory of OS for use as the value of the SYSTEM-SERVICE-TYPE service." @@ -710,12 +724,13 @@ listed in OS. The C library expects to find it under ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) (store-fs -> (operating-system-store-file-system os)) - (kernel -> (operating-system-kernel os)) + (label -> (kernel->grub-label (operating-system-kernel os))) + (kernel -> (operating-system-kernel-file os)) (root-device -> (if (eq? 'uuid (file-system-title root-fs)) (uuid->string (file-system-device root-fs)) (file-system-device root-fs))) (entries -> (list (menu-entry - (label (kernel->grub-label kernel)) + (label label) (linux kernel) (linux-arguments (cons* (string-append "--root=" root-device) @@ -739,7 +754,7 @@ this file is the reconstruction of GRUB menu entries for old configurations." #~(boot-parameters (version 0) (label #$label) (root-device #$(file-system-device root)) - (kernel #$(operating-system-kernel os)) + (kernel #$(operating-system-kernel-file os)) (kernel-arguments #$(operating-system-kernel-arguments os)) (initrd #$initrd)) @@ -768,7 +783,14 @@ this file is the reconstruction of GRUB menu entries for old configurations." (boot-parameters (label label) (root-device root) - (kernel linux) + + ;; In the past, we would store the directory name of the kernel instead + ;; of the absolute file name of its image. Detect that and correct it. + (kernel (if (string=? linux (direct-store-path linux)) + (string-append linux "/" + (system-linux-image-file-name)) + linux)) + (kernel-arguments (match (assq 'kernel-arguments rest) ((_ args) args) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index aa93c0f45..459274708 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -243,11 +243,6 @@ code." object, and where the store is available at STORE-FS, a object. OLD-ENTRIES is taken to be a list of menu entries corresponding to old generations of the system." - (define linux-image-name - (if (string-prefix? "mips" system) - "vmlinuz" - "bzImage")) - (define all-entries (append entries (grub-configuration-menu-entries config))) @@ -256,14 +251,12 @@ corresponding to old generations of the system." (($ label linux arguments initrd) #~(format port "menuentry ~s { ~a - linux ~a/~a ~a + linux ~a ~a initrd ~a }~%" #$label - #$(grub-root-search store-fs - #~(string-append #$linux "/" - #$linux-image-name)) - #$linux #$linux-image-name (string-join (list #$@arguments)) + #$(grub-root-search store-fs linux) + #$linux (string-join (list #$@arguments)) #$initrd)))) (mlet %store-monad ((sugar (eye-candy config store-fs system #~port))) -- cgit v1.3 From 317d3b474ab5e0e62509dd1b5b2fbbf2e27c95fe Mon Sep 17 00:00:00 2001 From: David Craven Date: Tue, 6 Sep 2016 15:58:49 +0200 Subject: services: Add login-service. * gnu/services/base.scm (%default-motd, , login-pam-service, login-serivce-type, login-service): New variables. (, mingetty-shepherd-service, mingetty-serivce-type): Remove motd. Remove allow-empty-passwords?. Remove mingetty-pam-service. (%base-services): Add login-service. Remove motd. --- doc/guix.texi | 27 +++++++++-- gnu/services/base.scm | 131 ++++++++++++++++++++++++++++---------------------- 2 files changed, 96 insertions(+), 62 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 7ed8ee813..41b8d5db0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6753,8 +6753,7 @@ following in your operating system declaration: (extra-options '("--gc-keep-derivations")))) (mingetty-service-type config => (mingetty-configuration - (inherit config) - (motd (plain-file "motd" "Howdy!")))))) + (inherit config))))) (operating-system ;; @dots{} @@ -7619,6 +7618,27 @@ this: Return a service that sets the host name to @var{name}. @end deffn +@deffn {Scheme Procedure} login-service @var{config} +Return a service to run login according to @var{config}, a +@code{} object, which specifies the message of the day, +among other things. +@end deffn + +@deftp {Data Type} login-configuration +This is the data type representing the configuration of login. + +@table @asis + +@item @code{motd} +A file-like object containing the ``message of the day''. + +@item @code{allow-empty-passwords?} (default: @code{#t}) +Allow empty passwords by default so that first-time users can log in when +the 'root' account has just been created. + +@end table +@end deftp + @deffn {Scheme Procedure} mingetty-service @var{config} Return a service to run mingetty according to @var{config}, a @code{} object, which specifies the tty to run, among @@ -7634,9 +7654,6 @@ implements console log-in. @item @code{tty} The name of the console this Mingetty runs on---e.g., @code{"tty1"}. -@item @code{motd} -A file-like object containing the ``message of the day''. - @item @code{auto-login} (default: @code{#f}) When true, this field must be a string denoting the user name under which the system automatically logs in. When it is @code{#f}, a diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 07c08d756..20a9c3ae1 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -66,6 +66,11 @@ udev-service udev-rule + login-configuration + login-configuration? + login-service-type + login-service + mingetty-configuration mingetty-configuration? mingetty-service @@ -656,41 +661,55 @@ strings or string-valued gexps." ;; codepoints notably found in the UTF-8 manual. (service console-font-service-type (list tty font))) +(define %default-motd + (plain-file "motd" "This is the GNU operating system, welcome!\n\n")) + +(define-record-type* + login-configuration make-login-configuration + login-configuration? + (motd login-configuration-motd ;file-like + (default %default-motd)) + ;; Allow empty passwords by default so that first-time users can log in when + ;; the 'root' account has just been created. + (allow-empty-passwords? login-configuration-allow-empty-passwords? + (default #t))) ;Boolean + +(define (login-pam-service config) + "Return the list of PAM service needed for CONF." + ;; Let 'login' be known to PAM. + (list (unix-pam-service "login" + #:allow-empty-passwords? + (login-configuration-allow-empty-passwords? config) + #:motd + (login-configuration-motd config)))) + +(define login-service-type + (service-type (name 'login) + (extensions (list (service-extension pam-root-service-type + login-pam-service))))) + +(define* (login-service #:optional (config (login-configuration))) + "Return a service configure login according to @var{config}, which specifies +the message of the day, among other things." + (service login-service-type config)) + (define-record-type* mingetty-configuration make-mingetty-configuration mingetty-configuration? (mingetty mingetty-configuration-mingetty ; (default mingetty)) (tty mingetty-configuration-tty) ;string - (motd mingetty-configuration-motd ;file-like - (default (plain-file "motd" "Welcome.\n"))) (auto-login mingetty-auto-login ;string | #f (default #f)) (login-program mingetty-login-program ;gexp (default #f)) (login-pause? mingetty-login-pause? ;Boolean - (default #f)) - - ;; Allow empty passwords by default so that first-time users can log in when - ;; the 'root' account has just been created. - (allow-empty-passwords? mingetty-configuration-allow-empty-passwords? - (default #t))) ;Boolean - -(define (mingetty-pam-service conf) - "Return the list of PAM service needed for CONF." - ;; Let 'login' be known to PAM. All the mingetty services will have that - ;; PAM service, but that's fine because they're all identical and duplicates - ;; are removed. - (list (unix-pam-service "login" - #:allow-empty-passwords? - (mingetty-configuration-allow-empty-passwords? conf) - #:motd - (mingetty-configuration-motd conf)))) + (default #f))) (define mingetty-shepherd-service (match-lambda - (($ mingetty tty motd auto-login login-program - login-pause? allow-empty-passwords?) + (($ mingetty tty auto-login login-program + login-pause?) (list (shepherd-service (documentation "Run mingetty on an tty.") @@ -718,9 +737,7 @@ strings or string-valued gexps." (define mingetty-service-type (service-type (name 'mingetty) (extensions (list (service-extension shepherd-root-service-type - mingetty-shepherd-service) - (service-extension pam-root-service-type - mingetty-pam-service))))) + mingetty-shepherd-service))))) (define* (mingetty-service config) "Return a service to run mingetty according to @var{config}, which specifies @@ -1435,38 +1452,38 @@ This service is not part of @var{%base-services}." (define %base-services ;; Convenience variable holding the basic services. - (let ((motd (plain-file "motd" " -This is the GNU operating system, welcome!\n\n"))) - (list (console-font-service "tty1") - (console-font-service "tty2") - (console-font-service "tty3") - (console-font-service "tty4") - (console-font-service "tty5") - (console-font-service "tty6") - - (mingetty-service (mingetty-configuration - (tty "tty1") (motd motd))) - (mingetty-service (mingetty-configuration - (tty "tty2") (motd motd))) - (mingetty-service (mingetty-configuration - (tty "tty3") (motd motd))) - (mingetty-service (mingetty-configuration - (tty "tty4") (motd motd))) - (mingetty-service (mingetty-configuration - (tty "tty5") (motd motd))) - (mingetty-service (mingetty-configuration - (tty "tty6") (motd motd))) - - (static-networking-service "lo" "127.0.0.1" - #:provision '(loopback)) - (syslog-service) - (urandom-seed-service) - (guix-service) - (nscd-service) - - ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is - ;; used, so enable them by default. The FUSE and ALSA rules are - ;; less critical, but handy. - (udev-service #:rules (list lvm2 fuse alsa-utils crda))))) + (list (login-service) + + (console-font-service "tty1") + (console-font-service "tty2") + (console-font-service "tty3") + (console-font-service "tty4") + (console-font-service "tty5") + (console-font-service "tty6") + + (mingetty-service (mingetty-configuration + (tty "tty1"))) + (mingetty-service (mingetty-configuration + (tty "tty2"))) + (mingetty-service (mingetty-configuration + (tty "tty3"))) + (mingetty-service (mingetty-configuration + (tty "tty4"))) + (mingetty-service (mingetty-configuration + (tty "tty5"))) + (mingetty-service (mingetty-configuration + (tty "tty6"))) + + (static-networking-service "lo" "127.0.0.1" + #:provision '(loopback)) + (syslog-service) + (urandom-seed-service) + (guix-service) + (nscd-service) + + ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is + ;; used, so enable them by default. The FUSE and ALSA rules are + ;; less critical, but handy. + (udev-service #:rules (list lvm2 fuse alsa-utils crda)))) ;;; base.scm ends here -- cgit v1.3 From 46ec2707a459f376dd72ea6e545662f51157c95e Mon Sep 17 00:00:00 2001 From: David Craven Date: Wed, 20 Jul 2016 13:17:07 +0200 Subject: services: Add kmscon service. * gnu/services/base.scm (, kmscon-service-type): New variables. * doc/guix.texi (@deffn kmscon-service-type, @deftp kmscon-configuration): Add documentation. --- doc/guix.texi | 31 +++++++++++++++++++++++++++++++ gnu/services/base.scm | 43 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 41b8d5db0..65cf804f1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7674,6 +7674,37 @@ The Mingetty package to use. @end table @end deftp +@deffn {Scheme Procedure} kmscon-service-type @var{config} +Return a service to run @uref{https://www.freedesktop.org/wiki/Software/kmscon,kmscon} +according to @var{config}, a @code{} object, which +specifies the tty to run, among other things. +@end deffn + +@deftp {Data Type} kmscon-configuration +This is the data type representing the configuration of Kmscon, which +implements console log-in. + +@table @asis + +@item @code{virtual-terminal} +The name of the console this Kmscon runs on---e.g., @code{"tty1"}. + +@item @code{login-program} (default: @code{#~(string-append #$shadow "/bin/login")}) +A gexp denoting the name of the log-in program. The default log-in program is +@command{login} from the Shadow tool suite. + +@item @code{login-arguments} (default: @code{'("-p")}) +A list of arguments to pass to @command{login}. + +@item @code{hardware-acceleration?} (default: #f) +Whether to use hardware acceleration. + +@item @code{kmscon} (default: @var{kmscon}) +The Kmscon package to use. + +@end table +@end deftp + @cindex name service cache daemon @cindex nscd @deffn {Scheme Procedure} nscd-service [@var{config}] [#:glibc glibc] @ diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 20a9c3ae1..4c1c48145 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -39,6 +39,7 @@ #:use-module (gnu packages package-management) #:use-module (gnu packages ssh) #:use-module (gnu packages lsof) + #:use-module (gnu packages terminals) #:use-module ((gnu build file-systems) #:select (mount-flags->bit-mask)) #:use-module (guix gexp) @@ -116,6 +117,11 @@ rngd-configuration? rngd-service-type rngd-service + + kmscon-configuration + kmscon-configuration? + kmscon-service-type + pam-limits-service-type pam-limits-service @@ -1449,6 +1455,43 @@ This service is not part of @var{%base-services}." (service gpm-service-type (gpm-configuration (gpm gpm) (options options)))) +(define-record-type* + kmscon-configuration make-kmscon-configuration + kmscon-configuration? + (kmscon kmscon-configuration-kmscon + (default kmscon)) + (virtual-terminal kmscon-configuration-virtual-terminal) + (login-program kmscon-configuration-login-program + (default #~(string-append #$shadow "/bin/login"))) + (login-arguments kmscon-configuration-login-arguments + (default '("-p"))) + (hardware-acceleration? kmscon-configuration-hardware-acceleration? + (default #f))) ; #t causes failure + +(define kmscon-service-type + (shepherd-service-type + 'kmscon + (lambda (config) + (let ((kmscon (kmscon-configuration-kmscon config)) + (virtual-terminal (kmscon-configuration-virtual-terminal config)) + (login-program (kmscon-configuration-login-program config)) + (login-arguments (kmscon-configuration-login-arguments config)) + (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config))) + + (define kmscon-command + #~(list + (string-append #$kmscon "/bin/kmscon") "--login" + "--vt" #$virtual-terminal + #$@(if hardware-acceleration? '("--hwaccel") '()) + "--" #$login-program #$@login-arguments)) + + (shepherd-service + (documentation "kmscon virtual terminal") + (requirement '(user-processes udev dbus-system)) + (provision (list (symbol-append 'term- (string->symbol virtual-terminal)))) + (start #~(make-forkexec-constructor #$kmscon-command)) + (stop #~(make-kill-destructor))))))) + (define %base-services ;; Convenience variable holding the basic services. -- cgit v1.3 From dbc6d370fa75d2b6da1f89961a7c44f27ac52f87 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sat, 10 Sep 2016 20:35:20 +0200 Subject: doc: "Various Services" -> "Miscellaneous Services" * doc/guix.texi (Services): "Various" -> "Miscellaneous" --- doc/guix.texi | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 65cf804f1..3a8a73cb7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -219,7 +219,7 @@ Services * Database Services:: SQL databases. * Mail Services:: IMAP, POP3, SMTP, and all that. * Web Services:: Web servers. -* Various Services:: Other services. +* Miscellaneous Services:: Other services. Defining Services @@ -7587,7 +7587,7 @@ declaration. * Database Services:: SQL databases. * Mail Services:: IMAP, POP3, SMTP, and all that. * Web Services:: Web servers. -* Various Services:: Other services. +* Miscellaneous Services:: Other services. @end menu @node Base Services @@ -10166,8 +10166,8 @@ directories are created when the service is activated. @end deffn -@node Various Services -@subsubsection Various Services +@node Miscellaneous Services +@subsubsection Miscellaneous Services @subsubheading RPC Bind Service -- cgit v1.3 From 4a3b6aa5dd625b1697977c065a5d6b4e9ca84148 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Sep 2016 17:56:18 +0200 Subject: doc: #:target takes a GNU triplet, not a system type. * doc/guix.texi (G-Expressions): In cross-compilation example, pass a GNU triplet to #:target. --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 3a8a73cb7..e13031799 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3794,7 +3794,7 @@ native package build: "-s" (string-append #$emacs "/bin/emacs") (string-append #$output "/bin/vi"))) - #:target "mips64el-linux") + #:target "mips64el-linux-gnu") @end example @noindent -- cgit v1.3 From 8f65585b1492760407f16bf08ec769080167d28f Mon Sep 17 00:00:00 2001 From: John Darrington Date: Fri, 16 Sep 2016 08:08:48 +0200 Subject: doc: "filesystem" -> "file system" * doc/guix.texi: "filesystem" -> "file system" * gnu/packages/admin.scm: "filesystem" -> "file system" * gnu/packages/cdrom.scm: "filesystem" -> "file system" * gnu/packages/compression.scm: "filesystem" -> "file system" * gnu/packages/disk.scm: "filesystem" -> "file system" * gnu/packages/gnome.scm: "filesystem" -> "file system" * gnu/packages/irc.scm: "filesystem" -> "file system" * gnu/packages/linux.scm: "filesystem" -> "file system" * gnu/packages/mail.scm: "filesystem" -> "file system" * gnu/packages/mpd.scm: "filesystem" -> "file system" * gnu/packages/ocaml.scm: "filesystem" -> "file system" * gnu/packages/perl.scm: "filesystem" -> "file system" * gnu/packages/python.scm: "filesystem" -> "file system" * gnu/packages/search.scm: "filesystem" -> "file system" * gnu/packages/tls.scm: "filesystem" -> "file system" * gnu/services/mail.scm: "filesystem" -> "file system" --- doc/guix.texi | 8 ++++---- gnu/packages/admin.scm | 4 ++-- gnu/packages/cdrom.scm | 4 ++-- gnu/packages/compression.scm | 6 +++--- gnu/packages/disk.scm | 4 ++-- gnu/packages/gnome.scm | 4 ++-- gnu/packages/irc.scm | 4 ++-- gnu/packages/linux.scm | 12 ++++++------ gnu/packages/mail.scm | 2 +- gnu/packages/mpd.scm | 2 +- gnu/packages/ocaml.scm | 2 +- gnu/packages/perl.scm | 8 ++++---- gnu/packages/python.scm | 6 +++--- gnu/packages/search.scm | 2 +- gnu/packages/tls.scm | 2 +- gnu/services/mail.scm | 8 ++++---- 16 files changed, 39 insertions(+), 39 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index e13031799..7a86a2f0a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9544,7 +9544,7 @@ Defaults to @samp{""}. @end deftypevr @deftypevr {@code{dovecot-configuration} parameter} boolean mail-full-filesystem-access? -Allow full filesystem access to clients. There's no access checks +Allow full file system access to clients. There's no access checks other than what the operating system does for the active UID/GID. It works with both maildir and mboxes, allowing you to prefix mailboxes names with e.g. /path/ or ~user/. @@ -9553,7 +9553,7 @@ Defaults to @samp{#f}. @deftypevr {@code{dovecot-configuration} parameter} boolean mmap-disable? Don't use mmap() at all. This is required if you store indexes to -shared filesystems (NFS or clustered filesystem). +shared file systems (NFS or clustered file system). Defaults to @samp{#f}. @end deftypevr @@ -9815,7 +9815,7 @@ Defaults to @samp{"1d"}. @deftypevr {@code{dovecot-configuration} parameter} boolean mdbox-preallocate-space? When creating new mdbox files, immediately preallocate their size to @samp{mdbox-rotate-size}. This setting currently works only in Linux -with some filesystems (ext4, xfs). +with some file systems (ext4, xfs). Defaults to @samp{#f}. @end deftypevr @@ -9838,7 +9838,7 @@ Defaults to @samp{128000}. @end deftypevr @deftypevr {@code{dovecot-configuration} parameter} string mail-attachment-fs -Filesystem backend to use for saving attachments: +File system backend to use for saving attachments: @table @code @item posix No SiS done by Dovecot (but this might help FS's own deduplication) diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 3685633f3..6d6961752 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -1461,9 +1461,9 @@ limits.") `("PYTHONPATH" ":" prefix (,py))) #t)))))) (home-page "https://github.com/wting/autojump") - (synopsis "Shell extension for filesystem navigation") + (synopsis "Shell extension for file system navigation") (description - "Autojump provides a faster way to navigate your filesystem, with a \"cd + "Autojump provides a faster way to navigate your file system, with a \"cd command that learns\". It works by maintaining a database of the directories you use the most from the command line and allows you to \"jump\" to frequently used directories by typing only a small pattern.") diff --git a/gnu/packages/cdrom.scm b/gnu/packages/cdrom.scm index 4263cdebb..52c90e18e 100644 --- a/gnu/packages/cdrom.scm +++ b/gnu/packages/cdrom.scm @@ -146,10 +146,10 @@ libcdio.") ("zlib" ,zlib) ("libcdio" ,libcdio))) (home-page "https://www.gnu.org/software/xorriso/") - (synopsis "Create, manipulate, burn ISO-9660 filesystems") + (synopsis "Create, manipulate, burn ISO-9660 file systems") (description "GNU Xorriso is a tool for copying files to and from ISO 9660 Rock -Ridge, a.k.a. Compact Disc File System, filesystems and it allows +Ridge, a.k.a. Compact Disc File System, file systems and it allows session-wise manipulation of them. It features a formatter and burner for CD, DVD and BD. It can operate on existing ISO images or it can create new ones. xorriso can then be used to copy files directly into or out of ISO diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index aaa0c99e8..650464197 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -664,14 +664,14 @@ time for compression ratio.") ("xz" ,xz) ("zlib" ,zlib))) (home-page "http://squashfs.sourceforge.net/") - (synopsis "Tools to create and extract squashfs filesystems") + (synopsis "Tools to create and extract squashfs file systems") (description - "Squashfs is a highly compressed read-only filesystem for Linux. It uses + "Squashfs is a highly compressed read-only file system for Linux. It uses zlib to compress files, inodes, and directories. All blocks are packed to minimize the data overhead, and block sizes of between 4K and 1M are supported. It is intended to be used for archival use, for live CDs, and for embedded systems where low overhead is needed. This package allows you to create and -extract such filesystems.") +extract such file systems.") (license license:gpl2+))) (define-public pigz diff --git a/gnu/packages/disk.scm b/gnu/packages/disk.scm index 27ab7a698..a3ace8ab1 100644 --- a/gnu/packages/disk.scm +++ b/gnu/packages/disk.scm @@ -191,10 +191,10 @@ to recover data more efficiently by only reading the necessary blocks.") "CC=gcc") #:tests? #f)) ;no tests (home-page "https://github.com/dosfstools/dosfstools") - (synopsis "Utilities for making and checking MS-DOS FAT filesystems") + (synopsis "Utilities for making and checking MS-DOS FAT file systems") (description "The dosfstools package includes the mkfs.fat and fsck.fat utilities, -which respectively make and check MS-DOS FAT filesystems.") +which respectively make and check MS-DOS FAT file systems.") (license license:gpl3+))) (define-public sdparm diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 6dab1d79e..19e982d08 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -3469,9 +3469,9 @@ part of udev-extras, then udev, then systemd. It's now a project on its own.") ("nettle" ,nettle) ; XXX: required by libarchive.pc ("udisks" ,udisks))) (home-page "https://wiki.gnome.org/gvfs/") - (synopsis "Userspace virtual filesystem for GIO") + (synopsis "Userspace virtual file system for GIO") (description - "GVFS is a userspace virtual filesystem designed to work with the I/O + "GVFS is a userspace virtual file system designed to work with the I/O abstraction of GIO. It contains a GIO module that seamlessly adds GVFS support to all applications using the GIO API. It also supports exposing the GVFS mounts to non-GIO applications using FUSE. diff --git a/gnu/packages/irc.scm b/gnu/packages/irc.scm index d52edd837..1058bef77 100644 --- a/gnu/packages/irc.scm +++ b/gnu/packages/irc.scm @@ -262,9 +262,9 @@ and extensible with plugins and scripts.") (modify-phases %standard-phases (delete 'configure)))) ; no configure (home-page "http://tools.suckless.org/ii/") - (synopsis "FIFO and filesystem-based IRC client") + (synopsis "FIFO and file system based IRC client") (description - "ii (Irc it) is a minimalist FIFO and filesystem based IRC client.") + "ii (Irc it) is a minimalist FIFO and file system based IRC client.") (license license:expat))) (define-public sic diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index df2eb6842..3e4237720 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -420,10 +420,10 @@ at login. Local and dynamic reconfiguration are its key features.") (inputs `(("ncurses" ,ncurses))) (home-page "http://psmisc.sourceforge.net/") (synopsis - "Small utilities that use the proc filesystem") + "Small utilities that use the proc file system") (description "This PSmisc package is a set of some small useful utilities that -use the proc filesystem. We're not about changing the world, but +use the proc file system. We're not about changing the world, but providing the system administrator with some help in common tasks.") (license license:gpl2+))) @@ -501,7 +501,7 @@ providing the system administrator with some help in common tasks.") (home-page "https://www.kernel.org/pub/linux/utils/util-linux/") (synopsis "Collection of utilities for the Linux kernel") (description "Util-linux is a diverse collection of Linux kernel -utilities. It provides dmesg and includes tools for working with filesystems, +utilities. It provides dmesg and includes tools for working with file systems, block devices, UUIDs, TTYs, and many other tools.") ;; Note that util-linux doesn't use the same license for all the @@ -643,7 +643,7 @@ slabtop, and skill.") ;; FIXME: Tests work by comparing the stdout/stderr of programs, that ;; they fail because we get an extra line that says "Can't check if - ;; filesystem is mounted due to missing mtab file". + ;; file system is mounted due to missing mtab file". #:tests? #f)) (home-page "http://e2fsprogs.sourceforge.net/") (synopsis "Creating and checking ext2/ext3/ext4 file systems") @@ -2185,7 +2185,7 @@ specified in /etc/acpi/events and execute the rules that match the event.") (home-page "http://linux-diag.sourceforge.net/Sysfsutils.html") (synopsis "System utilities based on Linux sysfs") (description - "These are a set of utilities built upon sysfs, a virtual filesystem in + "These are a set of utilities built upon sysfs, a virtual file system in Linux kernel versions 2.5+ that exposes a system's device tree. The package also contains the libsysfs library.") ;; The library is under lgpl2.1+ (all files say "or any later version"). @@ -2623,7 +2623,7 @@ and copy/paste text in the console and in xterm.") ("which" ,which))) (home-page "https://btrfs.wiki.kernel.org/") (synopsis "Create and manage btrfs copy-on-write file systems") - (description "Btrfs is a copy-on-write (CoW) filesystem for Linux aimed at + (description "Btrfs is a copy-on-write (CoW) file system for Linux aimed at implementing advanced features while focusing on fault tolerance, repair and easy administration.") ;; GPL2+: crc32.c, radix-tree.c, raid6.c, rbtree.c. diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 90c2da4f1..e344683af 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -1213,7 +1213,7 @@ deliver it in various ways.") #t))) #:tests? #f)) ;; There are no tests indicating a successful ;; build. Some tests of basic locking mechanisms provided by the - ;; filesystem are performed during 'make install'. However, these + ;; file system are performed during 'make install'. However, these ;; are performed before the actual build process. (build-system gnu-build-system) (inputs `(("exim" ,exim))) diff --git a/gnu/packages/mpd.scm b/gnu/packages/mpd.scm index 7bf39f98b..ec0861db1 100644 --- a/gnu/packages/mpd.scm +++ b/gnu/packages/mpd.scm @@ -208,7 +208,7 @@ terminal using ncurses.") (description "Ncmpcpp is an mpd client with a UI very similar to ncmpc, but it provides new useful features such as support for regular expressions for library searches, extended song format, items filtering, the ability to -sort playlists, and a local filesystem browser.") +sort playlists, and a local file system browser.") (home-page "http://ncmpcpp.rybczak.net/") (license license:gpl2+))) diff --git a/gnu/packages/ocaml.scm b/gnu/packages/ocaml.scm index 1f4c3e471..f6f7308ff 100644 --- a/gnu/packages/ocaml.scm +++ b/gnu/packages/ocaml.scm @@ -673,7 +673,7 @@ to the other.") "The \"findlib\" library provides a scheme to manage reusable software components (packages), and includes tools that support this scheme. Packages are collections of OCaml modules for which metainformation can be stored. The -packages are kept in the filesystem hierarchy, but with strict directory +packages are kept in the file system hierarchy, but with strict directory structure. The library contains functions to look the directory up that stores a package, to query metainformation about a package, and to retrieve dependency information about multiple packages. There is also a tool that diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm index d42294044..ba6f71a41 100644 --- a/gnu/packages/perl.scm +++ b/gnu/packages/perl.scm @@ -404,7 +404,7 @@ in web applications to store data locally to save repeated and redundant expensive calls to remote machines or databases. People have also been known to use Cache::Cache for its straightforward interface in sharing data between runs of an application or invocations of a CGI-style script or simply as an -easy to use abstraction of the filesystem or shared memory.") +easy to use abstraction of the file system or shared memory.") (license (package-license perl)))) (define-public perl-cache-fastmmap @@ -2115,7 +2115,7 @@ modules separately and deal with them after the module is done installing.") (synopsis "Advanced operations on path variables") (description "@code{Env::Path} presents an object-oriented interface to path variables, defined as that subclass of environment variables which name -an ordered list of filesystem elements separated by a platform-standard +an ordered list of file system elements separated by a platform-standard separator.") (license (package-license perl)))) @@ -2461,7 +2461,7 @@ platforms.") (synopsis "Create or remove directory trees") (description "This module provide a convenient way to create directories of arbitrary depth and to delete an entire directory subtree from the -filesystem.") +file system.") (license (package-license perl)))) (define-public perl-file-list @@ -6348,7 +6348,7 @@ generally slower on larger files.") (home-page "http://search.cpan.org/dist/Text-Glob") (synopsis "Match globbing patterns against text") (description "Text::Glob implements glob(3) style matching that can be -used to match against text, rather than fetching names from a filesystem. If +used to match against text, rather than fetching names from a file system. If you want to do full file globbing use the File::Glob module instead.") (license (package-license perl)))) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 0671444ca..2f349c88f 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -6943,7 +6943,7 @@ WebSocket usage in Python programs.") (build-system python-build-system) (synopsis "Atomic file writes in Python") (description "Library for atomic file writes using platform dependent tools -for atomic filesystem operations.") +for atomic file system operations.") (home-page "https://github.com/untitaker/python-atomicwrites") (license license:expat) (properties `((python2-variant . ,(delay python2-atomicwrites)))))) @@ -8571,8 +8571,8 @@ library.") (replace 'check (lambda _ (zero? (system* "python" "./test_pathlib.py"))))))) (home-page "https://pathlib.readthedocs.org/") - (synopsis "Object-oriented filesystem paths") - (description "Pathlib offers a set of classes to handle filesystem paths. + (synopsis "Object-oriented file system paths") + (description "Pathlib offers a set of classes to handle file system paths. It offers the following advantages over using string objects: @enumerate diff --git a/gnu/packages/search.scm b/gnu/packages/search.scm index 60f902f96..9eb4039f8 100644 --- a/gnu/packages/search.scm +++ b/gnu/packages/search.scm @@ -165,7 +165,7 @@ for parsing HTML files.") "0gi6y52gkakhhlnzy0p6izc36nqhyfx5830qirhvk3qrzrwxyqrh")))) (build-system gnu-build-system) (home-page "https://fedorahosted.org/mlocate/") - (synopsis "Locate files on the filesystem") + (synopsis "Locate files on the file system") (description "mlocate is a locate/updatedb implementation. The 'm' stands for \"merging\": @code{updatedb} reuses the existing database to avoid rereading diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index 412ec77bc..076270380 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -161,7 +161,7 @@ living in the same process.") ;; the location of the system-wide trust store. Instead it has a ;; configure-time option. Unless specified, its configure script ;; attempts to auto-detect the location by looking for common - ;; places in the filesystem, none of which are present in our + ;; places in the file system, none of which are present in our ;; chroot build environment. If not found, then no default trust ;; store is used, so each program has to provide its own ;; fallback, and users have to configure each program diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index 46dbab664..d94532c35 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -987,7 +987,7 @@ could allow a user to delete others' mailboxes, or ln -s (mail-full-filesystem-access? (boolean #f) - "Allow full filesystem access to clients. There's no access checks + "Allow full file system access to clients. There's no access checks other than what the operating system does for the active UID/GID. It works with both maildir and mboxes, allowing you to prefix mailboxes names with e.g. /path/ or ~user/.") @@ -997,7 +997,7 @@ names with e.g. /path/ or ~user/.") (mmap-disable? (boolean #f) "Don't use mmap() at all. This is required if you store indexes to -shared filesystems (NFS or clustered filesystem).") +shared file systems (NFS or clustered file system).") (dotlock-use-excl? (boolean #t) @@ -1229,7 +1229,7 @@ disabled.") (boolean #f) "When creating new mdbox files, immediately preallocate their size to @samp{mdbox-rotate-size}. This setting currently works only in Linux -with some filesystems (ext4, xfs).") +with some file systems (ext4, xfs).") (mail-attachment-dir (string "") @@ -1249,7 +1249,7 @@ externally.") (mail-attachment-fs (string "sis posix") - "Filesystem backend to use for saving attachments: + "File system backend to use for saving attachments: @table @code @item posix No SiS done by Dovecot (but this might help FS's own deduplication) -- cgit v1.3 From 71654dfdda4890d7a663a36a7fe754b53591aba6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 19 Sep 2016 13:31:06 +0900 Subject: services: Add 'simple-service'. * gnu/services.scm (simple-service): New procedure. * doc/guix.texi (Service Reference): Document it. --- doc/guix.texi | 19 +++++++++++++++++++ gnu/services.scm | 8 ++++++++ 2 files changed, 27 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 7a86a2f0a..808fbdceb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11348,6 +11348,25 @@ the extension; it must return a valid value for the target service. Return true if @var{obj} is a service extension. @end deffn +Occasionally, you might want to simply extend an existing service. This +involves creating a new service type and specifying the extension of +interest, which can be verbose; the @code{simple-service} procedure +provides a shorthand for this. + +@deffn {Scheme Procedure} simple-service @var{name} @var{target} @var{value} +Return a service that extends @var{target} with @var{value}. This works +by creating a singleton service type @var{name}, of which the returned +service is an instance. + +For example, this extends mcron (@pxref{Scheduled Job Execution}) with +an additional job: + +@example +(simple-service 'my-mcron-job mcron-service-type + #~(job '(next-hour (3)) "guix gc -F 2G")) +@end example +@end deffn + At the core of the service abstraction lies the @code{fold-services} procedure, which is responsible for ``compiling'' a list of services down to a single directory that contains everything needed to boot and diff --git a/gnu/services.scm b/gnu/services.scm index 5479bfae1..7e322c50b 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -50,6 +50,7 @@ service-kind service-parameters + simple-service modify-services service-back-edges fold-services @@ -141,6 +142,13 @@ (type service-kind) (parameters service-parameters)) +(define (simple-service name target value) + "Return a service that extends TARGET with VALUE. This works by creating a +singleton service type NAME, of which the returned service is an instance." + (let* ((extension (service-extension target identity)) + (type (service-type (name name) + (extensions (list extension))))) + (service type value))) (define-syntax %modify-service (syntax-rules (=>) -- cgit v1.3 From 66329c23a113201de2ead168a400cc068caafc85 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 4 Sep 2016 18:01:40 +0200 Subject: gnu: New default Dovecot service postmaster_address * gnu/services/mail.scm (dovecot-configuration): Change default for postmaster-address, as dovecot is now requiring a non-empty value and will fail to start up otherwise. * doc/guix.texi (Mail Services): Update. --- doc/guix.texi | 4 ++-- gnu/services/mail.scm | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 808fbdceb..c159e12b1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9964,8 +9964,8 @@ Defaults to @samp{""}. @deftypevr {@code{dovecot-configuration} parameter} string postmaster-address Address to use when sending rejection mails. -Default is postmaster@@. %d expands to recipient domain. -Defaults to @samp{""}. +%d expands to recipient domain. +Defaults to @samp{"postmaster@@%d"}. @end deftypevr @deftypevr {@code{dovecot-configuration} parameter} string hostname diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index d94532c35..cb0f119f4 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -1352,7 +1352,7 @@ regeneration entirely.") "SSL crypto device to use, for valid values run \"openssl engine\".") (postmaster-address - (string "") + (string "postmaster@%d") "Address to use when sending rejection mails. Default is postmaster@@. %d expands to recipient domain.") -- cgit v1.3 From 5564c011d9f0979fb0c477fcafd136c019a477b3 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Tue, 27 Sep 2016 14:12:02 -0400 Subject: doc: Give the full key fingerprint instead of the long key ID. * doc/guix.texi (OPENPGP-SIGNING-KEY-ID): Use fingerprint instead of long key ID. --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index c159e12b1..239428a75 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10,7 +10,7 @@ @include version.texi @c Identifier of the OpenPGP key used to sign tarballs and such. -@set OPENPGP-SIGNING-KEY-ID 090B11993D9AEBB5 +@set OPENPGP-SIGNING-KEY-ID 3CE464558A84FDC69DB40CFB090B11993D9AEBB5 @copying Copyright @copyright{} 2012, 2013, 2014, 2015, 2016 Ludovic Courtès@* -- cgit v1.3 From 86d8f6d3efb8300a3354735cbf06be6c01e23243 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Fri, 5 Aug 2016 15:20:15 +0200 Subject: services: Add 'openssh-service'. * gnu/packages/ssh.scm (openssh)[arguments]: Set sysconfdir to /etc/ssh. * gnu/services/ssh.scm (): New record type. (%openssh-accounts): New variable. (openssh-activation, openssh-config-file, openssh-shepherd-service) (openssh-service): New procedures. (openssh-service-type): New variable. * doc/guix.texi (Networking Services): Document 'openssh-services'. Co-authored-by: Ludovic Courtès --- doc/guix.texi | 34 +++++++++++++ gnu/packages/ssh.scm | 2 +- gnu/services/ssh.scm | 131 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 166 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 239428a75..f5bbb92c7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8199,6 +8199,40 @@ root. The other options should be self-descriptive. @end deffn +@deffn {Scheme Procedure} openssh-service [#:pid-file "/var/run/sshd.pid"] @ + [#:port-number 22] [#:permit-root-login 'without-password] @ + [#:allow-empty-passwords #f] [#:password-authentication? #t] @ + [#:pubkey-authentication? #t] [#:rsa-authentication? #t] @ + [#:x11-forwarding? #f] [#:protocol-number "2"] +Run the @command{sshd} program from @var{openssh} on port +@var{port-number}. @command{sshd} runs an SSH daemon and writes its PID +to @var{pid-file}. It understands SSH protocol +@var{protocol-number}. The @var{protocol-number} can be either 1 or 2. + +@var{permit-root-login} takes one of @code{#t}, @code{'without-password} +and @code{#f}. It is used to allow root login through SSH. +@code{'without-password} means that root login is allowed, but not with +password-based authentication. + +When @var{allow-empty-passwords?} is true, users with empty passwords +may log in. When false, they may not. + +When @var{password-authentication?} is true, users may log in with their +password. When false, they have to use other means of authentication. + +When @var{pubkey-authentication?} is true, users may log in using public +key authentication. When false, users have to use other means of +authentication. Authorized public keys are stored in +@file{~/.ssh/authorized_keys}. This is used only by protocol version 2. + +When @var{rsa-authentication?} is true, users may log in using pure RSA +authentication. When false, users have to use other means of +authentication. This is used only by protocol 1. + +When @var{x11-forwarding?} is true, @command{ssh} options @option{-X} +and @option{-Y} will work. +@end deffn + @deffn {Scheme Procedure} dropbear-service [@var{config}] Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH daemon} with the given @var{config}, a @code{} diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm index b2612a495..88bfd062d 100644 --- a/gnu/packages/ssh.scm +++ b/gnu/packages/ssh.scm @@ -144,7 +144,7 @@ a server that supports the SSH-2 protocol.") ("xauth" ,xauth))) ;for 'ssh -X' and 'ssh -Y' (arguments `(#:test-target "tests" - #:configure-flags '("--sysconfdir=/etc" + #:configure-flags '("--sysconfdir=/etc/ssh" ;; Default value of 'PATH' used by sshd. "--with-default-path=/run/current-system/profile/bin" diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 462988cc8..084f8fa4e 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2016 David Craven +;;; Copyright © 2016 Julien Lepiller ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,17 +20,25 @@ (define-module (gnu services ssh) #:use-module (gnu packages ssh) + #:use-module (gnu packages admin) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu system pam) + #:use-module (gnu system shadow) #:use-module (guix gexp) #:use-module (guix records) #:use-module (srfi srfi-26) + #:use-module (ice-9 match) #:export (lsh-configuration lsh-configuration? lsh-service lsh-service-type + openssh-configuration + openssh-configuration? + openssh-service-type + openssh-service + dropbear-configuration dropbear-configuration? dropbear-service-type @@ -244,6 +253,128 @@ The other options should be self-descriptive." public-key-authentication?) (initialize? initialize?)))) + +;;; +;;; OpenSSH. +;;; + +(define-record-type* + openssh-configuration make-openssh-configuration + openssh-configuration? + (pid-file openssh-configuration-pid-file) ;string + (port-number openssh-configuration-port-number) ;integer + (permit-root-login openssh-configuration-permit-root-login) ;Boolean | 'without-password + (allow-empty-passwords? openssh-configuration-allow-empty-passwords?) ;Boolean + (password-authentication? openssh-configuration-password-authentication?) ;Boolean + (pubkey-authentication? openssh-configuration-pubkey-authentication?) ;Boolean + (rsa-authentication? openssh-configuration-rsa-authentication?) ;Boolean + (x11-forwarding? openssh-configuration-x11-forwarding?) ;Boolean + (protocol-number openssh-configuration-protocol-number)) ;integer + +(define %openssh-accounts + (list (user-group (name "sshd") (system? #t)) + (user-account + (name "sshd") + (group "sshd") + (system? #t) + (comment "sshd privilege separation user") + (home-directory "/var/run/sshd") + (shell #~(string-append #$shadow "/sbin/nologin"))))) + +(define (openssh-activation config) + "Return the activation GEXP for CONFIG." + #~(begin + (mkdir-p "/etc/ssh") + (mkdir-p (dirname #$(openssh-configuration-pid-file config))) + + ;; Generate missing host keys. + (system* (string-append #$openssh "/bin/ssh-keygen") "-A"))) + +(define (openssh-config-file config) + "Return the sshd configuration file corresponding to CONFIG." + (computed-file + "sshd_config" + #~(call-with-output-file #$output + (lambda (port) + (display "# Generated by 'openssh-service'.\n" port) + (format port "Protocol ~a\n" + #$(if (eq? (openssh-configuration-protocol-number config) 1) + "1" "2")) + (format port "Port ~a\n" + #$(number->string (openssh-configuration-port-number config))) + (format port "PermitRootLogin ~a\n" + #$(match (openssh-configuration-permit-root-login config) + (#t "yes") + (#f "no") + ('without-password "without-password"))) + (format port "PermitEmptyPasswords ~a\n" + #$(if (openssh-configuration-allow-empty-passwords? config) + "yes" "no")) + (format port "PasswordAuthentication ~a\n" + #$(if (openssh-configuration-password-authentication? config) + "yes" "no")) + (format port "PubkeyAuthentication ~a\n" + #$(if (openssh-configuration-pubkey-authentication? config) + "yes" "no")) + (format port "RSAAuthentication ~a\n" + #$(if (openssh-configuration-rsa-authentication? config) + "yes" "no")) + (format port "X11Forwarding ~a\n" + #$(if (openssh-configuration-x11-forwarding? config) + "yes" "no")) + (format port "PidFile ~a\n" + #$(openssh-configuration-pid-file config)) + #t)))) + +(define (openssh-shepherd-service config) + "Return a for openssh with CONFIG." + + (define pid-file + (openssh-configuration-pid-file config)) + + (define openssh-command + #~(list (string-append #$openssh "/sbin/sshd") + "-D" "-f" #$(openssh-config-file config))) + + (list (shepherd-service + (documentation "OpenSSH server.") + (requirement '(networking syslogd)) + (provision '(ssh-daemon)) + (start #~(make-forkexec-constructor #$openssh-command + #:pid-file #$pid-file)) + (stop #~(make-kill-destructor))))) + +(define openssh-service-type + (service-type (name 'openssh) + (extensions + (list (service-extension shepherd-root-service-type + openssh-shepherd-service) + (service-extension activation-service-type + openssh-activation) + (service-extension account-service-type + (const %openssh-accounts)))))) + +(define* (openssh-service #:key + (pid-file "/var/run/sshd.pid") + (port-number 22) + (permit-root-login 'without-password) + (allow-empty-passwords? #f) + (password-authentication? #t) + (pubkey-authentication? #t) + (rsa-authentication? #t) + (x11-forwarding? #f) + (protocol-number 2)) + (service openssh-service-type (openssh-configuration + (pid-file pid-file) + (port-number port-number) + (permit-root-login permit-root-login) + (allow-empty-passwords? allow-empty-passwords?) + (password-authentication? password-authentication?) + (pubkey-authentication? pubkey-authentication?) + (rsa-authentication? rsa-authentication?) + (x11-forwarding? x11-forwarding?) + (protocol-number protocol-number)))) + ;;; ;;; Dropbear. -- cgit v1.3