05/07: gnu: Allow OS configurations to add PAM session modules

[Andy Wingo]

wingo pushed a commit to branch wip-pam-elogind
in repository guix.

commit 3b26f6ea8bdde7e3e867f10e9ca41a05b4662375
Author: Andy Wingo <address@hidden>
Date:   Tue Aug 18 10:22:16 2015 +0200

    gnu: Allow OS configurations to add PAM session modules
    
    * gnu/services/base.scm (mingetty-service):
    * gnu/services/xorg.scm (slim-service):
    * gnu/services/ssh.scm (lsh-service):
    * gnu/system/linux.scm (unix-pam-service, base-pam-services): Add
      #:additional-session-modules keyword argument.
---
 gnu/services/base.scm |    6 ++++--
 gnu/services/ssh.scm  |    6 ++++--
 gnu/services/xorg.scm |    6 ++++--
 gnu/system/linux.scm  |   27 ++++++++++++++++-----------
 4 files changed, 28 insertions(+), 17 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 888e446..60dc93b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -364,7 +364,8 @@ stopped before 'kill' is called."
                            ;; Allow empty passwords by default so that
                            ;; first-time users can log in when the 'root'
                            ;; account has just been created.
-                           (allow-empty-passwords? #t))
+                           (allow-empty-passwords? #t)
+                           (additional-session-modules '()))
   "Return a service to run mingetty on @var{tty}.
 
 When @var{allow-empty-passwords?} is true, allow empty log-in password.  When
@@ -416,7 +417,8 @@ the ``message of the day''."
        ;; duplicates are removed.
        (list (unix-pam-service "login"
                                #:allow-empty-passwords? allow-empty-passwords?
-                               #:motd motd)))))))
+                               #:motd motd
+                               #:additional-session-modules 
additional-session-modules)))))))
 
 (define-record-type* <nscd-configuration> nscd-configuration
   make-nscd-configuration
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index e2f8542..15e4052 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -86,7 +86,8 @@
                       (tcp/ip-forwarding? #t)
                       (password-authentication? #t)
                       (public-key-authentication? #t)
-                      (initialize? #t))
+                      (initialize? #t)
+                      (additional-session-modules '()))
   "Run the @command{lshd} program from @var{lsh} to listen on port 
@var{port-number}.
 @var{host-key} must designate a file containing the host key, and readable
 only by root.
@@ -162,7 +163,8 @@ The other options should be self-descriptive."
              (pam-services
               (list (unix-pam-service
                      "lshd"
-                     #:allow-empty-passwords? allow-empty-passwords?)))
+                     #:allow-empty-passwords? allow-empty-passwords?
+                     #:additional-session-modules additional-session-modules)))
              (activate #~(begin
                            (use-modules (guix build utils))
                            (mkdir-p "/var/spool/lsh")
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 9ee8817..71bbb32 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -224,7 +224,8 @@ which should be passed to this script as the first 
argument.  If not, the
                        (xauth xauth) (dmd dmd) (bash bash)
                        (auto-login-session #~(string-append #$windowmaker
                                                             "/bin/wmaker"))
-                       startx)
+                       startx
+                       (additional-session-modules '()))
   "Return a service that spawns the SLiM graphical login manager, which in
 turn starts the X display server with @var{startx}, a command as returned by
 @code{xorg-start-command}.
@@ -305,6 +306,7 @@ reboot_cmd " dmd "/sbin/reboot
        ;; Tell PAM about 'slim'.
        (list (unix-pam-service
               "slim"
-              #:allow-empty-passwords? allow-empty-passwords?)))))))
+              #:allow-empty-passwords? allow-empty-passwords?
+              #:additional-session-modules additional-session-modules)))))))
 
 ;;; xorg.scm ends here
diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm
index 7461a4a..1656862 100644
--- a/gnu/system/linux.scm
+++ b/gnu/system/linux.scm
@@ -133,7 +133,8 @@ dumped in /etc/pam.d/NAME, where NAME is the name of 
SERVICE."
   (let ((unix (pam-entry
                (control "required")
                (module "pam_unix.so"))))
-    (lambda* (name #:key allow-empty-passwords? motd)
+    (lambda* (name #:key allow-empty-passwords? motd
+                   (additional-session-modules '()))
       "Return a standard Unix-style PAM service for NAME.  When
 ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords.  When MOTD is true, it
 should be the name of a file used as the message-of-the-day."
@@ -153,14 +154,16 @@ should be the name of a file used as the 
message-of-the-day."
                           (module "pam_unix.so")
                           ;; Store SHA-512 encrypted passwords in /etc/shadow.
                           (arguments '("sha512" "shadow")))))
-         (session (if motd
-                      (list unix
-                            (pam-entry
-                             (control "optional")
-                             (module "pam_motd.so")
-                             (arguments
-                              (list #~(string-append "motd=" #$motd)))))
-                      (list unix))))))))
+         (session (append
+                   (if motd
+                       (list unix
+                             (pam-entry
+                              (control "optional")
+                              (module "pam_motd.so")
+                              (arguments
+                               (list #~(string-append "motd=" #$motd)))))
+                       (list unix))
+                   additional-session-modules)))))))
 
 (define (rootok-pam-service command)
   "Return a PAM service for COMMAND such that 'root' does not need to
@@ -177,14 +180,16 @@ authenticate to run COMMAND."
      (password (list unix))
      (session (list unix)))))
 
-(define* (base-pam-services #:key allow-empty-passwords?)
+(define* (base-pam-services #:key allow-empty-passwords?
+                            (additional-session-modules '()))
   "Return the list of basic PAM services everyone would want."
   ;; TODO: Add other Shadow programs?
   (append (list %pam-other-services)
 
           ;; These programs are setuid-root.
           (map (cut unix-pam-service <>
-                    #:allow-empty-passwords? allow-empty-passwords?)
+                    #:allow-empty-passwords? allow-empty-passwords?
+                    #:additional-session-modules additional-session-modules)
                '("su" "passwd" "sudo"
                  "xlock" "xscreensaver"))