;;; Copyright © 2021 qblade <qblade@protonmail.com>
;;; Copyright © 2021 Hui Lu <luhuins@163.com>
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li>
;;;
;;; This file is part of GNU Guix.
;;;
#:select (file-system-packages))
#:use-module (gnu packages admin)
#:use-module ((gnu packages linux)
- #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools))
+ #:select (alsa-utils btrfs-progs crda eudev
+ e2fsprogs f2fs-tools fuse gpm kbd lvm2 rng-tools
+ util-linux xfsprogs))
#:use-module (gnu packages bash)
#:use-module ((gnu packages base)
#:select (coreutils glibc glibc-utf8-locales tar))
#:autoload (gnu packages hurd) (hurd)
#:use-module (gnu packages package-management)
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
- #:use-module (gnu packages linux)
+ #:use-module ((gnu packages disk)
+ #:select (dosfstools))
+ #:use-module ((gnu packages file-systems)
+ #:select (bcachefs-tools exfat-utils jfsutils zfs))
#:use-module (gnu packages terminals)
#:use-module ((gnu build file-systems)
#:select (mount-flags->bit-mask
#:export (fstab-service-type
root-file-system-service
file-system-service-type
+ file-system-utilities
swap-service
host-name-service
%default-console-font
guix-configuration-extra-options
guix-configuration-log-file
+ guix-extension
+ guix-extension?
+ guix-extension-authorized-keys
+ guix-extension-substitute-urls
+ guix-extension-chroot-directories
+
guix-service-type
guix-publish-configuration
guix-publish-configuration?
pam-limits-service-type
pam-limits-service
- references-file
+ greetd-service-type
+ greetd-configuration
+ greetd-terminal-configuration
+ greetd-agreety-session
%base-services))
;; Return #f if successfully stopped.
(sync)
- (call-with-blocked-asyncs
- (lambda ()
- (let ((null (%make-void-port "w")))
- ;; Close 'shepherd.log'.
- (display "closing log\n")
- ((@ (shepherd comm) stop-logging))
-
- ;; Redirect the default output ports..
- (set-current-output-port null)
- (set-current-error-port null)
-
- ;; Close /dev/console.
- (for-each close-fdes '(0 1 2))
-
- ;; At this point, there are no open files left, so the
- ;; root file system can be re-mounted read-only.
- (mount #f "/" #f
- (logior MS_REMOUNT MS_RDONLY)
- #:update-mtab? #f)
-
- #f)))))
+ (let ((null (%make-void-port "w")))
+ ;; Close 'shepherd.log'.
+ (display "closing log\n")
+ ((@ (shepherd comm) stop-logging))
+
+ ;; Redirect the default output ports..
+ (set-current-output-port null)
+ (set-current-error-port null)
+
+ ;; Close /dev/console.
+ (for-each close-fdes '(0 1 2))
+
+ ;; At this point, there should be no open files left so the
+ ;; root file system can be re-mounted read-only.
+ (let loop ((n 10))
+ (unless (catch 'system-error
+ (lambda ()
+ (mount #f "/" #f
+ (logior MS_REMOUNT MS_RDONLY)
+ #:update-mtab? #f)
+ #t)
+ (const #f))
+ (unless (zero? n)
+ ;; Yield to the other fibers. That gives logging fibers
+ ;; an opportunity to close log files so the 'mount' call
+ ;; doesn't fail with EBUSY.
+ ((@ (fibers) sleep) 1)
+ (loop (- n 1)))))
+
+ #f)))
(respawn? #f)))
(define root-file-system-service-type
(memq 'bind-mount (file-system-flags file-system))))
file-systems))
+(define (file-system-type->utilities type)
+ "Return the package providing the utilities for file system TYPE, #f
+otherwise."
+ (assoc-ref
+ `(("bcachefs" . ,bcachefs-tools)
+ ("btrfs" . ,btrfs-progs)
+ ("exfat" . ,exfat-utils)
+ ("ext2" . ,e2fsprogs)
+ ("ext3" . ,e2fsprogs)
+ ("ext4" . ,e2fsprogs)
+ ("fat" . ,dosfstools)
+ ("f2fs" . ,f2fs-tools)
+ ("jfs" . ,jfsutils)
+ ("vfat" . ,dosfstools)
+ ("xfs" . ,xfsprogs)
+ ("zfs" . ,zfs))
+ type))
+
+(define (file-system-utilities file-systems)
+ "Return a list of packages containing file system utilities for
+FILE-SYSTEMS."
+ (filter-map (lambda (file-system)
+ (file-system-type->utilities (file-system-type file-system)))
+ file-systems))
+
(define file-system-service-type
(service-type (name 'file-systems)
(extensions
file-system-shepherd-services)
(service-extension fstab-service-type
file-system-fstab-entries)
+ (service-extension profile-service-type
+ file-system-utilities)
;; Have 'user-processes' depend on 'file-systems'.
(service-extension user-processes-service-type
(default #f))
(no-hints? agetty-no-hints? ;Boolean
(default #f))
- (no-hostname? agetty-no hostname? ;Boolean
+ (no-hostname? agetty-no-hostname? ;Boolean
(default #f))
(long-hostname? agetty-long-hostname? ;Boolean
(default #f))
# level notice or higher and anything of level err or
# higher to the console.
# Don't log private authentication messages!
- *.alert;auth.notice;authpriv.none /dev/console
+ *.alert;auth.notice;authpriv.none -/dev/console
# Log anything (except mail) of level info or higher.
# Don't log private authentication messages!
- *.info;mail.none;authpriv.none /var/log/messages
+ *.info;mail.none;authpriv.none -/var/log/messages
- # Like /var/log/messages, but also including \"debug\"-level logs.
- *.debug;mail.none;authpriv.none /var/log/debug
+ # Log \"debug\"-level entries and nothing else.
+ *.=debug -/var/log/debug
# Same, in a different place.
- *.info;mail.none;authpriv.none /dev/tty12
+ *.info;mail.none;authpriv.none -/dev/tty12
# The authpriv file has restricted access.
+ # 'fsync' the file after each line (hence the lack of a leading dash).
authpriv.* /var/log/secure
# Log all the mail messages in one place.
- mail.* /var/log/maillog
+ mail.* -/var/log/maillog
"))
(define* (syslog-service #:optional (config (syslog-configuration)))
(module "pam_limits.so")
(arguments '("conf=/etc/security/limits.conf")))))
(if (member (pam-service-name pam)
- '("login" "su" "slim" "gdm-password" "sddm"))
+ '("login" "greetd" "su" "slim" "gdm-password" "sddm"
+ "sudo" "sshd"))
(pam-service
(inherit pam)
(session (cons pam-limits
(substitute-key-authorization authorized-keys guix)
#~#f))))
-(define* (references-file item #:optional (name "references"))
- "Return a file that contains the list of references of ITEM."
- (if (struct? item) ;lowerable object
- (computed-file name
- (with-extensions (list guile-gcrypt) ;for store-copy
- (with-imported-modules (source-module-closure
- '((guix build store-copy)))
- #~(begin
- (use-modules (guix build store-copy))
-
- (call-with-output-file #$output
- (lambda (port)
- (write (map store-info-item
- (call-with-input-file "graph"
- read-reference-graph))
- port))))))
- #:options `(#:local-build? #f
- #:references-graphs (("graph" ,item))))
- (plain-file name "()")))
+(define-record-type* <guix-extension>
+ guix-extension make-guix-extension
+ guix-extension?
+ (authorized-keys guix-extension-authorized-keys ;list of file-like
+ (default '()))
+ (substitute-urls guix-extension-substitute-urls ;list of strings
+ (default '()))
+ (chroot-directories guix-extension-chroot-directories ;list of file-like/strings
+ (default '())))
+
+(define (guix-extension-merge a b)
+ (guix-extension
+ (authorized-keys (append (guix-extension-authorized-keys a)
+ (guix-extension-authorized-keys b)))
+ (substitute-urls (append (guix-extension-substitute-urls a)
+ (guix-extension-substitute-urls b)))
+ (chroot-directories (append (guix-extension-chroot-directories a)
+ (guix-extension-chroot-directories b)))))
(define guix-service-type
(service-type
(service-extension profile-service-type
(compose list guix-configuration-guix))))
- ;; Extensions can specify extra directories to add to the build chroot.
- (compose concatenate)
- (extend (lambda (config directories)
+ ;; Extensions can specify extra directories to add to the build chroot,
+ ;; extra substitute urls and extra authorized keys
+ (compose (lambda (args) (fold guix-extension-merge (guix-extension) args)))
+ (extend (lambda (config extension)
(guix-configuration
(inherit config)
+ (authorized-keys (append (guix-extension-authorized-keys extension)
+ (guix-configuration-authorized-keys config)))
+ (substitute-urls (append (guix-extension-substitute-urls extension)
+ (guix-configuration-substitute-urls config)))
(chroot-directories
- (append (guix-configuration-chroot-directories config)
- directories)))))
+ (append (guix-extension-chroot-directories extension)
+ (guix-configuration-chroot-directories config))))))
(default-value (guix-configuration))
(description
(default 80))
(host guix-publish-configuration-host ;string
(default "localhost"))
- (advertise? guix-publish-advertise? ;boolean
+ (advertise? guix-publish-advertise? ;boolean
(default #f))
(compression guix-publish-configuration-compression
(thunked)
(match-record config <guix-publish-configuration>
(guix port host nar-path cache workers ttl negative-ttl
cache-bypass-threshold advertise?)
- (list (shepherd-service
- (provision '(guix-publish))
- (requirement `(user-processes
- guix-daemon
- ,@(if advertise? '(avahi-daemon) '())))
- (start #~(make-forkexec-constructor
- (list #$(file-append guix "/bin/guix")
+ (let ((command #~(list #$(file-append guix "/bin/guix")
"publish" "-u" "guix-publish"
"-p" #$(number->string port)
#$@(config->compression-options config)
"--cache-bypass-threshold="
(number->string
cache-bypass-threshold)))
- #~()))
-
- ;; Make sure we run in a UTF-8 locale so we can produce
- ;; nars for packages that contain UTF-8 file names such
- ;; as 'nss-certs'. See <https://bugs.gnu.org/26948>.
- #:environment-variables
- (list (string-append "GUIX_LOCPATH="
- #$glibc-utf8-locales "/lib/locale")
- "LC_ALL=en_US.utf8")
- #:log-file "/var/log/guix-publish.log"))
- (stop #~(make-kill-destructor))))))
+ #~())))
+ (options #~(#:environment-variables
+ ;; Make sure we run in a UTF-8 locale so we can produce
+ ;; nars for packages that contain UTF-8 file names such
+ ;; as 'nss-certs'. See <https://bugs.gnu.org/26948>.
+ (list (string-append "GUIX_LOCPATH="
+ #$glibc-utf8-locales "/lib/locale")
+ "LC_ALL=en_US.utf8")
+ #:log-file "/var/log/guix-publish.log"))
+ (endpoints #~(let ((ai (false-if-exception
+ (getaddrinfo #$host
+ #$(number->string port)
+ AI_NUMERICSERV))))
+ (if (pair? ai)
+ (list (endpoint (addrinfo:addr (car ai))))
+ '()))))
+ (list (shepherd-service
+ (provision '(guix-publish))
+ (requirement `(user-processes
+ guix-daemon
+ ,@(if advertise? '(avahi-daemon) '())))
+
+ ;; Use lazy socket activation unless ADVERTISE? is true: in that
+ ;; case the process should start right away to advertise itself.
+ (start #~(if (and (defined? 'make-systemd-constructor) ;> 0.9.0?
+ #$(not advertise?))
+ (make-systemd-constructor
+ #$command #$endpoints #$@options)
+ (make-forkexec-constructor #$command #$@options)))
+ (stop #~(if (and (defined? 'make-systemd-destructor)
+ #$(not advertise?))
+ (make-systemd-destructor)
+ (make-kill-destructor))))))))
(define %guix-publish-accounts
(list (user-group (name "guix-publish") (system? #t))
(service-extension
account-service-type account-extension)
(service-extension
- udev-service-type udev-extension))))))
+ udev-service-type udev-extension)))
+ (description "This service adds udev rules."))))
(service type #f)))
(define (swap-space->shepherd-service-name space)
(name-servers '("10.0.2.3"))))
\f
+;;;
+;;; greetd-service-type -- minimal and flexible login manager daemon
+;;;
+
+(define-record-type* <greetd-agreety-session>
+ greetd-agreety-session make-greetd-agreety-session
+ greetd-agreety-session?
+ (agreety greetd-agreety (default greetd))
+ (command greetd-agreety-command (default (file-append bash "/bin/bash")))
+ (command-args greetd-agreety-command-args (default '("-l")))
+ (extra-env greetd-agreety-extra-env (default '()))
+ (xdg-env? greetd-agreety-xdg-env? (default #t)))
+
+(define greetd-agreety-tty-session-command
+ (match-lambda
+ (($ <greetd-agreety-session> _ command args extra-env)
+ (program-file
+ "agreety-tty-session-command"
+ #~(begin
+ (use-modules (ice-9 match))
+ (for-each (match-lambda ((var . val) (setenv var val)))
+ (quote (#$@extra-env)))
+ (apply execl #$command #$command (list #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+ (match-lambda
+ (($ <greetd-agreety-session> _ command args extra-env)
+ (program-file
+ "agreety-tty-xdg-session-command"
+ #~(begin
+ (use-modules (ice-9 match))
+ (let*
+ ((username (getenv "USER"))
+ (useruid (passwd:uid (getpwuid username)))
+ (useruid (number->string useruid)))
+ (setenv "XDG_SESSION_TYPE" "tty")
+ (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
+ (for-each (match-lambda ((var . val) (setenv var val)))
+ (quote (#$@extra-env)))
+ (apply execl #$command #$command (list #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+ (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+ (program-file
+ "agreety-command"
+ #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+ (cond ((greetd-agreety-session? config-or-command)
+ (cond ((greetd-agreety-xdg-env? config-or-command)
+ (make-greetd-agreety-session-command
+ config-or-command
+ (greetd-agreety-tty-xdg-session-command config-or-command)))
+ (#t
+ (make-greetd-agreety-session-command
+ config-or-command
+ (greetd-agreety-tty-session-command config-or-command)))))
+ (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+ greetd-terminal-configuration make-greetd-terminal-configuration
+ greetd-terminal-configuration?
+ (greetd greetd-package (default greetd))
+ (config-file-name greetd-config-file-name (thunked)
+ (default (default-config-file-name this-record)))
+ (log-file-name greetd-log-file-name (thunked)
+ (default (default-log-file-name this-record)))
+ (terminal-vt greetd-terminal-vt (default "7"))
+ (terminal-switch greetd-terminal-switch (default #f))
+ (default-session-user greetd-default-session-user (default "greeter"))
+ (default-session-command greetd-default-session-command
+ (default (greetd-agreety-session))
+ (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+ (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (default-log-file-name config)
+ (string-join (list "/var/log/greetd-" (greetd-terminal-vt config) ".log") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+ (let*
+ ((config-file-name (greetd-config-file-name config))
+ (terminal-vt (greetd-terminal-vt config))
+ (terminal-switch (greetd-terminal-switch config))
+ (default-session-user (greetd-default-session-user config))
+ (default-session-command (greetd-default-session-command config)))
+ (mixed-text-file
+ config-file-name
+ "[terminal]\n"
+ "vt = " terminal-vt "\n"
+ "switch = " (if terminal-switch "true" "false") "\n"
+ "[default_session]\n"
+ "user = " default-session-user "\n"
+ "command = " default-session-command "\n")))
+
+(define %greetd-file-systems
+ (list (file-system
+ (device "none")
+ (mount-point "/run/greetd/pam_mount")
+ (type "tmpfs")
+ (check? #f)
+ (flags '(no-suid no-dev no-exec))
+ (options "mode=0755")
+ (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+ `((debug (@ (enable "0")))
+ (volume (@ (sgrp "users")
+ (fstype "tmpfs")
+ (mountpoint "/run/user/%(USERUID)")
+ (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+ (logout (@ (wait "0")
+ (hup "0")
+ (term "yes")
+ (kill "no")))
+ (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+ greetd-configuration make-greetd-configuration
+ greetd-configuration?
+ (motd greetd-motd (default %default-motd))
+ (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+ (terminals greetd-terminals (default '()))
+ (greeter-supplementary-groups greetd-greeter-supplementary-groups (default '())))
+
+(define (greetd-accounts config)
+ (list (user-group (name "greeter") (system? #t))
+ (user-account
+ (name "greeter")
+ (group "greeter")
+ (supplementary-groups (greetd-greeter-supplementary-groups config))
+ (system? #t))))
+
+(define (make-greetd-pam-mount-conf-file config)
+ (computed-file
+ "greetd_pam_mount.conf.xml"
+ #~(begin
+ (use-modules (sxml simple))
+ (call-with-output-file #$output
+ (lambda (port)
+ (sxml->xml
+ '(*TOP*
+ (*PI* xml "version='1.0' encoding='utf-8'")
+ (pam_mount
+ #$@%greetd-pam-mount-rules
+ (pmvarrun
+ #$(file-append greetd-pam-mount
+ "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+ port))))))
+
+(define (greetd-etc-service config)
+ `(("security/greetd_pam_mount.conf.xml"
+ ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+ (define optional-pam-mount
+ (pam-entry
+ (control "optional")
+ (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+ (arguments '("disable_interactive"))))
+
+ (list
+ (unix-pam-service "greetd"
+ #:login-uid? #t
+ #:allow-empty-passwords?
+ (greetd-allow-empty-passwords? config)
+ #:motd
+ (greetd-motd config))
+ (lambda (pam)
+ (if (member (pam-service-name pam)
+ '("login" "greetd" "su" "slim" "gdm-password"))
+ (pam-service
+ (inherit pam)
+ (auth (append (pam-service-auth pam)
+ (list optional-pam-mount)))
+ (session (append (pam-service-session pam)
+ (list optional-pam-mount))))
+ pam))))
+
+(define (greetd-shepherd-services config)
+ (map
+ (lambda (tc)
+ (let*
+ ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+ (greetd-conf (make-greetd-terminal-configuration-file tc))
+ (greetd-log (greetd-log-file-name tc))
+ (greetd-vt (greetd-terminal-vt tc)))
+ (shepherd-service
+ (documentation "Minimal and flexible login manager daemon")
+ (requirement '(user-processes host-name udev virtual-terminal))
+ (provision (list (symbol-append
+ 'term-tty
+ (string->symbol (greetd-terminal-vt tc)))))
+ (start #~(make-forkexec-constructor
+ (list #$greetd-bin "-c" #$greetd-conf)
+ #:log-file #$greetd-log))
+ (stop #~(make-kill-destructor)))))
+ (greetd-terminals config)))
+
+(define greetd-service-type
+ (service-type
+ (name 'greetd)
+ (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+ (extensions
+ (list
+ (service-extension account-service-type greetd-accounts)
+ (service-extension file-system-service-type (const %greetd-file-systems))
+ (service-extension etc-service-type greetd-etc-service)
+ (service-extension pam-root-service-type greetd-pam-service)
+ (service-extension shepherd-root-service-type greetd-shepherd-services)))
+ (default-value (greetd-configuration))))
+
+\f
(define %base-services
;; Convenience variable holding the basic services.
(list (service login-service-type)
HCoop / jackhill / guix / guix.git / blobdiff