* [bug#72316] [PATCH 2/3] Switch to Guile-PAM.
2024-07-26 22:01 [bug#72316] [PATCH 0/3] Switch to Guile-PAM Felix Lechner via Guix-patches via
2024-07-26 22:39 ` [bug#72316] [PATCH 1/3] Add guile-pam Felix Lechner via Guix-patches via
@ 2024-07-26 22:39 ` Felix Lechner via Guix-patches via
2024-07-26 22:39 ` [bug#72316] [PATCH 3/3] Add a guile-pam-module service Felix Lechner via Guix-patches via
2 siblings, 0 replies; 6+ messages in thread
From: Felix Lechner via Guix-patches via @ 2024-07-26 22:39 UTC (permalink / raw)
To: 72316; +Cc: Felix Lechner
Change-Id: Ib691b41cdb152f508a4a8d1b12b2a20da8706fed
---
gnu/services/authentication.scm | 9 +-
gnu/services/base.scm | 16 +-
gnu/services/desktop.scm | 14 +-
gnu/services/kerberos.scm | 12 +-
gnu/services/lightdm.scm | 69 ++++++--
gnu/services/pam-mount.scm | 5 +-
gnu/services/sddm.scm | 91 +++++++---
gnu/services/xorg.scm | 17 +-
gnu/system/pam.scm | 296 ++++++++++++++++++++++++++------
9 files changed, 420 insertions(+), 109 deletions(-)
diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index fbfef2d3d0..88ccba6ada 100644
--- a/gnu/services/authentication.scm
+++ b/gnu/services/authentication.scm
@@ -503,9 +503,6 @@ (define (nslcd-shepherd-service config)
(define (pam-ldap-pam-service config)
"Return a PAM service for LDAP authentication."
- (define pam-ldap-module
- (file-append (nslcd-configuration-nss-pam-ldapd config)
- "/lib/security/pam_ldap.so"))
(pam-extension
(transformer
(lambda (pam)
@@ -514,7 +511,11 @@ (define (pam-ldap-pam-service config)
(let ((sufficient
(pam-entry
(control "sufficient")
- (module pam-ldap-module))))
+ (module "pam_ldap.so")
+ (foreign-library-path
+ (list
+ (file-append (nslcd-configuration-nss-pam-ldapd config)
+ "/lib/security"))))))
(pam-service
(inherit pam)
(auth (cons sufficient (pam-service-auth pam)))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 4b5b103cc3..0d99c649c2 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -58,8 +58,8 @@ (define-module (gnu services base)
#: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))
+ e2fsprogs f2fs-tools fuse gpm kbd linux-pam
+ lvm2 rng-tools util-linux xfsprogs))
#:use-module (gnu packages bash)
#:use-module ((gnu packages base)
#:select (coreutils glibc glibc/hurd
@@ -1652,7 +1652,10 @@ (define pam-limits-service-type
(control "required")
(module "pam_limits.so")
(arguments
- (list #~(string-append "conf=" #$limits-file))))))
+ (list #~(string-append "conf=" #$limits-file)))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(if (member (pam-service-name pam)
'("login" "greetd" "su" "slim" "gdm-password"
"sddm" "lightdm" "sudo" "sshd"))
@@ -3540,8 +3543,11 @@ (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"))))
+ (module "pam_mount.so")
+ (arguments '("disable_interactive"))
+ (foreign-library-path
+ (list
+ (file-append greetd-pam-mount "/lib/security")))))
(list
(unix-pam-service "greetd"
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 63e2011ce3..762b933519 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1233,8 +1233,10 @@ (define (pam-extension-procedure config)
(define pam-elogind
(pam-entry
(control "required")
- (module (file-append (elogind-package config)
- "/lib/security/pam_elogind.so"))))
+ (module "pam_elogind.so")
+ (foreign-library-path
+ (list
+ (file-append (elogind-package config) "/lib/security")))))
(list (pam-extension
(transformer
@@ -1886,9 +1888,11 @@ (define (pam-gnome-keyring config)
(define (%pam-keyring-entry . arguments)
(pam-entry
(control "optional")
- (module (file-append (gnome-keyring-package config)
- "/lib/security/pam_gnome_keyring.so"))
- (arguments arguments)))
+ (module "pam_gnome_keyring.so")
+ (arguments arguments)
+ (foreign-library-path
+ (list
+ (file-append (gnome-keyring-package config) "/lib/security")))))
(list
(pam-extension
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index a6f540a9b6..d2d8988a83 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -431,18 +431,18 @@ (define (pam-krb5-pam-service config)
(pam-extension
(transformer
(lambda (pam)
- (define pam-krb5-module
- (file-append (pam-krb5-configuration-pam-krb5 config)
- "/lib/security/pam_krb5.so"))
-
(let ((pam-krb5-sufficient
(pam-entry
(control "sufficient")
- (module pam-krb5-module)
+ (module "pam_krb5.so")
(arguments
(list
(format #f "minimum_uid=~a"
- (pam-krb5-configuration-minimum-uid config)))))))
+ (pam-krb5-configuration-minimum-uid config))))
+ (foreign-library-path
+ (list
+ (file-append (pam-krb5-configuration-pam-krb5 config)
+ "/lib/security"))))))
(pam-service
(inherit pam)
(auth (cons* pam-krb5-sufficient
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 18beaa44de..dcdae51c68 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -24,6 +24,7 @@ (define-module (gnu services lightdm)
#:use-module (gnu packages display-managers)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages gnome)
+ #:use-module ((gnu packages linux) #:select (linux-pam))
#:use-module (gnu packages vnc)
#:use-module (gnu packages xorg)
#:use-module (gnu services configuration)
@@ -546,15 +547,35 @@ (define (lightdm-greeter-pam-service)
(name "lightdm-greeter")
(auth (list
;; Load environment from /etc/environment and ~/.pam_environment.
- (pam-entry (control "required") (module "pam_env.so"))
+ (pam-entry (control "required")
+ (module "pam_env.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
;; Always let the greeter start without authentication.
- (pam-entry (control "required") (module "pam_permit.so"))))
+ (pam-entry (control "required")
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
;; No action required for account management
- (account (list (pam-entry (control "required") (module "pam_permit.so"))))
+ (account (list (pam-entry (control "required")
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
;; Prohibit changing password.
- (password (list (pam-entry (control "required") (module "pam_deny.so"))))
+ (password (list (pam-entry (control "required")
+ (module "pam_deny.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
;; Setup session.
- (session (list (pam-entry (control "required") (module "pam_unix.so"))))))
+ (session (list (pam-entry (control "required")
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))))
(define (lightdm-autologin-pam-service)
"Return a PAM service for @command{lightdm-autologin}}."
@@ -563,17 +584,41 @@ (define (lightdm-autologin-pam-service)
(auth
(list
;; Block login if user is globally disabled.
- (pam-entry (control "required") (module "pam_nologin.so"))
- (pam-entry (control "required") (module "pam_succeed_if.so")
- (arguments (list "uid >= 1000")))
+ (pam-entry (control "required")
+ (module "pam_nologin.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
+ (pam-entry (control "required")
+ (module "pam_succeed_if.so")
+ (arguments (list "uid >= 1000"))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
;; Allow access without authentication.
- (pam-entry (control "required") (module "pam_permit.so"))))
+ (pam-entry (control "required")
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
;; Stop autologin if account requires action.
- (account (list (pam-entry (control "required") (module "pam_unix.so"))))
+ (account (list (pam-entry (control "required")
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
;; Prohibit changing password.
- (password (list (pam-entry (control "required") (module "pam_deny.so"))))
+ (password (list (pam-entry (control "required")
+ (module "pam_deny.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
;; Setup session.
- (session (list (pam-entry (control "required") (module "pam_unix.so"))))))
+ (session (list (pam-entry (control "required")
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))))
(define (lightdm-pam-services config)
(list (lightdm-pam-service config)
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index b3a02e82e9..1eb5b44e31 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -94,7 +94,10 @@ (define (pam-mount-pam-service config)
(define optional-pam-mount
(pam-entry
(control "optional")
- (module (file-append pam-mount "/lib/security/pam_mount.so"))))
+ (module "pam_mount.so")
+ (foreign-library-path
+ (list
+ (file-append pam-mount "/lib/security")))))
(list
(pam-extension
(transformer
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index 92d64cc599..cb2c5a9276 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -24,6 +24,7 @@ (define-module (gnu services sddm)
#:use-module (gnu packages admin)
#:use-module (gnu packages display-managers)
#:use-module (gnu packages freedesktop)
+ #:use-module ((gnu packages linux) #:select (linux-pam))
#:use-module (gnu packages xorg)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
@@ -206,40 +207,61 @@ (define (sddm-pam-service config)
(list
(pam-entry
(control "requisite")
- (module "pam_nologin.so"))
+ (module "pam_nologin.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
(pam-entry
(control "required")
- (module "pam_env.so"))
+ (module "pam_env.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
(pam-entry
(control "required")
(module "pam_succeed_if.so")
(arguments (list (string-append "uid >= "
(number->string (sddm-configuration-minimum-uid config)))
- "quiet")))
+ "quiet"))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
;; should be factored out into system-auth
(pam-entry
(control "required")
- (module "pam_unix.so"))))
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(account
(list
;; should be factored out into system-account
(pam-entry
(control "required")
- (module "pam_unix.so"))))
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(password
(list
;; should be factored out into system-password
(pam-entry
(control "required")
(module "pam_unix.so")
- (arguments (list "sha512" "shadow" "try_first_pass")))))
+ (arguments (list "sha512" "shadow" "try_first_pass"))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(session
(list
;; lfs has a required pam_limits.so
;; should be factored out into system-session
(pam-entry
(control "required")
- (module "pam_unix.so"))))))
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))))
(define (sddm-greeter-pam-service)
"Return a PAM service for @command{sddm-greeter}."
@@ -250,29 +272,44 @@ (define (sddm-greeter-pam-service)
;; Load environment from /etc/environment and ~/.pam_environment
(pam-entry
(control "required")
- (module "pam_env.so"))
+ (module "pam_env.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
;; Always let the greeter start without authentication
(pam-entry
(control "required")
- (module "pam_permit.so"))))
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(account
(list
;; No action required for account management
(pam-entry
(control "required")
- (module "pam_permit.so"))))
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(password
(list
;; Can't change password
(pam-entry
(control "required")
- (module "pam_deny.so"))))
+ (module "pam_deny.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(session
(list
;; Setup session
(pam-entry
(control "required")
- (module "pam_unix.so"))))))
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))))
(define (sddm-autologin-pam-service config)
"Return a PAM service for @command{sddm-autologin}"
@@ -282,31 +319,37 @@ (define (sddm-autologin-pam-service config)
(list
(pam-entry
(control "requisite")
- (module "pam_nologin.so"))
+ (module "pam_nologin.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
(pam-entry
(control "required")
(module "pam_succeed_if.so")
(arguments (list (string-append "uid >= "
(number->string (sddm-configuration-minimum-uid config)))
- "quiet")))
+ "quiet"))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
(pam-entry
(control "required")
- (module "pam_permit.so"))))
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(account
- (list
- (pam-entry
- (control "include")
- (module "sddm"))))
+ (pam-service-account (sddm-pam-service config)))
(password
(list
(pam-entry
(control "required")
- (module "pam_deny.so"))))
+ (module "pam_deny.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(session
- (list
- (pam-entry
- (control "include")
- (module "sddm"))))))
+ (pam-service-session (sddm-pam-service config)))))
(define (sddm-pam-services config)
(list (sddm-pam-service config)
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index e7d8922d76..b1df08662f 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -1236,16 +1236,25 @@ (define (gdm-pam-service config)
#:login-uid? #t))
(auth (list (pam-entry
(control "optional")
- (module (file-append (gdm-configuration-gdm config)
- "/lib/security/pam_gdm.so")))
+ (module "pam_gdm.so")
+ (foreign-library-path
+ (list
+ (file-append (gdm-configuration-gdm config)
+ "/lib/security/"))))
(pam-entry
(control "sufficient")
- (module "pam_permit.so")))))
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security")))))))
(pam-service
(inherit (unix-pam-service "gdm-launch-environment"))
(auth (list (pam-entry
(control "required")
- (module "pam_permit.so")))))
+ (module "pam_permit.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security")))))))
(unix-pam-service "gdm-password"
#:login-uid? #t
#:allow-empty-passwords?
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index a035a92e25..232256d59a 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -32,7 +32,9 @@ (define-module (gnu system pam)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module ((guix utils) #:select (%current-system))
+ #:use-module (gnu packages guile)
#:use-module (gnu packages linux)
+ #:use-module (gnu packages mes)
#:export (pam-service
pam-service-name
pam-service-account
@@ -44,6 +46,8 @@ (define-module (gnu system pam)
pam-entry-control
pam-entry-module
pam-entry-arguments
+ pam-entry-guile-inputs
+ pam-entry-foreign-library-path
pam-limits-entry
pam-limits-entry-domain
@@ -92,10 +96,16 @@ (define-record-type* <pam-service> pam-service
(define-record-type* <pam-entry> pam-entry
make-pam-entry
pam-entry?
- (control pam-entry-control) ; string
+ (control pam-entry-control) ; string, symbol or g-expression
(module pam-entry-module) ; file name
(arguments pam-entry-arguments ; list of string-valued g-expressions
- (default '())))
+ (default '()))
+ (guile-inputs pam-entry-guile-inputs ; list of package variables
+ (default '()))
+ (foreign-library-path pam-entry-foreign-library-path ; list of file-like folders
+ ;; courtesy for historical usage
+ (default (list
+ (file-append linux-pam "/lib/security")))))
;; PAM limits entries are used by the pam_limits PAM module to set or override
;; limits on system resources for user sessions. The format is specified
@@ -150,35 +160,79 @@ (define (pam-limits-entry->string entry)
(number->string value))))
" "))))
-(define (pam-service->configuration service)
+(define (pam-service->configuration service shared-object environment-file pamda-file)
"Return the derivation building the configuration file for SERVICE, to be
dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
- (define (entry->gexp type entry)
- (match entry
- (($ <pam-entry> control module (arguments ...))
- #~(format #t "~a ~a ~a ~a~%"
- #$type #$control #$module
- (string-join (list #$@arguments))))))
-
- (match service
- (($ <pam-service> name account auth password session)
- (define builder
- #~(begin
- (with-output-to-file #$output
- (lambda ()
- #$@(append (map (cut entry->gexp "account" <>) account)
- (map (cut entry->gexp "auth" <>) auth)
- (map (cut entry->gexp "password" <>) password)
- (map (cut entry->gexp "session" <>) session))
- #t))))
-
- (computed-file name builder))))
-
-(define (pam-services->directory services)
+ (mixed-text-file (pam-service-name service)
+ "account required " shared-object " " environment-file " " pamda-file "\n"
+ "auth required " shared-object " " environment-file " " pamda-file "\n"
+ "password required " shared-object " " environment-file " " pamda-file "\n"
+ "session required " shared-object " " environment-file " " pamda-file "\n"))
+
+(define (intersperse a xs)
+ (if (null? xs)
+ '()
+ [cons (car xs)
+ (if (null? (cdr xs))
+ (cdr xs)
+ (cons a (intersperse a (cdr xs))))]))
+
+(define* (make-environment-file guile-inputs
+ foreign-library-path
+ #:key
+ (auto-compile? #f)
+ (guix-locale-path '("/run/current-system/locale"))
+ (install-locale? #f)
+ (jit-log-level 0)
+ (jit-pause-when-stopping? #f)
+ (jit-stop-after -1)
+ (jit-threshold 1000)
+ (locale "C.utf8")
+ (warn-deprecated "yes"))
+ (let* ((load-path (map (lambda (package)
+ (file-append package "/share/guile/site/3.0"))
+ guile-inputs))
+ (load-compiled-path (map (lambda (package)
+ (file-append package "/lib/guile/3.0/site-ccache"))
+ guile-inputs))
+ (lines `(("LANG=" ,locale)
+ ;; note on LOCPATH from the Glibc manual:
+ ;; The value of ‘LOCPATH’ is ignored by privileged programs for security
+ ;; reasons, and only the default directory is used.
+ ("GUIX_LOCPATH=" ,@(intersperse ":" guix-locale-path))
+ ("GUILE_AUTO_COMPILE=" ,(if auto-compile? "1" "0"))
+ ("GUILE_INSTALL_LOCALE=" ,(if install-locale? "1" "0"))
+ ("GUILE_LOAD_PATH=" ,@(intersperse ":" load-path))
+ ("GUILE_LOAD_COMPILED_PATH=" ,@(intersperse ":" load-compiled-path))
+ ("GUILE_EXTENSIONS_PATH=" ,@(intersperse ":" foreign-library-path))
+ ("GUILE_WARN_DEPRECATED=" ,warn-deprecated)
+ ("GUILE_JIT_LOG=" ,(number->string jit-log-level))
+ ("GUILE_JIT_PAUSE_WHEN_STOPPING=" ,(if jit-pause-when-stopping? "1" "0"))
+ ("GUILE_JIT_STOP_AFTER=" ,(number->string jit-stop-after))
+ ("GUILE_JIT_THRESHOLD=" ,(number->string jit-threshold))))
+ (terminated (map (lambda (line)
+ (append line '("\0")))
+ lines))
+ (flattened (fold (lambda (right left)
+ (append left right))
+ '()
+ terminated)))
+ (apply mixed-text-file "guile-pam-environment" flattened)))
+
+(define (pam-services->directory shared-object
+ guile-inputs
+ foreign-library-path
+ folder
+ services)
"Return the derivation to build the configuration directory to be used as
/etc/pam.d for SERVICES."
- (let ((names (map pam-service-name services))
- (files (map pam-service->configuration services)))
+ (let* ((names (map pam-service-name services))
+ (environment-file (make-environment-file guile-inputs
+ foreign-library-path))
+ (pamda-file (make-pam-stack folder services))
+ (files (map (cut pam-service->configuration <>
+ shared-object environment-file pamda-file)
+ services)))
(define builder
#~(begin
(use-modules (ice-9 match)
@@ -195,14 +249,17 @@ (define (pam-services->directory services)
;; instead. See <http://bugs.gnu.org/20037>.
(delete-duplicates '#$(zip names files)))))
- (computed-file "pam.d" builder)))
+ (computed-file folder builder)))
(define %pam-other-services
;; The "other" PAM configuration, which denies everything (see
;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
(let ((deny (pam-entry
(control "required")
- (module "pam_deny.so"))))
+ (module "pam_deny.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(pam-service
(name "other")
(account (list deny))
@@ -213,12 +270,18 @@ (define %pam-other-services
(define unix-pam-service
(let ((unix (pam-entry
(control "required")
- (module "pam_unix.so")))
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security")))))
(env (pam-entry ; to honor /etc/environment.
(control "required")
- (module "pam_env.so"))))
+ (module "pam_env.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(lambda* (name #:key allow-empty-passwords? allow-root? motd
- login-uid? gnupg?)
+ login-uid? gnupg?)
"Return a standard Unix-style PAM service for NAME. When
ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When ALLOW-ROOT? is
true, allow root to run the command without authentication. When MOTD is
@@ -234,40 +297,61 @@ (define unix-pam-service
(auth (append (if allow-root?
(list (pam-entry
(control "sufficient")
- (module "pam_rootok.so")))
+ (module "pam_rootok.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security")))))
'())
(list (if allow-empty-passwords?
(pam-entry
(control "required")
(module "pam_unix.so")
- (arguments '("nullok")))
+ (arguments '("nullok"))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))
unix))
(if gnupg?
(list (pam-entry
(control "required")
- (module (file-append pam-gnupg "/lib/security/pam_gnupg.so"))))
+ (module "pam_gnupg.so")
+ (foreign-library-path
+ (list
+ (file-append pam-gnupg "/lib/security")))))
'())))
(password (list (pam-entry
(control "required")
(module "pam_unix.so")
;; Store SHA-512 encrypted passwords in /etc/shadow.
- (arguments '("sha512" "shadow")))))
+ (arguments '("sha512" "shadow"))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(session `(,@(if motd
(list (pam-entry
(control "optional")
(module "pam_motd.so")
(arguments
- (list #~(string-append "motd=" #$motd)))))
+ (list #~(string-append "motd=" #$motd)))
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security")))))
'())
,@(if login-uid?
(list (pam-entry ;to fill in /proc/self/loginuid
(control "required")
- (module "pam_loginuid.so")))
+ (module "pam_loginuid.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security")))))
'())
,@(if gnupg?
(list (pam-entry
(control "required")
- (module (file-append pam-gnupg "/lib/security/pam_gnupg.so"))))
+ (module "pam_gnupg.so")
+ (foreign-library-path
+ (list
+ (file-append pam-gnupg "/lib/security")))))
'())
,env ,unix))))))
@@ -276,13 +360,19 @@ (define (rootok-pam-service command)
authenticate to run COMMAND."
(let ((unix (pam-entry
(control "required")
- (module "pam_unix.so"))))
+ (module "pam_unix.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(pam-service
(name command)
(account (list unix))
(auth (list (pam-entry
(control "sufficient")
- (module "pam_rootok.so"))))
+ (module "pam_rootok.so")
+ (foreign-library-path
+ (list
+ (file-append linux-pam "/lib/security"))))))
(password (list unix))
(session (list unix)))))
@@ -374,21 +464,114 @@ (define-record-type* <pam-configuration>
(services pam-configuration-services)
;list of procedures <pam-entry> -> <pam-entry>
(transformers pam-configuration-transformers)
+ ;; file-like shared module
+ (shared-object pam-configuration-shared-object)
+ ;; list of package variables
+ (guile-inputs pam-configuration-guile-inputs)
+ ;; list of file-like folders
+ (foreign-library-path pam-configuration-foreign-library-path)
;list of symbols
(shepherd-requirements pam-configuration-shepherd-requirements))
+(define (make-pam-stack folder services)
+ (define* (entry->gate entry
+ #:key
+ only-actions
+ only-services)
+ (match entry
+ (($ <pam-entry> control module (options ...))
+ ;; adapted from (pam legacy configuration)
+ (cond
+ ((string=? "include" control)
+ (error "PAM include not implemented; send list of <pam-entry> instead"
+ control module options entry))
+ ((string=? "substack" control)
+ ;; this probably differs a little bit from Linux-PAM
+ #~(gate required (stack-pamda
+ (configuration-file->gates #$folder #$module
+ #:only-actions '#$only-actions
+ #:only-services '#$only-services))
+ #:only-actions '#$only-actions
+ #:only-services '#$only-services))
+ (else
+ #~(gate (legacy-plan->modern-plan #$control)
+ (legacy-or-modern-pamda #$module)
+ #:options (list #$@options)
+ #:only-actions '#$only-actions
+ #:only-services '#$only-services))))))
+
+ (define (service->gates service)
+ (match service
+ (($ <pam-service> name account auth password session)
+ (append (map (cut entry->gate <>
+ #:only-actions '(pam_sm_acct_mgmt)
+ #:only-services (list name))
+ account)
+ (map (cut entry->gate <>
+ #:only-actions '(pam_sm_authenticate
+ pam_sm_setcred)
+ #:only-services (list name))
+ auth)
+ (map (cut entry->gate <>
+ #:only-actions '(pam_sm_chauthtok)
+ #:only-services (list name))
+ password)
+ (map (cut entry->gate <>
+ #:only-actions '(pam_sm_open_session
+ pam_sm_close_session)
+ #:only-services (list name))
+ session)))))
+
+ (let* ((gates (append-map service->gates services)))
+ (scheme-file
+ "guile-pam-stack.scm"
+ #~(begin
+ (use-modules (pam stack)
+ (pam legacy configuration)
+ (pam legacy module)
+ (pam legacy stack))
+ (stack-pamda (list #$@gates))))))
+
(define (/etc-entry config)
"Return the /etc/pam.d entry corresponding to CONFIG."
+ (define (service->pam-entries service)
+ (match service
+ (($ <pam-service> name account auth password session)
+ (append account auth password session))))
(match config
- (($ <pam-configuration> services transformers shepherd-requirements)
- (let ((services (map (apply compose identity transformers)
- services)))
- `(("pam.d" ,(pam-services->directory services)))))))
+ (($ <pam-configuration> services
+ transformers
+ shared-object
+ guile-inputs
+ foreign-library-path
+ shepherd-requirements)
+ (let* ((services (map (apply compose identity transformers)
+ services))
+ (all-entries (append-map service->pam-entries
+ services))
+ (combined-inputs (delete-duplicates
+ (append guile-inputs
+ (append-map pam-entry-guile-inputs
+ all-entries))))
+ (combined-library-path (delete-duplicates
+ (append foreign-library-path
+ (append-map pam-entry-foreign-library-path
+ all-entries)))))
+ `(("pam.d" ,(pam-services->directory shared-object
+ combined-inputs
+ combined-library-path
+ "pam.d"
+ services)))))))
(define (pam-shepherd-service config)
"Return the PAM synchronization shepherd service corresponding to CONFIG."
(match config
- (($ <pam-configuration> services transformers shepherd-requirements)
+ (($ <pam-configuration> services
+ transformers
+ shared-object
+ guile-inputs
+ foreign-library-path
+ shepherd-requirements)
(list (shepherd-service
(documentation "Synchronization point for services that need to be
started for PAM to work.")
@@ -417,6 +600,9 @@ (define (extend-configuration initial extensions)
services))
(transformers (append (pam-configuration-transformers initial)
(map pam-extension-transformer pam-extensions)))
+ (shared-object (pam-configuration-shared-object initial))
+ (guile-inputs (pam-configuration-guile-inputs initial))
+ (foreign-library-path (pam-configuration-foreign-library-path initial))
(shepherd-requirements
(append (pam-configuration-shepherd-requirements initial)
(append-map pam-extension-shepherd-requirements pam-extensions))))))
@@ -442,8 +628,19 @@ (define pam-root-service-type
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
session.")))
-
-(define* (pam-root-service base #:key (transformers '()) (shepherd-requirements '()))
+(define* (pam-root-service base
+ #:key
+ (transformers '())
+ (shared-object
+ (file-append guile-pam "/lib/security/pam_guile.so"))
+ (guile-inputs
+ (list guile-3.0
+ guile-bytestructures ;for (bytestructures guile)
+ guile-pam ;for (pam) and (ffi pam)
+ nyacc)) ;for (system ffi-helper-rt)
+ (foreign-library-path
+ (list (file-append linux-pam "/lib"))) ;for libpam.so
+ (shepherd-requirements '()))
"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.
TRANSFORM is a procedure that takes a <pam-service> and returns a
@@ -452,6 +649,9 @@ (define* (pam-root-service base #:key (transformers '()) (shepherd-requirements
(service pam-root-service-type
(pam-configuration (services base)
(transformers transformers)
+ (shared-object shared-object)
+ (guile-inputs guile-inputs)
+ (foreign-library-path foreign-library-path)
(shepherd-requirements shepherd-requirements))))
--
2.45.2
^ permalink raw reply related [flat|nested] 6+ messages in thread* [bug#72316] [PATCH 3/3] Add a guile-pam-module service.
2024-07-26 22:01 [bug#72316] [PATCH 0/3] Switch to Guile-PAM Felix Lechner via Guix-patches via
2024-07-26 22:39 ` [bug#72316] [PATCH 1/3] Add guile-pam Felix Lechner via Guix-patches via
2024-07-26 22:39 ` [bug#72316] [PATCH 2/3] Switch to Guile-PAM Felix Lechner via Guix-patches via
@ 2024-07-26 22:39 ` Felix Lechner via Guix-patches via
2024-07-29 10:22 ` pelzflorian (Florian Pelz)
2 siblings, 1 reply; 6+ messages in thread
From: Felix Lechner via Guix-patches via @ 2024-07-26 22:39 UTC (permalink / raw)
To: 72316
Cc: Felix Lechner, Florian Pelz, Ludovic Courtès,
Matthew Trzcinski, Maxim Cournoyer
Change-Id: I1da0fe25f542cf9d8c22d26a7434f952585119e6
---
doc/guix.texi | 89 ++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
gnu/services/pam.scm | 105 +++++++++++++++++++++++++++++++++++++++++++
3 files changed, 195 insertions(+)
create mode 100644 gnu/services/pam.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 41814042f5..a9bf00f0bb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -403,6 +403,7 @@ Top
* Telephony Services:: Telephony services.
* File-Sharing Services:: File-sharing services.
* Monitoring Services:: Monitoring services.
+* Guile-PAM Services:: Guile-PAM services.
* Kerberos Services:: Kerberos services.
* LDAP Services:: LDAP services.
* Web Services:: Web servers.
@@ -18991,6 +18992,7 @@ Services
* Telephony Services:: Telephony services.
* File-Sharing Services:: File-sharing services.
* Monitoring Services:: Monitoring services.
+* Guile-PAM Services:: Guile-PAM services.
* Kerberos Services:: Kerberos services.
* LDAP Services:: LDAP services.
* Web Services:: Web servers.
@@ -30932,6 +30934,93 @@ Monitoring Services
@end deftp
+@c %end of fragment
+
+@node Guile-PAM Services
+@subsection Guile-PAM Services
+@cindex Guile-PAM
+
+The @code{(gnu services pam)} module provides services related to the
+authentication mechanism @dfn{Guile-PAM}.
+
+Guile-PAM is a reimplementation in GNU Guile of the venerable Linux-PAM
+authentication system. For details, please have a look at the Texinfo
+manual in the @code{guile-pam} package.
+
+@defvar guile-pam-module-service-type
+A service type for Guile-PAM modules.
+@end defvar
+
+@noindent
+Here is an example of its use:
+@lisp
+(define welcome-pamda-file
+ (scheme-file
+ "welcome-pamda-file"
+ #~(begin
+ (use-modules (ice-9 format))
+
+ (lambda (action handle flags options)
+ (case action
+ ;; authentication management
+ ((pam_sm_authenticate)
+ (format #t "In a working module, we would now identify you.~%"))
+ ((pam_sm_setcred)
+ (format #t "In a working module, we would now help you manage additional credentials.~%"))
+ ;; account management
+ ((pam_sm_acct_mgmt)
+ (format #t "In a working module, we would now confirm your access rights.~%"))
+ ;; password management
+ ((pam_sm_chauthtok)
+ (format #t "In a working module, we would now change your password.~%"))
+ ;; session management
+ ((pam_sm_open_session)
+ (format #t "In a working module, we would now open a session for you.~%"))
+ ((pam_sm_close_session)
+ (format #t "In a working module, we would now close your session.~%"))
+ (else
+ (format #t "In a working module, we would not know what to do about action '~s'.~%"
+ action)))
+ 'PAM_SUCCESS))))
+
+(service guile-pam-module-service-type
+ (guile-pam-module-configuration
+ (rules "optional")
+ (module welcome-pamda-file)
+ (services '("login"
+ "greetd"
+ "su"
+ "slim"
+ "gdm-password"
+ "sddm"))))
+@end lisp
+
+@c %start of fragment
+
+@deftp {Data Type} guile-pam-module-configuration
+Available @code{guile-pam-module-configuration} fields are:
+
+@table @asis
+@item @code{rules} (type: maybe-string)
+Determines how the module's return value is evaluated.
+
+@item @code{module} (type: maybe-file-like)
+A Guile-PAM pamda file or a classical PAM module.
+
+@item @code{services} (type: maybe-list-of-strings)
+List of PAM service names for which to install the module.
+
+@item @code{guile-inputs} (type: maybe-list-of-packages)
+Guile inputs available in the PAM module
+
+@item @code{foreign-library-path} (type: maybe-list-of-packages)
+Search path for shared objects and libraries.
+
+@end table
+
+@end deftp
+
+
@c %end of fragment
@node Kerberos Services
diff --git a/gnu/local.mk b/gnu/local.mk
index fac7b5973b..30551971ac 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -733,6 +733,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/networking.scm \
%D%/services/nix.scm \
%D%/services/nfs.scm \
+ %D%/services/pam.scm \
%D%/services/pam-mount.scm \
%D%/services/science.scm \
%D%/services/security.scm \
diff --git a/gnu/services/pam.scm b/gnu/services/pam.scm
new file mode 100644
index 0000000000..a242067e38
--- /dev/null
+++ b/gnu/services/pam.scm
@@ -0,0 +1,105 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Felix Lechner <felix.lechner@lease-up.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services pam)
+ #:use-module (gnu packages guile)
+ #:use-module (gnu packages guile-xyz)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu packages mes)
+ #:use-module (gnu services)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu system pam)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (guix records)
+ #:use-module (guix utils)
+ #:use-module (srfi srfi-1)
+ #:export (guile-pam-module-configuration))
+
+(define-maybe string)
+(define-maybe list-of-strings)
+(define-maybe file-like)
+
+(define-maybe string-or-file-like)
+(define (string-or-file-like? val)
+ (or (string? val) (file-like? val)))
+
+(define-maybe list-of-packages)
+(define (list-of-packages? val)
+ (and (list? val) (map package? val)))
+
+(define-configuration/no-serialization guile-pam-module-configuration
+ (rules
+ maybe-string
+ "Determines how the module's return value is evaluated.")
+ (module
+ maybe-file-like
+ "A Guile-PAM pamda file or a classical PAM module.")
+ (services
+ maybe-list-of-strings
+ "List of PAM service names for which to install the module.")
+ (guile-inputs
+ maybe-list-of-packages
+ "Guile inputs available in the PAM module")
+ (foreign-library-path
+ maybe-list-of-packages
+ "Search path for shared objects and libraries.") )
+
+(define (guile-pam-module-service config)
+ "Return a list of <shepherd-service> for guile-pam-module for CONFIG."
+ (match-record
+ config <guile-pam-module-configuration> (foreign-library-path
+ guile-inputs
+ module
+ rules
+ services)
+ (list
+ (pam-extension
+ (transformer
+ (lambda (pam)
+ (if (member (pam-service-name pam) services)
+ (let* ((new-entry
+ (pam-entry
+ (control rules)
+ (module module)
+ (guile-inputs (if (eq? %unset-value guile-inputs)
+ '()
+ guile-inputs))
+ (foreign-library-path (if (eq? %unset-value foreign-library-path)
+ '()
+ foreign-library-path)))))
+ (pam-service
+ (inherit pam)
+ (auth (append (pam-service-auth pam)
+ (list new-entry)))
+ (account (append (pam-service-account pam)
+ (list new-entry)))
+ (session (append (pam-service-session pam)
+ (list new-entry)))
+ (password (append (pam-service-password pam)
+ (list new-entry)))))
+ pam)))))))
+
+(define-public guile-pam-module-service-type
+ (service-type
+ (name 'guile-pam-module)
+ (extensions (list (service-extension pam-root-service-type
+ guile-pam-module-service)))
+ (compose concatenate)
+ (default-value (guile-pam-module-configuration))
+ (description "Load Guile code as part of Linux-PAM.")))
--
2.45.2
^ permalink raw reply related [flat|nested] 6+ messages in thread