From 12c00bca92e3eef2b86565924bbefc39397b5497 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 6 Feb 2016 11:46:09 +0100
Subject: 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(-)

(limited to 'gnu/system')

diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index b526c95239..743039daf6 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
-- 
cgit v1.2.3