amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

system: pam: Let PAM extensions add shepherd requirements.

Browse source 
* gnu/system/pam.scm (<pam-extension>): New record type.
(pam-shepherd-service): Add Shepherd synchronization point.

* gnu/services/mail.scm (dovecot-shepherd-service)
* gnu/services/lightdm.scm (lightdm-shepherd-service)
* gnu/services/mail.scm (opensmtpd-shepherd-service)
* gnu/services/sddm.scm (sddm-shepherd-service)
* gnu/services/ssh.scm (lsh-shepherd-service, openssh-shepherd-service)
* gnu/services/xorg.scm (slim-shepherd-service, gdm-shepherd-service)
* gnu/services/base.scm (greetd-shepherd-services): Add PAM requirement.

* gnu/system/pam.scm (/etc-entry, extend-configuration,
pam-root-service-type, pam-root-service)
* gnu/services/authentication.scm (pam-ldap-pam-service)
* gnu/services/base.scm (pam-limits-service-type)
(greetd-pam-service)
* gnu/services/desktop.scm (pam-gnome-keyring)
* gnu/services/kerberos.scm (pam-krb5-pam-service)
* gnu/services/pam-mount.scm (pam-mount-pam-service): Adapt to use
pam-extension.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Josselin Poiret 2023-05-09 18:45:07 +02:00 • committed by Ludovic Courtès
parent b2a65b4c8c
commit 2df5d4fd18
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
11 changed files with 178 additions and 111 deletions
Download patch file Download diff file Expand all files Collapse all files

28
gnu/services/authentication.scm
View file

@ -506,19 +506,21 @@ password.")
(define pam-ldap-module (define pam-ldap-module
#~(string-append #$(nslcd-configuration-nss-pam-ldapd config) #~(string-append #$(nslcd-configuration-nss-pam-ldapd config)
"/lib/security/pam_ldap.so")) "/lib/security/pam_ldap.so"))
(lambda (pam) (pam-extension
(if (member (pam-service-name pam) (transformer
(nslcd-configuration-pam-services config)) (lambda (pam)
(let ((sufficient (if (member (pam-service-name pam)
(pam-entry (nslcd-configuration-pam-services config))
(control "sufficient") (let ((sufficient
(module pam-ldap-module)))) (pam-entry
(pam-service (control "sufficient")
(inherit pam) (module pam-ldap-module))))
(auth (cons sufficient (pam-service-auth pam))) (pam-service
(session (cons sufficient (pam-service-session pam))) (inherit pam)
(account (cons sufficient (pam-service-account pam))))) (auth (cons sufficient (pam-service-auth pam)))
pam))) (session (cons sufficient (pam-service-session pam)))
(account (cons sufficient (pam-service-account pam)))))
pam)))))
(define (pam-ldap-pam-services config) (define (pam-ldap-pam-services config)
(list (pam-ldap-pam-service config))) (list (pam-ldap-pam-service config)))

54
gnu/services/base.scm
View file

