[bug#72316] [PATCH v2 2/3] Add a guile-pam-module service.

[Z572]

Felix Lechner via Guix-patches via <guix-patches@gnu.org> writes:

> 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 90d90b2e1eb..11480cb0ae5 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -412,6 +412,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.
> @@ -19437,6 +19438,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.
> @@ -33149,6 +33151,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 f6f95bbf10b..3d3da58d659 100644
> --- a/gnu/local.mk
> +++ b/gnu/local.mk
> @@ -764,6 +764,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/power.scm                     \
>    %D%/services/science.scm                   \
> diff --git a/gnu/services/pam.scm b/gnu/services/pam.scm
> new file mode 100644
> index 00000000000..a242067e380
> --- /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)))

i think should use (@ (srfi srfi-1) every), not map, otherwise this has
always been #t. And should use `file-like?', friendly to inferior packages.

> +
> +(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")

If I understand correctly, all guile-pam-modules share the same
pam_guile and dependencies, can we restrict this so that each different
pam-module is its own separate dependency

(If possible in the future, I would even like to compile each of them to
wasm separately, limiting the capabilities even more.)

> +  (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))

looks like this patch depends on https://issues.guix.gnu.org/72316#10 ?.

I think it may not be possible to merge directly

> +                        (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.")))

signature.asc
Description: PGP signature