unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#72316] [PATCH 0/3] Switch to Guile-PAM.
@ 2024-07-26 22:01 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
                   ` (2 more replies)
  0 siblings, 3 replies; 6+ messages in thread
From: Felix Lechner via Guix-patches via @ 2024-07-26 22:01 UTC (permalink / raw)
  To: 72316
  Cc: Felix Lechner, Florian Pelz, Ludovic Courtès,
	Matthew Trzcinski, Maxim Cournoyer

Guile-PAM reimplements the PAM stack in GNU Guile and allows system
administrators to write modules in GNU Guile.

This patch series switches Guix System to Guile-PAM.  It relies on the shared
objects from Linux-PAM until Guile implementations are available.

In Guix, Guile-PAM could start Shepherd's user services or keep track of login
sessions similar to pam_systemd.so.

The guile-pam package ships with a detailed Texinfo manual.

The software is in alpha stage.  For example, the interaction with sddm was
not well-tested.  Please let me know how it goes---private email is okay!

Kind regards
Felix


Felix Lechner (3):
  Add guile-pam.
  Switch to Guile-PAM.
  Add a guile-pam-module service.

 doc/guix.texi                   |  89 ++++++++++
 gnu/local.mk                    |   1 +
 gnu/packages/linux.scm          |  56 ++++++
 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/pam.scm            | 105 +++++++++++
 gnu/services/sddm.scm           |  91 +++++++---
 gnu/services/xorg.scm           |  17 +-
 gnu/system/pam.scm              | 296 ++++++++++++++++++++++++++------
 13 files changed, 671 insertions(+), 109 deletions(-)
 create mode 100644 gnu/services/pam.scm


base-commit: 862a9b5b25966845f71d218ad8c0c5655ffc479a
-- 
2.45.2





^ permalink raw reply	[flat|nested] 6+ messages in thread

* [bug#72316] [PATCH 1/3] Add 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 ` 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 ` [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, Leo Famulari, Wilko Meyer

Change-Id: I991ca32c8696de0e6751b0f4225bf24151ba22f2
---
 gnu/packages/linux.scm | 56 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)

diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index f36d0fc9ee..7b5f549584 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -112,6 +112,7 @@ (define-module (gnu packages linux)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages bison)
   #:use-module (gnu packages boost)
+  #:use-module (gnu packages build-tools)
   #:use-module (gnu packages calendar)
   #:use-module (gnu packages check)
   #:use-module (gnu packages cpio)
@@ -145,6 +146,7 @@ (define-module (gnu packages linux)
   #:use-module (gnu packages graphviz)
   #:use-module (gnu packages gstreamer)
   #:use-module (gnu packages gtk)
+  #:use-module (gnu packages guile)
   #:use-module (gnu packages haskell-apps)
   #:use-module (gnu packages haskell-xyz)
   #:use-module (gnu packages image)
@@ -157,6 +159,7 @@ (define-module (gnu packages linux)
   #:use-module (gnu packages m4)
   #:use-module (gnu packages man)
   #:use-module (gnu packages maths)
+  #:use-module (gnu packages mes)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages netpbm)
@@ -1917,6 +1920,59 @@ (define-public vendor-reset-linux-module
 ;;; Pluggable authentication modules (PAM).
 ;;;
 
+(define-public guile-pam
+  (let ((commit "7eba489fbc56b72de5e4bd77d7c99816434b5178")
+        (revision "0"))
+    (package
+      (name "guile-pam")
+      (version (git-version "0.0" revision commit))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "https://codeberg.org/lechner/guile-pam")
+                      (commit commit)))
+                (file-name (git-file-name name version))
+                (sha256
+                 (base32
+                  "149cmgif05wcp4zgkkr2gp93djr44qiv71ih2b2d633vnj1mbayb"))))
+      (native-inputs (list
+                      autoconf
+                      automake
+                      gnulib
+                      guile-3.0
+                      libtool
+                      linux-pam
+                      nyacc
+                      pkg-config
+                      texinfo))
+      (inputs (list
+               guile-3.0
+               linux-pam))
+      (propagated-inputs (list
+                          nyacc))
+      (build-system gnu-build-system)
+      (arguments
+       (list
+        #:phases
+        #~(modify-phases %standard-phases
+            (add-after 'unpack 'install-gnulib
+              ;; per https://lists.gnu.org/archive/html/guile-devel/2012-08/msg00042.html
+              (lambda* (#:key inputs #:allow-other-keys)
+                (let ((build-aux (dirname (search-input-file inputs "/src/gnulib/build-aux/config.rpath"))))
+                  (mkdir-p "build-aux")
+                  (copy-recursively build-aux "build-aux"))
+                (let ((m4 (dirname (search-input-file inputs "/src/gnulib/m4/lib-link.m4"))))
+                  (mkdir-p "m4")
+                  (copy-recursively m4 "m4")))))))
+      (home-page "https://codeberg.org/lechner/guile-pam")
+      (synopsis "Write your Linux-PAM authentication logic in Guile Scheme")
+      (description
+       "Guile-PAM provides a way to rewrite your authentication logic in the
+Linux PAM (pluggable authentication modules) in Guile Scheme. It should make
+those modules more transparent to the administrator and more intuitive to
+use.")
+      (license license:gpl3+))))
+
 (define-public linux-pam
   (package
     (name "linux-pam")
-- 
2.45.2





^ permalink raw reply related	[flat|nested] 6+ messages in thread

* [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

* [bug#72316] [PATCH 3/3] Add a guile-pam-module service.
  2024-07-26 22:39 ` [bug#72316] [PATCH 3/3] Add a guile-pam-module service Felix Lechner via Guix-patches via
@ 2024-07-29 10:22   ` pelzflorian (Florian Pelz)
  2024-07-30 17:00     ` Felix Lechner via Guix-patches via
  0 siblings, 1 reply; 6+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-07-29 10:22 UTC (permalink / raw)
  To: Felix Lechner
  Cc: 72316, Ludovic Courtès, Maxim Cournoyer, Matthew Trzcinski

Hi Felix.  I don’t know linux-pam much but had been wary of its design,
but now that I started reading your guile-pam info manual, it is less of
a riddle.

By the way, guile-pam docs reference guile-wtut, which presumably
should be guile-tut without w.

About this doc/guix.texi addition, it is okay in my opinion, but it
would be better giving one or two functional examples rather than only
calling the (format) procedure.  This would showcase to the
uninitiated what PAM can do and how it looks in Guile.

> +  (foreign-library-path
> +   maybe-list-of-packages
> +   "Search path for shared objects and libraries.") )
> […]
> +                        (foreign-library-path (if (eq? %unset-value foreign-library-path)
> +                                                  '()
> +                                                  foreign-library-path)))))

