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. --- gnu/services/base.scm | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index f3f6408687..2c2962cd8c 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 -- cgit v1.2.3 From afa54a38b738e6ddf4fb25757410cf7b24067b39 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 7 Sep 2016 11:25:00 +0200 Subject: services: syslog: Use a PID file. * gnu/services/base.scm (syslog-service-type)[start]: Remove --no-detach and use #:pid-file. --- gnu/services/base.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 2c2962cd8c..42094b5fb9 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -907,8 +907,8 @@ Service Switch}, for an example." (requirement '(user-processes)) (start #~(make-forkexec-constructor (list #$(syslog-configuration-syslogd config) - "--no-detach" - "--rcfile" #$(syslog-configuration-config-file config)))) + "--rcfile" #$(syslog-configuration-config-file config)) + #:pid-file "/var/run/syslog.pid")) (stop #~(make-kill-destructor)))))) ;; Snippet adapted from the GNU inetutils manual. -- cgit v1.2.3 From 9e41130b14ad32c4e1fa756f95d806703056cb60 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 10 Sep 2016 12:03:47 +0200 Subject: system: Use 'file-append' to denote file names. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/databases.scm, gnu/services/dbus.scm, gnu/services/desktop.scm, gnu/services/dict.scm, gnu/services/mail.scm, gnu/services/networking.scm, gnu/services/sddm.scm, gnu/services/spice.scm, gnu/services/ssh.scm, gnu/services/web.scm, gnu/services/xorg.scm, gnu/system.scm: Replace the #~(string-append #$pkg "/bin/foo") idiom with (file-append pkg "/bin/foo"). --- gnu/services/avahi.scm | 2 +- gnu/services/base.scm | 10 +++++----- gnu/services/databases.scm | 4 ++-- gnu/services/dbus.scm | 4 ++-- gnu/services/desktop.scm | 11 +++++------ gnu/services/dict.scm | 2 +- gnu/services/mail.scm | 4 ++-- gnu/services/networking.scm | 8 ++++---- gnu/services/sddm.scm | 18 +++++++++--------- gnu/services/spice.scm | 2 +- gnu/services/ssh.scm | 2 +- gnu/services/web.scm | 4 ++-- gnu/services/xorg.scm | 11 +++++------ gnu/system.scm | 24 ++++++++++++------------ 14 files changed, 52 insertions(+), 54 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index 807cc05a22..60e9e61f94 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -88,7 +88,7 @@ (system? #t) (comment "Avahi daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define %avahi-activation ;; Activation gexp. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 42094b5fb9..07c08d7567 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -516,7 +516,7 @@ stopped before 'kill' is called." (define device (rngd-configuration-device config)) (define rngd-command - (list #~(string-append #$rng-tools "/sbin/rngd") + (list (file-append rng-tools "/sbin/rngd") "-f" "-r" device)) (shepherd-service @@ -893,7 +893,7 @@ Service Switch}, for an example." syslog-configuration make-syslog-configuration syslog-configuration? (syslogd syslog-configuration-syslogd - (default #~(string-append #$inetutils "/libexec/syslogd"))) + (default (file-append inetutils "/libexec/syslogd"))) (config-file syslog-configuration-config-file (default %default-syslog.conf))) @@ -1009,7 +1009,7 @@ starting at FIRST-UID, and under GID." (comment (format #f "Guix Build User ~2d" n)) (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin")))) + (shell (file-append shadow "/sbin/nologin")))) 1+ 1)) @@ -1036,7 +1036,7 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (define %default-authorized-guix-keys ;; List of authorized substitute keys. - (list #~(string-append #$guix "/share/guix/hydra.gnu.org.pub"))) + (list (file-append guix "/share/guix/hydra.gnu.org.pub"))) (define-record-type* guix-configuration make-guix-configuration @@ -1167,7 +1167,7 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (system? #t) (comment "guix publish user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define guix-publish-service-type (service-type (name 'guix-publish) diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 86847f8c50..1eed85542b 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -76,7 +76,7 @@ host all all ::1/128 trust")) (system? #t) (comment "PostgreSQL server user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define postgresql-activation (match-lambda @@ -171,7 +171,7 @@ and stores the database cluster in @var{data-directory}." (group "mysql") (system? #t) (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define mysql-configuration-file (match-lambda diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 690561cccd..876f56d45f 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -128,13 +128,13 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (system? #t) (comment "D-Bus system bus user") (home-directory "/var/run/dbus") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define dbus-setuid-programs ;; Return the file name of the setuid program that we need. (match-lambda (($ dbus services) - (list #~(string-append #$dbus "/libexec/dbus-daemon-launch-helper"))))) + (list (file-append dbus "/libexec/dbus-daemon-launch-helper"))))) (define (dbus-activation config) "Return an activation gexp for D-Bus using @var{config}." diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 8dacf54668..dfd1ea6e92 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -460,9 +460,8 @@ Users need to be in the @code{lp} group to access the D-Bus service. (define polkit-setuid-programs (match-lambda (($ polkit) - (list #~(string-append #$polkit - "/lib/polkit-1/polkit-agent-helper-1") - #~(string-append #$polkit "/bin/pkexec"))))) + (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1") + (file-append polkit "/bin/pkexec"))))) (define polkit-service-type (service-type (name 'polkit) @@ -522,7 +521,7 @@ the capability to suspend the system if the user is logged in locally." (system? #t) (comment "colord daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define colord-service-type (service-type (name 'colord) @@ -738,8 +737,8 @@ seats.)" (define pam-elogind (pam-entry (control "required") - (module #~(string-append #$(elogind-package config) - "/lib/security/pam_elogind.so")))) + (module (file-append (elogind-package config) + "/lib/security/pam_elogind.so")))) (list (lambda (pam) (pam-service diff --git a/gnu/services/dict.scm b/gnu/services/dict.scm index b06922c911..da5d004701 100644 --- a/gnu/services/dict.scm +++ b/gnu/services/dict.scm @@ -73,7 +73,7 @@ (group "dicod") (system? #t) (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define (dicod-configuration-file config) (define database->text diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index c252d669de..46dbab6645 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -1505,7 +1505,7 @@ greyed out, instead of only later giving \"not selectable\" popup error. (system? #t) (comment "Dovecot daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))) + (shell (file-append shadow "/sbin/nologin"))) (user-group (name "dovenull") (system? #t)) (user-account @@ -1514,7 +1514,7 @@ greyed out, instead of only later giving \"not selectable\" popup error. (system? #t) (comment "Dovecot daemon login user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define %dovecot-activation ;; Activation gexp. diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index dee1b74d81..7495179f8e 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -194,7 +194,7 @@ gateway." 'dhcp-client (lambda (dhcp) (define dhclient - #~(string-append #$dhcp "/sbin/dhclient")) + (file-append dhcp "/sbin/dhclient")) (define pid-file "/var/run/dhclient.pid") @@ -306,7 +306,7 @@ restrict -6 ::1\n")) (system? #t) (comment "NTP daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define (ntp-service-activation config) @@ -361,7 +361,7 @@ keep the system clock synchronized with that of @var{servers}." (system? #t) (comment "Tor daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define-record-type (hidden-service name mapping) @@ -554,7 +554,7 @@ project's documentation} for more information." (system? #t) (comment "BitlBee daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define %bitlbee-activation ;; Activation gexp for BitlBee. diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm index ab6672b0e5..ef1e78e9bf 100644 --- a/gnu/services/sddm.scm +++ b/gnu/services/sddm.scm @@ -48,9 +48,9 @@ (numlock sddm-configuration-numlock (default "on")) (halt-command sddm-configuration-halt-command - (default #~(string-append #$shepherd "/sbin/halt"))) + (default (file-append shepherd "/sbin/halt"))) (reboot-command sddm-configuration-reboot-command - (default #~(string-append #$shepherd "/sbin/reboot"))) + (default (file-append shepherd "/sbin/reboot"))) ;; [Theme] ;; valid values are elarun or maldives @@ -75,24 +75,24 @@ (hide-users sddm-configuration-hide-users (default "")) (hide-shells sddm-configuration-hide-shells - (default #~(string-append #$shadow "/sbin/nologin"))) + (default (file-append shadow "/sbin/nologin"))) ;; [Wayland] (session-command sddm-configuration-session-command - (default #~(string-append #$sddm "/share/sddm/scripts/wayland-session"))) + (default (file-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"))) + (default (file-append xauth "/bin/xauth"))) (xephyr-path sddm-configuration-xephyr-path - (default #~(string-append #$xorg-server "/bin/Xephyr"))) + (default (file-append xorg-server "/bin/Xephyr"))) (xdisplay-start sddm-configuration-xdisplay-start - (default #~(string-append #$sddm "/share/sddm/scripts/Xsetup"))) + (default (file-append sddm "/share/sddm/scripts/Xsetup"))) (xdisplay-stop sddm-configuration-xdisplay-stop - (default #~(string-append #$sddm "/share/sddm/scripts/Xstop"))) + (default (file-append sddm "/share/sddm/scripts/Xstop"))) (xsession-command sddm-configuration-xsession-command (default (xinitrc))) (xsessions-directory sddm-configuration-xsessions-directory @@ -292,7 +292,7 @@ Relogin=" (if (sddm-configuration-relogin? config) (system? #t) (comment "SDDM user") (home-directory "/var/lib/sddm") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) ;; Add default themes to profile (define sddm-profile-service diff --git a/gnu/services/spice.scm b/gnu/services/spice.scm index 26f072e7a8..bd0a538346 100644 --- a/gnu/services/spice.scm +++ b/gnu/services/spice.scm @@ -43,7 +43,7 @@ (define spice-vdagentd-command (list - #~(string-append #$spice-vdagent "/sbin/spice-vdagentd") + (file-append spice-vdagent "/sbin/spice-vdagentd") "-x")) (list diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 9a7ea0fb46..462988cc80 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -122,7 +122,7 @@ (define lsh-command (append - (cons #~(string-append #$lsh "/sbin/lshd") + (cons (file-append lsh "/sbin/lshd") (if daemonic? (let ((syslog (if (lsh-configuration-syslog-output? config) '() diff --git a/gnu/services/web.scm b/gnu/services/web.scm index d86aab50b5..40e4d5f46f 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -67,7 +67,7 @@ (system? #t) (comment "nginx server user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define nginx-activation (match-lambda @@ -86,7 +86,7 @@ (define nginx-shepherd-service (match-lambda (($ nginx log-directory run-directory config-file) - (let* ((nginx-binary #~(string-append #$nginx "/sbin/nginx")) + (let* ((nginx-binary (file-append nginx "/sbin/nginx")) (nginx-action (lambda args #~(lambda _ diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 87c4487037..d098d831e1 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -267,7 +267,7 @@ which should be passed to this script as the first argument. If not, the (define %default-slim-theme ;; Theme based on work by Felipe López. - #~(string-append #$%artwork-repository "/slim")) + (file-append %artwork-repository "/slim")) (define %default-slim-theme-name ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that @@ -374,8 +374,8 @@ reboot_cmd " shepherd "/sbin/reboot\n" (theme %default-slim-theme) (theme-name %default-slim-theme-name) (xauth xauth) (shepherd shepherd) (bash bash) - (auto-login-session #~(string-append #$windowmaker - "/bin/wmaker")) + (auto-login-session (file-append windowmaker + "/bin/wmaker")) (startx (xorg-start-command))) "Return a service that spawns the SLiM graphical login manager, which in turn starts the X display server with @var{startx}, a command as returned by @@ -450,14 +450,13 @@ command is @var{program}, to the set of setuid programs and add a PAM entry for it. For example: @lisp -(screen-locker-service xlockmore \"xlock\") + (screen-locker-service xlockmore \"xlock\") @end lisp makes the good ol' XlockMore usable." (service screen-locker-service-type (screen-locker program - #~(string-append #$package - #$(string-append "/bin/" program)) + (file-append package "/bin/" program) allow-empty-passwords?))) ;;; xorg.scm ends here diff --git a/gnu/system.scm b/gnu/system.scm index 4c1de384fa..7edb018f00 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -472,9 +472,9 @@ then source /run/current-system/profile/etc/profile.d/bash_completion.sh fi\n"))) (etc-service - `(("services" ,#~(string-append #$net-base "/etc/services")) - ("protocols" ,#~(string-append #$net-base "/etc/protocols")) - ("rpc" ,#~(string-append #$net-base "/etc/rpc")) + `(("services" ,(file-append net-base "/etc/services")) + ("protocols" ,(file-append net-base "/etc/protocols")) + ("rpc" ,(file-append net-base "/etc/rpc")) ("login.defs" ,#~#$login.defs) ("issue" ,#~#$issue) ("nsswitch.conf" ,#~#$nsswitch) @@ -482,8 +482,8 @@ fi\n"))) ("bashrc" ,#~#$bashrc) ("hosts" ,#~#$(or (operating-system-hosts-file os) (default-/etc/hosts (operating-system-host-name os)))) - ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/" - #$(operating-system-timezone os))) + ("localtime" ,(file-append tzdata "/share/zoneinfo/" + (operating-system-timezone os))) ("sudoers" ,(operating-system-sudoers-file os)))))) (define %root-account @@ -547,7 +547,7 @@ use 'plain-file' instead~%") @var{session-environment-service-type}, to be used in @file{/etc/environment}." `(("LANG" . ,(operating-system-locale os)) ("TZ" . ,(operating-system-timezone os)) - ("TZDIR" . ,#~(string-append #$tzdata "/share/zoneinfo")) + ("TZDIR" . ,(file-append tzdata "/share/zoneinfo")) ;; Tell 'modprobe' & co. where to look for modules. ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules") ;; These variables are honored by OpenSSL (libssl) and Git. @@ -571,12 +571,12 @@ use 'plain-file' instead~%") (define %setuid-programs ;; Default set of setuid-root programs. (let ((shadow (@ (gnu packages admin) shadow))) - (list #~(string-append #$shadow "/bin/passwd") - #~(string-append #$shadow "/bin/su") - #~(string-append #$inetutils "/bin/ping") - #~(string-append #$inetutils "/bin/ping6") - #~(string-append #$sudo "/bin/sudo") - #~(string-append #$fuse "/bin/fusermount")))) + (list (file-append shadow "/bin/passwd") + (file-append shadow "/bin/su") + (file-append inetutils "/bin/ping") + (file-append inetutils "/bin/ping6") + (file-append sudo "/bin/sudo") + (file-append fuse "/bin/fusermount")))) (define %sudoers-specification ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel' -- cgit v1.2.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 'gnu/services/base.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 7ed8ee8130..41b8d5db0b 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 07c08d7567..20a9c3ae11 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.2.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 'gnu/services/base.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 41b8d5db0b..65cf804f1e 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 20a9c3ae11..4c1c481453 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.2.3 From 4a84a48742ab9e15d7d527c3d965f907ec40672c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 19 Sep 2016 23:36:17 +0900 Subject: services: console-font: A single service handles all the VTs. * gnu/services/base.scm (%default-console-font): New variable. (console-font-shepherd-services): New procedure. (console-font-service-type): Change to use 'service-type'. (console-font-service): Rewrite using 'simple-service'. (%base-services): Use a single CONSOLE-FONT-SERVICE-TYPE instance. * gnu/system/install.scm (installation-services): Likewise. --- gnu/services/base.scm | 80 +++++++++++++++++++++++++++++--------------------- gnu/system/install.scm | 10 +++---- 2 files changed, 51 insertions(+), 39 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 4c1c481453..afbecdb47e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -58,6 +58,8 @@ session-environment-service-type host-name-service console-keymap-service + %default-console-font + console-font-service-type console-font-service udev-configuration @@ -635,37 +637,51 @@ strings or string-valued gexps." "Return a service to load console keymaps from @var{files}." (service console-keymap-service-type files)) -(define console-font-service-type - (shepherd-service-type - 'console-font - (match-lambda - ((tty font) - (let ((device (string-append "/dev/" tty))) - (shepherd-service - (documentation "Load a Unicode console font.") - (provision (list (symbol-append 'console-font- - (string->symbol tty)))) - - ;; Start after mingetty has been started on TTY, otherwise the settings - ;; are ignored. - (requirement (list (symbol-append 'term- - (string->symbol tty)))) +(define %default-console-font + ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common + ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode + ;; codepoints notably found in the UTF-8 manual. + "LatGrkCyr-8x16") + +(define (console-font-shepherd-services tty+font) + "Return a list of Shepherd services for each pair in TTY+FONT." + (map (match-lambda + ((tty . font) + (let ((device (string-append "/dev/" tty))) + (shepherd-service + (documentation "Load a Unicode console font.") + (provision (list (symbol-append 'console-font- + (string->symbol tty)))) + + ;; Start after mingetty has been started on TTY, otherwise the settings + ;; are ignored. + (requirement (list (symbol-append 'term- + (string->symbol tty)))) + + (start #~(lambda _ + (and #$(unicode-start device) + (zero? + (system* (string-append #$kbd "/bin/setfont") + "-C" #$device #$font))))) + (stop #~(const #t)) + (respawn? #f))))) + tty+font)) - (start #~(lambda _ - (and #$(unicode-start device) - (zero? - (system* (string-append #$kbd "/bin/setfont") - "-C" #$device #$font))))) - (stop #~(const #t)) - (respawn? #f))))))) +(define console-font-service-type + (service-type (name 'console-fonts) + (extensions + (list (service-extension shepherd-root-service-type + console-font-shepherd-services))) + (compose concatenate) + (extend append))) (define* (console-font-service tty #:optional (font "LatGrkCyr-8x16")) - "Return a service that sets up Unicode support in @var{tty} and loads + "This procedure is deprecated in favor of @code{console-font-service-type}. + +Return a service that sets up Unicode support in @var{tty} and loads @var{font} for that tty (fonts are per virtual console in Linux.)" - ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common - ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode - ;; codepoints notably found in the UTF-8 manual. - (service console-font-service-type (list tty font))) + (simple-service (symbol-append 'console-font- (string->symbol tty)) + console-font-service-type `((,tty . ,font)))) (define %default-motd (plain-file "motd" "This is the GNU operating system, welcome!\n\n")) @@ -1497,12 +1513,10 @@ This service is not part of @var{%base-services}." ;; Convenience variable holding the basic services. (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") + (service console-font-service-type + (map (lambda (tty) + (cons tty %default-console-font)) + '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) (mingetty-service (mingetty-configuration (tty "tty1"))) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index b28925f432..dfa003f256 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -313,12 +313,10 @@ You have been warned. Thanks for being so brave. (cow-store-service) ;; Install Unicode support and a suitable font. - (console-font-service "tty1") - (console-font-service "tty2") - (console-font-service "tty3") - (console-font-service "tty4") - (console-font-service "tty5") - (console-font-service "tty6") + (service console-font-service-type + (map (lambda (tty) + (cons tty %default-console-font)) + '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) ;; To facilitate copy/paste. (gpm-service) -- cgit v1.2.3