From 12c00bca92e3eef2b86565924bbefc39397b5497 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 6 Feb 2016 11:46:09 +0100
Subject: [PATCH] system: pam: 'pam-root-service-type' can be extended with
transformations.
* gnu/system/pam.scm (<pam-configuration>): New record type.
(/etc-entry): Change 'services' parameter' to 'config'. Honor the
'transform' field of CONFIG.
(extend-configuration): New procedure.
(pam-root-service-type): Use EXTEND-CONFIGURATION as the 'extend'
field.
(pam-root-service): Add #:transform parameter. Service value is a
<pam-configuration>.
---
gnu/system/pam.scm | 44 ++++++++++++++++++++++++++++++++++++++------
1 file changed, 38 insertions(+), 6 deletions(-)
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index b526c952397..743039daf6c 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -23,6 +23,7 @@ (define-module (gnu system pam)
#:use-module (gnu services)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module ((guix utils) #:select (%current-system))
#:export (pam-service
@@ -208,19 +209,50 @@ (define* (base-pam-services #:key allow-empty-passwords?)
;;; PAM root service.
;;;
-(define (/etc-entry services)
- `(("pam.d" ,(pam-services->directory services))))
+;; Overall PAM configuration: a list of services, plus a procedure that takes
+;; one <pam-service> and returns a <pam-service>. The procedure is used to
+;; implement cross-cutting concerns such as the use of the 'elogind.so'
+;; session module that keeps track of logged-in users.
+(define-record-type* <pam-configuration>
+ pam-configuration make-pam-configuration? pam-configuration?
+ (services pam-configuration-services) ;list of <pam-service>
+ (transform pam-configuration-transform)) ;procedure
+
+(define (/etc-entry config)
+ "Return the /etc/pam.d entry corresponding to CONFIG."
+ (match config
+ (($ <pam-configuration> services transform)
+ (let ((services (map transform services)))
+ `(("pam.d" ,(pam-services->directory services)))))))
+
+(define (extend-configuration initial extensions)
+ "Extend INITIAL with NEW."
+ (let-values (((services procs)
+ (partition pam-service? extensions)))
+ (pam-configuration
+ (services (append (pam-configuration-services initial)
+ services))
+ (transform (apply compose
+ (pam-configuration-transform initial)
+ procs)))))
(define pam-root-service-type
(service-type (name 'pam)
(extensions (list (service-extension etc-service-type
/etc-entry)))
+
+ ;; Arguments include <pam-service> as well as procedures.
(compose concatenate)
- (extend append)))
+ (extend extend-configuration)))
-(define (pam-root-service base)
+(define* (pam-root-service base #:key (transform identity))
"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."
- (service pam-root-service-type base))
+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
+<pam-service>. It can be used to implement cross-cutting concerns that affect
+all the PAM services."
+ (service pam-root-service-type
+ (pam-configuration (services base)
+ (transform transform))))
;;; linux.scm ends here
--
GitLab