It is repetitive that foreign-library-path must be set now everywhere
for non-guile pam modules.  Even though a foreign-library-path is not
always needed, would it be better to always set it as default even when
unneeded, then patch 2/3 “Switch to Guile-PAM.” could be dropped?

Disclaimer; I do not know PAM.  I may well be wrong.

Regards,
Florian




^ permalink raw reply	[flat|nested] 6+ messages in thread

* [bug#72316] [PATCH 3/3] Add a guile-pam-module service.
  2024-07-29 10:22   ` pelzflorian (Florian Pelz)
@ 2024-07-30 17:00     ` Felix Lechner via Guix-patches via
  0 siblings, 0 replies; 6+ messages in thread
From: Felix Lechner via Guix-patches via @ 2024-07-30 17:00 UTC (permalink / raw)
  To: pelzflorian (Florian Pelz)
  Cc: 72316, Ludovic Courtès, Maxim Cournoyer, Matthew Trzcinski

Hi Florian,

On Mon, Jul 29 2024, pelzflorian (Florian Pelz) wrote:

> guile-pam docs reference guile-wtut, which presumably should be
> guile-tut without w.

Thank you for your review!

A baby has been typing extra letters.  The typo was fixed.  You were
credited in the commit message. [1]

> About this doc/guix.texi addition [...] it would be better giving one
> or two functional examples rather than only calling the (format)
> procedure.  This would showcase to the uninitiated what PAM can do and
> how it looks in Guile.

I personally think that it would turn off new readers.

Guix System configures PAM already.  Only people hoping to accomplish
something non-standard will look into Guile-PAM.  Unfortunately, those
readers have little in common.  That's why I illustrated the way
Guile-PAM works with a simple example.

You are now saying we should instead solve a specialist case, but I
believe that's likely to distract the diverse group of readers by
drawing too much attention to what the module does, as opposed to how
Guile-PAM works.

The example was supposed to draw readers to Guile-PAM's Texinfo manual,
which I mentioned nearby.  Should we strike the example instead?

> It is repetitive that foreign-library-path must be set now everywhere
> for non-guile pam modules.

The foreign-library-path only looks repetitive.  It is the absolute path
to each module.  The modules just happen to be in the same place.

Guix traditionally relied on a special feature in Linux-PAM: One can use
absolute paths but, as many long-timer Guixers know, that is likely to
cause stability issues.

Guile-PAM solves that issue for Guix by separating the load path so a
running process won't reload a newer version of the same shared object.
Since the change has a logic to it, I have trouble relating to your
observation that the load paths look repetitive.

Please note that the foreign-library-path isn't actually needed for
modules that ship with Linux-PAM.  The Linux-PAM load path is added by
default near the comment regarding "courtesy for historical usage" in
the patch.  It is being offered only for user customizations of the
operating-system record, however, and may go away.

The right thing is always list the load path for a module.  That is what
the patch does.

> Even though a foreign-library-path is not always needed, would it be
> better to always set it as default even when unneeded

As I hoped to explain above, the load path is always needed.  In my
estimation, is not better to offer a default even though I did so for
the time being in the interest of a smooth transition.

Ultimately, the matter rests with the Guix maintainers.  They will (or
will not) decide if, when, and how to offer Guile-PAM to their users.

Because Guile-PAM is a new and lightly tested package that strives to
become an integral part of every Guix system, the decision will likely
involve a lot more questions than the ones you and I are discussing in
this thread here.

At the same time, Guile-PAM is only 541 lines of code (in Scheme, not
counting the examples) so maybe someone will get around to taking a
look.

> then patch 2/3 “Switch to Guile-PAM.” could be dropped?

No, the patch does other things.  It switches all PAM configurations
from Linux-PAM to Guile-PAM.  The configured system will use Guile-PAM's
stack implementation.

Guile-PAM should be attractive to Guix for several reasons.  One is that
it may simplify Guix's existing PAM machinery, which is complex, because
the same things can be accomplished better with quoted S-expressions (or
G-expressions, depending on the context).

There are also philosophical considerations which I hope will encourage
Guix to adopt Guile-PAM.  The code is short, written in Scheme, and
licensed under the GPL.

> Disclaimer; I do not know PAM.  I may well be wrong.

No worries, please, and thanks again for your review.  Linux-PAM is
arcane and complicated.  I wrote Guile-PAM for you!

Kind regards
Felix

[1] https://codeberg.org/lechner/guile-pam/commit/2f0f20a0a44f7672bfd93470c0562d19eb8ec511




^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2024-07-30 17:02 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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 ` [bug#72316] [PATCH 3/3] Add a guile-pam-module service Felix Lechner via Guix-patches via
2024-07-29 10:22   ` pelzflorian (Florian Pelz)
2024-07-30 17:00     ` Felix Lechner via Guix-patches via

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).