cristiancmoises
/
radix
mirror of https://codeberg.org/anemofilia/radix.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

radix: services: greetd: Add a version of greetd-service-type that doesn't create /home/greeter nor use bash as default agreety command when SHELL is set

main
Luis Guilherme Coelho 2024-11-09 08:37:43 -03:00
parent 8b4b9c7e5d
commit 310b855301
No known key found for this signature in database
GPG Key ID: 1F2E76ACE3F531C8
1 changed files with 447 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

447
radix/services/greetd.scm Normal file
View File

@ -0,0 +1,447 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015, 2016, 2020 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 John Soo <jsoo1@asu.edu>
;;; Copyright © 2019, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021 qblade <qblade@protonmail.com>
;;; Copyright © 2021 Hui Lu <luhuins@163.com>
;;; Copyright © 2021, 2022, 2023 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>
;;; Copyright © 2022 ( <paren@disroot.org>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
;;; Copyright © 2024 Luis Guilherme Coelho <lgcoelho@disroot.org>
;;;
;;; This file isn't 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 <http://www.gnu.org/licenses/>.
(define-module (radix services greetd)
#:use-module (guix store)
#:use-module (guix deprecation)
#:autoload (guix diagnostics) (warning formatted-message &fix-hint)
#:autoload (guix i18n) (G_)
#:use-module (guix combinators)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
#:use-module (gnu services sysctl)
#:use-module (gnu system pam)
#:use-module (gnu system shadow) ; 'user-account', etc.
#:use-module (gnu system uuid)
#:use-module (gnu system file-systems) ; 'file-system', etc.
#:use-module (gnu system keyboard)
#:use-module (gnu system mapped-devices)
#:use-module ((gnu system linux-initrd)
#:select (file-system-packages))
#:use-module (gnu packages admin)
#:use-module ((gnu packages linux)
#: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/hurd
glibc-utf8-locales
libc-utf8-locales-for-target
make-glibc-utf8-locales
tar canonical-package))
#:use-module ((gnu packages cross-base)
#:select (cross-libc))
#:use-module ((gnu packages compression) #:select (gzip))
#:use-module (gnu packages fonts)
#:autoload (gnu packages guile-xyz) (guile-netlink)
#:autoload (gnu packages hurd) (hurd)
#:use-module (gnu packages package-management)
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
#:use-module ((gnu packages disk)
#:select (dosfstools))
#:use-module ((gnu packages file-systems)
#:select (bcachefs-tools exfat-utils jfsutils zfs))
#:use-module (gnu packages fonts)
#:use-module (gnu packages terminals)
#:use-module ((gnu packages wm) #:select (sway))
#:use-module ((gnu build file-systems)
#:select (mount-flags->bit-mask
swap-space->flags-bit-mask))
#:autoload (guix channels) (%default-channels channel->code)
#:use-module (guix gexp)
#:use-module ((guix packages) #:select (package-version))
#:use-module (guix records)
#:use-module (guix modules)
#:use-module (guix pki)
#:use-module ((guix self) #:select (make-config.scm))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:autoload (guix utils) (target-hurd?)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:re-export (user-processes-service-type ;backwards compatibility
%default-substitute-urls)
#:export (greetd-service-type
greetd-configuration
greetd-terminal-configuration
greetd-agreety-session
greetd-wlgreet-session
greetd-wlgreet-sway-session))
(define %default-motd
(plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
;;;
;;; 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 #~(begin
(use-modules (guix build utils))
(let ((shell (getenv "SHELL")))
(if shell
(which shell)
(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 config)
(match-record config <greetd-agreety-session>
(command 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 #$@command-args))))))
(define (greetd-agreety-tty-xdg-session-command config)
(match-record config <greetd-agreety-session>
(command 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 #$@command-args))))))
(define-gexp-compiler (greetd-agreety-session-compiler
(session <greetd-agreety-session>)
system target)
(let ((agreety (file-append (greetd-agreety session)
"/bin/agreety"))
(command ((if (greetd-agreety-xdg-env? session)
greetd-agreety-tty-xdg-session-command
greetd-agreety-tty-session-command)
session)))
(lower-object
(program-file "agreety-command"
#~(execl #$agreety #$agreety "-c" #$command)))))
(define-record-type* <greetd-wlgreet-session>
greetd-wlgreet-session make-greetd-wlgreet-session
greetd-wlgreet-session?
(wlgreet greetd-wlgreet (default wlgreet))
(command greetd-wlgreet-command
(default (file-append sway "/bin/sway")))
(command-args greetd-wlgreet-command-args (default '()))
(output-mode greetd-wlgreet-output-mode (default "all"))
(scale greetd-wlgreet-scale (default 1))
(background greetd-wlgreet-background (default '(0 0 0 0.9)))
(headline greetd-wlgreet-headline (default '(1 1 1 1)))
(prompt greetd-wlgreet-prompt (default '(1 1 1 1)))
(prompt-error greetd-wlgreet-prompt-error (default '(1 1 1 1)))
(border greetd-wlgreet-border (default '(1 1 1 1)))
(extra-env greetd-wlgreet-extra-env (default '())))
(define (greetd-wlgreet-wayland-session-command session)
(program-file "wlgreet-session-command"
#~(let* ((username (getenv "USER"))
(useruid (number->string
(passwd:uid (getpwuid username))))
(command #$(greetd-wlgreet-command session)))
(use-modules (ice-9 match))
(setenv "XDG_SESSION_TYPE" "wayland")
(setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))
(for-each (lambda (env) (setenv (car env) (cdr env)))
'(#$@(greetd-wlgreet-extra-env session)))
(apply execl command command
(list #$@(greetd-wlgreet-command-args session))))))
(define (make-wlgreet-config-color section-name color)
(match color
((red green blue opacity)
(string-append
"[" section-name "]\n"
"red = " (number->string red) "\n"
"green = " (number->string green) "\n"
"blue = " (number->string blue) "\n"
"opacity = " (number->string opacity) "\n"))))
(define (make-wlgreet-configuration-file session)
(let ((command (greetd-wlgreet-wayland-session-command session))
(output-mode (greetd-wlgreet-output-mode session))
(scale (greetd-wlgreet-scale session))
(background (greetd-wlgreet-background session))
(headline (greetd-wlgreet-headline session))
(prompt (greetd-wlgreet-prompt session))
(prompt-error (greetd-wlgreet-prompt-error session))
(border (greetd-wlgreet-border session)))
(mixed-text-file "wlgreet.toml"
"command = \"" command "\"\n"
"outputMode = \"" output-mode "\"\n"
"scale = " (number->string scale) "\n"
(apply string-append
(map (match-lambda
((section-name . color)
(make-wlgreet-config-color section-name color)))
`(("background" . ,background)
("headline" . ,headline)
("prompt" . ,prompt)
("prompt-error" . ,prompt-error)
("border" . ,border)))))))
(define-record-type* <greetd-wlgreet-sway-session>
greetd-wlgreet-sway-session make-greetd-wlgreet-sway-session
greetd-wlgreet-sway-session?
(wlgreet-session greetd-wlgreet-sway-session-wlgreet-session ;<greetd-wlgreet-session>
(default (greetd-wlgreet-session)))
(sway greetd-wlgreet-sway-session-sway (default sway)) ;<package>
(sway-configuration greetd-wlgreet-sway-session-sway-configuration ;file-like
(default (plain-file "wlgreet-sway-config" ""))))
(define (make-wlgreet-sway-configuration-file session)
(let* ((wlgreet-session (greetd-wlgreet-sway-session-wlgreet-session session))
(wlgreet-config (make-wlgreet-configuration-file wlgreet-session))
(wlgreet (file-append (greetd-wlgreet wlgreet-session) "/bin/wlgreet"))
(sway-config (greetd-wlgreet-sway-session-sway-configuration session))
(swaymsg (file-append (greetd-wlgreet-sway-session-sway session)
"/bin/swaymsg")))
(mixed-text-file "wlgreet-sway.conf"
"include " sway-config "\n"
"xwayland disable\n"
"exec \"" wlgreet " --config " wlgreet-config "; "
swaymsg " exit\"\n")))
(define-gexp-compiler (greetd-wlgreet-sway-session-compiler
(session <greetd-wlgreet-sway-session>)
system target)
(let ((sway (file-append (greetd-wlgreet-sway-session-sway session)
"/bin/sway"))
(config (make-wlgreet-sway-configuration-file session)))
(lower-object
(program-file "wlgreet-sway-session-command"
#~(let* ((log-file (open-output-file
(string-append "/tmp/sway-greeter."
(number->string (getpid))
".log")))
(username (getenv "USER"))
(useruid (number->string (passwd:uid (getpwuid username)))))
;; redirect stdout/err to log-file
(dup2 (fileno log-file) 1)
(dup2 1 2)
(sleep 1) ;give seatd/logind some time to start up
(setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))
(execl #$sway #$sway "-d" "-c" #$config))))))
(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))
(source-profile? greetd-source-profile? (default #t))
(default-session-user greetd-default-session-user (default "greeter"))
(default-session-command greetd-default-session-command
(default (greetd-agreety-session))))
(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))
(source-profile? (greetd-source-profile? 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
"[general]\n"
"source_profile = " (if source-profile? "true" "false") "\n"
"[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")
(home-directory "/var/empty")
(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 (file-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))
(pam-extension
(transformer
(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 '(pam 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))))