Subject: bug#27155: [PATCH 2/2] system: pam: Remove custom API to transform PAM services.

From: Ludovic Courtès <[email-masked]>
Date: Wed, 31 May 2017 00:05:09 +0200

This specific way to extend 'pam-root-service-type' has been subsumed by
the "finalization extensions" of services.

* gnu/system/pam.scm (<pam-configuration>): Remove.
(/etc-entry): Adjust accordingly.
(extend-configuration): Remove.
(pam-root-service-type)[extend]: Set to 'append'.
(pam-root-service): Remove #:transform parameter.  Adjust 'service'
form.
* gnu/services/desktop.scm (pam-extension-procedure): Rename to...
(elogind-pam-extension): ... this.  Expect the complete list of
services and map over it.
(elogind-service-type): Change PAM-ROOT-SERVICE-TYPE extension to refer
to 'elogind-pam-extension'.
* gnu/services/base.scm (limits-pam-extension): New procedure.
(pam-limits-service-type): Remove 'pam-extension' procedure.  Adjust
PAM-ROOT-SERVICE-TYPE extension accordingly.
---
 gnu/services/base.scm    | 33 ++++++++++++++++++---------------
 gnu/services/desktop.scm | 23 ++++++++++++-----------
 gnu/system/pam.scm       | 44 ++++++++------------------------------------
 3 files changed, 38 insertions(+), 62 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 7cd9a34ca..d36f5c410 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1239,6 +1239,21 @@ information on the configuration file syntax."
   (service syslog-service-type config))

+(define (limits-pam-extension limits-file pam-services)
+  "Modify some of PAM-SERVICES to use 'pam_limits.so'."
+  (map (lambda (pam)
+         (let ((pam-limits (pam-entry
+                            (control "required")
+                            (module "pam_limits.so")
+                            (arguments '("conf=/etc/security/limits.conf")))))
+           (if (member (pam-service-name pam) '("login" "su" "slim"))
+               (pam-service
+                (inherit pam)
+                (session (cons pam-limits
+                               (pam-service-session pam))))
+               pam)))
+       pam-services))
+
 (define pam-limits-service-type
   (let ((security-limits
          ;; Create /etc/security containing the provided "limits.conf" file.
@@ -1250,26 +1265,14 @@ information on the configuration file syntax."
                     (mkdir #$output)
                     (stat #$limits-file)
                     (symlink #$limits-file
-                             (string-append #$output "/limits.conf"))))))))
-        (pam-extension
-         (lambda (pam)
-           (let ((pam-limits (pam-entry
-                              (control "required")
-                              (module "pam_limits.so")
-                              (arguments '("conf=/etc/security/limits.conf")))))
-             (if (member (pam-service-name pam)
-                         '("login" "su" "slim"))
-                 (pam-service
-                  (inherit pam)
-                  (session (cons pam-limits
-                                 (pam-service-session pam))))
-                 pam)))))
+                             (string-append #$output "/limits.conf")))))))))
     (service-type
      (name 'limits)
      (extensions
       (list (service-extension etc-service-type security-limits)
             (service-extension pam-root-service-type
-                               (lambda _ (list pam-extension))))))))
+                               (const '())
+                               limits-pam-extension))))))
 
 (define* (pam-limits-service #:optional (limits '()))
   "Return a service that makes selected programs respect the list of
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 36049587d..6495bc94c 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2015 Andy Wingo <[email-masked]>
 ;;; Copyright © 2015 Mark H Weaver <[email-masked]>
 ;;; Copyright © 2016 Sou Bunnbu <[email-masked]>
@@ -637,21 +637,21 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
                               "ELOGIND_CONF_FILE"
                               (elogind-configuration-file config))))
 
-(define (pam-extension-procedure config)
-  "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
-services use 'pam_elogind.so', a module that allows elogind to keep track of
-logged-in users (run 'loginctl' to see elogind's world view of users and
-seats.)"
+(define (elogind-pam-extension config pam-services)
+  "Change PAM-SERVICES so that each of them uses 'pam_elogind.so', a module
+that allows elogind to keep track of logged-in users (run 'loginctl' to see
+elogind's world view of users and seats), and return that."
   (define pam-elogind
     (pam-entry
      (control "required")
      (module (file-append (elogind-package config)
                           "/lib/security/pam_elogind.so"))))
 
-  (list (lambda (pam)
-          (pam-service
-           (inherit pam)
-           (session (cons pam-elogind (pam-service-session pam)))))))
+  (map (lambda (pam)
+         (pam-service
+          (inherit pam)
+          (session (cons pam-elogind (pam-service-session pam)))))
+       pam-services))
 
 (define elogind-service-type
   (service-type (name 'elogind)
@@ -669,7 +669,8 @@ seats.)"
 
                        ;; Extend PAM with pam_elogind.so.
                        (service-extension pam-root-service-type
-                                          pam-extension-procedure)
+                                          (const '())
+                                          elogind-pam-extension)
 
                        ;; We need /run/user, /run/systemd, etc.
                        (service-extension file-system-service-type
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index eedf93394..b1bfab7ba 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -281,50 +281,22 @@ authenticate to run COMMAND."
 ;;; PAM root service.
 ;;;
 
-;; 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)
+(define (/etc-entry services)
   "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)))))
+  `(("pam.d" ,(pam-services->directory services))))
 
 (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.
+                ;; Arguments are <pam-service> objects.
                 (compose concatenate)
-                (extend extend-configuration)))
+                (extend append)))
 
-(define* (pam-root-service base #:key (transform identity))
+(define* (pam-root-service base)
   "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
-<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))))
+them into a /etc/pam.d directory, including the <pam-service> listed in BASE."
+  (service pam-root-service-type base))

-- 
2.13.0