guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#72316] [PATCH 2/3] Switch to Guile-PAM.


From: Felix Lechner
Subject: [bug#72316] [PATCH 2/3] Switch to Guile-PAM.
Date: Fri, 26 Jul 2024 15:39:12 -0700

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






reply via email to

[Prev in Thread] Current Thread [Next in Thread]