Package: guix-patches;
Reported by: Felix Lechner <felix.lechner <at> lease-up.com>
Date: Fri, 26 Jul 2024 22:03:02 UTC
Severity: normal
Tags: patch
View this message in rfc822 format
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 72316 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com>, Florian Pelz <pelzflorian <at> pelzflorian.de>, Ludovic Courtès <ludo <at> gnu.org>, Matthew Trzcinski <matt <at> excalamus.com>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [bug#72316] [PATCH 3/3] Add a guile-pam-module service. Date: Fri, 26 Jul 2024 15:39:13 -0700
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 <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.