@ -1603,20 +1603,22 @@ information on the configuration file syntax."
(define pam-limits-service-type (define pam-limits-service-type
(let ((pam-extension (let ((pam-extension
(lambda (pam) (pam-extension
(let ((pam-limits (pam-entry (transformer
(control "required") (lambda (pam)
(module "pam_limits.so") (let ((pam-limits (pam-entry
(arguments (control "required")
'("conf=/etc/security/limits.conf"))))) (module "pam_limits.so")
(if (member (pam-service-name pam) (arguments
'("login" "greetd" "su" "slim" "gdm-password" "sddm" '("conf=/etc/security/limits.conf")))))
"sudo" "sshd")) (if (member (pam-service-name pam)
(pam-service '("login" "greetd" "su" "slim" "gdm-password"
(inherit pam) "sddm" "sudo" "sshd"))
(session (cons pam-limits (pam-service
(pam-service-session pam)))) (inherit pam)
pam)))) (session (cons pam-limits
(pam-service-session pam))))
pam))))))
;; XXX: Using file-like objects is deprecated, use lists instead. ;; XXX: Using file-like objects is deprecated, use lists instead.
;; This is to be reduced into the list? case when the deprecated ;; This is to be reduced into the list? case when the deprecated
@ -3264,16 +3266,18 @@ to handle."
(greetd-allow-empty-passwords? config) (greetd-allow-empty-passwords? config)
#:motd #:motd
(greetd-motd config)) (greetd-motd config))
(lambda (pam) (pam-extension
(if (member (pam-service-name pam) (transformer
'("login" "greetd" "su" "slim" "gdm-password")) (lambda (pam)
(pam-service (if (member (pam-service-name pam)
(inherit pam) '("login" "greetd" "su" "slim" "gdm-password"))
(auth (append (pam-service-auth pam) (pam-service
(list optional-pam-mount))) (inherit pam)
(session (append (pam-service-session pam) (auth (append (pam-service-auth pam)
(list optional-pam-mount)))) (list optional-pam-mount)))
pam)))) (session (append (pam-service-session pam)
(list optional-pam-mount))))
pam))))))
(define (greetd-shepherd-services config) (define (greetd-shepherd-services config)
(map (map
@ -3285,7 +3289,7 @@ to handle."
(greetd-vt (greetd-terminal-vt tc))) (greetd-vt (greetd-terminal-vt tc)))
(shepherd-service (shepherd-service
(documentation "Minimal and flexible login manager daemon") (documentation "Minimal and flexible login manager daemon")
(requirement '(user-processes host-name udev virtual-terminal)) (requirement '(pam user-processes host-name udev virtual-terminal))
(provision (list (symbol-append (provision (list (symbol-append
'term-tty 'term-tty
(string->symbol (greetd-terminal-vt tc))))) (string->symbol (greetd-terminal-vt tc)))))

44
gnu/services/desktop.scm
View file

@ -1187,10 +1187,12 @@ seats.)"
(module (file-append (elogind-package config) (module (file-append (elogind-package config)
"/lib/security/pam_elogind.so")))) "/lib/security/pam_elogind.so"))))
(list (lambda (pam) (list (pam-extension
(pam-service (transformer
(inherit pam) (lambda (pam)
(session (cons pam-elogind (pam-service-session pam))))))) (pam-service
(inherit pam)
(session (cons pam-elogind (pam-service-session pam)))))))))
(define (elogind-shepherd-service config) (define (elogind-shepherd-service config)
"Return a Shepherd service to start elogind according to @var{config}." "Return a Shepherd service to start elogind according to @var{config}."
@ -1703,22 +1705,24 @@ dispatches events from it.")))
(arguments arguments))) (arguments arguments)))
(list (list
(lambda (service) (pam-extension
(case (assoc-ref (gnome-keyring-pam-services config) (transformer
(pam-service-name service)) (lambda (service)
((login) (case (assoc-ref (gnome-keyring-pam-services config)
(pam-service (pam-service-name service))
(inherit service) ((login)
(auth (append (pam-service-auth service) (pam-service
(list (%pam-keyring-entry)))) (inherit service)
(session (append (pam-service-session service) (auth (append (pam-service-auth service)
(list (%pam-keyring-entry "auto_start")))))) (list (%pam-keyring-entry))))
((passwd) (session (append (pam-service-session service)
(pam-service (list (%pam-keyring-entry "auto_start"))))))
(inherit service) ((passwd)
(password (append (pam-service-password service) (pam-service
(list (%pam-keyring-entry)))))) (inherit service)
(else service))))) (password (append (pam-service-password service)
(list (%pam-keyring-entry))))))
(else service)))))))
(define gnome-keyring-service-type (define gnome-keyring-service-type
(service-type (service-type

42
gnu/services/kerberos.scm
View file

@ -428,27 +428,29 @@ generates such a file. It does not cause any daemon to be started.")))
(define (pam-krb5-pam-service config) (define (pam-krb5-pam-service config)
"Return a PAM service for Kerberos authentication." "Return a PAM service for Kerberos authentication."
(lambda (pam) (pam-extension
(define pam-krb5-module (transformer
#~(string-append #$(pam-krb5-configuration-pam-krb5 config) (lambda (pam)
"/lib/security/pam_krb5.so")) (define pam-krb5-module
#~(string-append #$(pam-krb5-configuration-pam-krb5 config)
"/lib/security/pam_krb5.so"))
(let ((pam-krb5-sufficient (let ((pam-krb5-sufficient
(pam-entry (pam-entry
(control "sufficient") (control "sufficient")
(module pam-krb5-module) (module pam-krb5-module)
(arguments (arguments
(list (list
(format #f "minimum_uid=~a" (format #f "minimum_uid=~a"
(pam-krb5-configuration-minimum-uid config))))))) (pam-krb5-configuration-minimum-uid config)))))))
(pam-service (pam-service
(inherit pam) (inherit pam)
(auth (cons* pam-krb5-sufficient (auth (cons* pam-krb5-sufficient
(pam-service-auth pam))) (pam-service-auth pam)))
(session (cons* pam-krb5-sufficient (session (cons* pam-krb5-sufficient
(pam-service-session pam))) (pam-service-session pam)))
(account (cons* pam-krb5-sufficient (account (cons* pam-krb5-sufficient
(pam-service-account pam))))))) (pam-service-account pam)))))))))
(define (pam-krb5-pam-services config) (define (pam-krb5-pam-services config)
(list (pam-krb5-pam-service config))) (list (pam-krb5-pam-service config)))

