From f7d6fafaa27b11e9dcaf15f7611c62447d8532fa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 7 Dec 2013 16:18:51 +0100
Subject: [PATCH] gnu: dmd: Add 'pam-services' field to <service>.

* gnu/system/dmd.scm (<service>)[pam-services]: New field.
  (mingetty-service): Add #:motd and #:allow-empty-passwords?
  parameters.  Add MOTD to 'inputs' field; add 'pam-services' field.
* gnu/system/vm.scm (system-qemu-image): Aggregate PAM entries from
  SERVICES.
---
 gnu/system/dmd.scm | 29 +++++++++++++++++++++++------
 gnu/system/vm.scm  |  7 +++----
 2 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm
index 8e3f7e976a..df38172def 100644
--- a/gnu/system/dmd.scm
+++ b/gnu/system/dmd.scm
@@ -29,7 +29,8 @@
                 #:select (guix))
   #:use-module ((gnu packages linux)
                 #:select (net-tools))
-  #:use-module (gnu system shadow)
+  #:use-module (gnu system shadow)                ; for user accounts/groups
+  #:use-module (gnu system linux)                 ; for PAM services
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
@@ -45,6 +46,7 @@
             service-inputs
             service-user-accounts
             service-user-groups
+            service-pam-services
 
             host-name-service
             syslog-service
@@ -79,6 +81,8 @@
   (user-accounts service-user-accounts            ; list of <user-account>
                  (default '()))
   (user-groups   service-user-groups              ; list of <user-groups>
+                 (default '()))
+  (pam-services  service-pam-services             ; list of <pam-service>
                  (default '())))
 
 (define (host-name-service name)
@@ -91,9 +95,13 @@
                        (sethostname ,name)))
              (respawn? #f)))))
 
-(define (mingetty-service tty)
+(define* (mingetty-service tty
+                           #:key
+                           (motd (text-file "motd" "Welcome.\n"))
+                           (allow-empty-passwords? #t))
   "Return a service to run mingetty on TTY."
-  (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty")))
+  (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty"))
+                      (motd         motd))
     (return
      (service
       (documentation (string-append "Run mingetty on " tty "."))
@@ -103,9 +111,18 @@
       ;; service to be done.
       (requirement '(host-name))
 
-      (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty))
-      (stop  `(make-kill-destructor))
-      (inputs `(("mingetty" ,mingetty)))))))
+      (start  `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty))
+      (stop   `(make-kill-destructor))
+      (inputs `(("mingetty" ,mingetty)
+                ("motd" ,motd)))
+
+      (pam-services
+       ;; Let 'login' be known to PAM.  All the mingetty services will have
+       ;; that PAM service, but that's fine because they're all identical and
+       ;; duplicates are removed.
+       (list (unix-pam-service "login"
+                               #:allow-empty-passwords? allow-empty-passwords?
+                               #:motd motd)))))))
 
 (define* (nscd-service #:key (glibc glibc-final))
   "Return a service that runs libc's name service cache daemon (nscd)."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index e89815225e..ffbc07ee85 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -571,10 +571,9 @@ Happy birthday, GNU!                                http://www.gnu.org/gnu30
 "))
        (pam-services ->
                      ;; Services known to PAM.
-                     (list %pam-other-services
-                           (unix-pam-service "login"
-                                             #:allow-empty-passwords? #t
-                                             #:motd motd)))
+                     (delete-duplicates
+                      (cons %pam-other-services
+                            (append-map service-pam-services services))))
 
        (bash-file (package-file bash "bin/bash"))
        (dmd-file  (package-file dmd "bin/dmd"))