2
gnu/services/lightdm.scm
View file

@ -616,7 +616,7 @@ port=" (number->string vnc-server-port) "\n"
(list (list
(shepherd-service (shepherd-service
(documentation "LightDM display manager") (documentation "LightDM display manager")
(requirement '(dbus-system user-processes host-name)) (requirement '(pam dbus-system user-processes host-name))
(provision '(lightdm display-manager xorg-server)) (provision '(lightdm display-manager xorg-server))
(respawn? #f) (respawn? #f)
(start (start

4
gnu/services/mail.scm
View file

@ -1578,7 +1578,7 @@ greyed out, instead of only later giving \"not selectable\" popup error.
(list (shepherd-service (list (shepherd-service
(documentation "Run the Dovecot POP3/IMAP mail server.") (documentation "Run the Dovecot POP3/IMAP mail server.")
(provision '(dovecot)) (provision '(dovecot))
(requirement '(networking)) (requirement '(pam networking))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$dovecot "/sbin/dovecot") (list (string-append #$dovecot "/sbin/dovecot")
"-F"))) "-F")))
@ -1676,7 +1676,7 @@ match from local for any action outbound
(package config-file shepherd-requirement) (package config-file shepherd-requirement)
(list (shepherd-service (list (shepherd-service
(provision '(smtpd)) (provision '(smtpd))
(requirement `(loopback ,@shepherd-requirement)) (requirement `(pam loopback ,@shepherd-requirement))
(documentation "Run the OpenSMTPD daemon.") (documentation "Run the OpenSMTPD daemon.")
(start (let ((smtpd (file-append package "/sbin/smtpd"))) (start (let ((smtpd (file-append package "/sbin/smtpd")))
#~(make-forkexec-constructor #~(make-forkexec-constructor

23
gnu/services/pam-mount.scm
View file

@ -88,16 +88,19 @@
(pam-entry (pam-entry
(control "optional") (control "optional")
(module #~(string-append #$pam-mount "/lib/security/pam_mount.so")))) (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
(list (lambda (pam) (list
(if (member (pam-service-name pam) (pam-extension
'("login" "greetd" "su" "slim" "gdm-password" "sddm")) (transformer
(pam-service (lambda (pam)
(inherit pam) (if (member (pam-service-name pam)
(auth (append (pam-service-auth pam) '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
(list optional-pam-mount))) (pam-service
(session (append (pam-service-session pam) (inherit pam)
(list optional-pam-mount)))) (auth (append (pam-service-auth pam)
pam)))) (list optional-pam-mount)))
(session (append (pam-service-session pam)
(list optional-pam-mount))))
pam))))))
(define pam-mount-service-type (define pam-mount-service-type
(service-type (service-type

2
gnu/services/sddm.scm
View file

@ -169,7 +169,7 @@ Relogin=" (if (sddm-configuration-relogin? config)
(list (shepherd-service (list (shepherd-service
(documentation "SDDM display manager.") (documentation "SDDM display manager.")
(requirement '(user-processes elogind)) (requirement '(user-processes elogind pam))
(provision '(xorg-server display-manager)) (provision '(xorg-server display-manager))
(start #~(make-forkexec-constructor #$sddm-command)) (start #~(make-forkexec-constructor #$sddm-command))
(stop #~(make-kill-destructor))))) (stop #~(make-kill-destructor)))))

10
gnu/services/ssh.scm
View file

@ -197,9 +197,11 @@
interfaces))))) interfaces)))))
(define requires (define requires
(if (and daemonic? (lsh-configuration-syslog-output? config)) `(networking
'(networking syslogd) pam
'(networking))) ,@(if (and daemonic? (lsh-configuration-syslog-output? config))
'(syslogd)
'())))
(list (shepherd-service (list (shepherd-service
(documentation "GNU lsh SSH server") (documentation "GNU lsh SSH server")
@ -566,7 +568,7 @@ of user-name/file-like tuples."
(list (shepherd-service (list (shepherd-service
(documentation "OpenSSH server.") (documentation "OpenSSH server.")
(requirement '(syslogd loopback)) (requirement '(pam syslogd loopback))
(provision '(ssh-daemon ssh sshd)) (provision '(ssh-daemon ssh sshd))
(start #~(if #$inetd-style? (start #~(if #$inetd-style?

4
gnu/services/xorg.scm
View file

@ -667,7 +667,7 @@ reboot_cmd " shepherd "/sbin/reboot\n"
(list (symbol-append 'xorg-server- (list (symbol-append 'xorg-server-
(string->symbol vt))))) (string->symbol vt)))))
(requirement '(user-processes host-name udev)) (requirement '(pam user-processes host-name udev))
(start (start
#~(lambda () #~(lambda ()
;; A stale lock file can prevent SLiM from starting, so remove it to ;; A stale lock file can prevent SLiM from starting, so remove it to
@ -1119,7 +1119,7 @@ argument.")))
(list (shepherd-service (list (shepherd-service
(documentation "Xorg display server (GDM)") (documentation "Xorg display server (GDM)")
(provision '(xorg-server)) (provision '(xorg-server))
(requirement '(dbus-system user-processes host-name udev elogind)) (requirement '(dbus-system pam user-processes host-name udev elogind))
(start #~(lambda () (start #~(lambda ()
(fork+exec-command (fork+exec-command
(list #$(file-append (gdm-configuration-gdm config) (list #$(file-append (gdm-configuration-gdm config)

76
gnu/system/pam.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2017, 2019-2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013-2017, 2019-2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2023 Josselin Poiret <dev@jpoiret.xyz>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,8 +20,11 @@
(define-module (gnu system pam) (define-module (gnu system pam)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix diagnostics)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix i18n)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system setuid) #:use-module (gnu system setuid)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -55,6 +59,10 @@
session-environment-service session-environment-service
session-environment-service-type session-environment-service-type
pam-extension
pam-extension-transformer
pam-extension-shepherd-requirements
pam-root-service-type pam-root-service-type
pam-root-service)) pam-root-service))
@ -347,32 +355,71 @@ strings or string-valued gexps."
;;; PAM root service. ;;; PAM root service.
;;; ;;;
;; Extension of the PAM configuration. A PAM transformer consists of a
;; procedure acting on each PAM entry; 'shepherd-requirements' lists services
;; that the meta 'pam' Shepherd service will depend on.
(define-record-type* <pam-extension>
pam-extension make-pam-extension pam-extension?
(transformer pam-extension-transformer)
(shepherd-requirements pam-extension-shepherd-requirements
(default '())))
;; Overall PAM configuration: a list of services, plus a procedure that takes ;; Overall PAM configuration: a list of services, plus a procedure that takes
;; one <pam-service> and returns a <pam-service>. The procedure is used to ;; one <pam-service> and returns a <pam-service>. The procedure is used to
;; implement cross-cutting concerns such as the use of the 'elogind.so' ;; implement cross-cutting concerns such as the use of the 'elogind.so'
;; session module that keeps track of logged-in users. ;; session module that keeps track of logged-in users.
(define-record-type* <pam-configuration> (define-record-type* <pam-configuration>
pam-configuration make-pam-configuration? pam-configuration? pam-configuration make-pam-configuration pam-configuration?
(services pam-configuration-services) ;list of <pam-service> ;list of <pam-service>
(transform pam-configuration-transform)) ;procedure (services pam-configuration-services)
;list of procedures <pam-entry> -> <pam-entry>
(transformers pam-configuration-transformers)
;list of symbols
(shepherd-requirements pam-configuration-shepherd-requirements))
(define (/etc-entry config) (define (/etc-entry config)
"Return the /etc/pam.d entry corresponding to CONFIG." "Return the /etc/pam.d entry corresponding to CONFIG."
(match config (match config
(($ <pam-configuration> services transform) (($ <pam-configuration> services transformers shepherd-requirements)
(let ((services (map transform services))) (let ((services (map (apply compose identity transformers)
services)))
`(("pam.d" ,(pam-services->directory services))))))) `(("pam.d" ,(pam-services->directory services)))))))
(define (pam-shepherd-service config)
"Return the PAM synchronization shepherd service corresponding to CONFIG."
(match config
(($ <pam-configuration> services transformers shepherd-requirements)
(list (shepherd-service
(documentation "Synchronization point for services that need to be
started for PAM to work.")
(provision '(pam))
(requirement shepherd-requirements)
(start #~(const #t))
(stop #~(const #t)))))))
(define (extend-configuration initial extensions) (define (extend-configuration initial extensions)
"Extend INITIAL with NEW." "Extend INITIAL with NEW."
(let-values (((services procs) ;; TODO: Remove deprecation shim.
(partition pam-service? extensions))) (define cleaned-extensions
(map (lambda (ext)
(if (procedure? ext)
(begin
(warning (G_ "'pam-root-service-type' extensions should \
now use the <pam-extension> record~%"))
(pam-extension (transformer ext)))
ext))
extensions))
(let-values (((services pam-extensions)
(partition pam-service? cleaned-extensions)))
(pam-configuration (pam-configuration
(services (append (pam-configuration-services initial) (services (append (pam-configuration-services initial)
services)) services))
(transform (apply compose (transformers (append (pam-configuration-transformers initial)
(pam-configuration-transform initial) (map pam-extension-transformer pam-extensions)))
procs))))) (shepherd-requirements
(append (pam-configuration-shepherd-requirements initial)
(append-map pam-extension-shepherd-requirements pam-extensions))))))
(define pam-root-service-type (define pam-root-service-type
(service-type (name 'pam) (service-type (name 'pam)
@ -382,7 +429,9 @@ strings or string-valued gexps."
(lambda (_) (lambda (_)
(list (file-like->setuid-program (list (file-like->setuid-program
(file-append linux-pam "/sbin/unix_chkpwd"))))) (file-append linux-pam "/sbin/unix_chkpwd")))))
(service-extension etc-service-type /etc-entry))) (service-extension etc-service-type /etc-entry)
(service-extension shepherd-root-service-type
pam-shepherd-service)))
;; Arguments include <pam-service> as well as procedures. ;; Arguments include <pam-service> as well as procedures.
(compose concatenate) (compose concatenate)
@ -394,7 +443,7 @@ such as @command{login} or @command{sshd}, and specifies for instance how the
program may authenticate users or what it should do when opening a new program may authenticate users or what it should do when opening a new
session."))) session.")))
(define* (pam-root-service base #:key (transform identity)) (define* (pam-root-service base #:key (transformers '()) (shepherd-requirements '()))
"The \"root\" PAM service, which collects <pam-service> instance and turns "The \"root\" PAM service, which collects <pam-service> instance and turns
them into a /etc/pam.d directory, including the <pam-service> listed in BASE. them into a /etc/pam.d directory, including the <pam-service> listed in BASE.
TRANSFORM is a procedure that takes a <pam-service> and returns a TRANSFORM is a procedure that takes a <pam-service> and returns a
@ -402,6 +451,7 @@ TRANSFORM is a procedure that takes a <pam-service> and returns a
all the PAM services." all the PAM services."
(service pam-root-service-type (service pam-root-service-type
(pam-configuration (services base) (pam-configuration (services base)
(transform transform)))) (transformers transformers)
(shepherd-requirements shepherd-requirements))))