gnu: Move helper code to (gnu system …) modules.

* gnu/packages/grub.scm (<menu-entry>, grub-configuration-file): Move
  to...
* gnu/system/grub.scm: ... here.  New file.
* gnu/packages/linux.scm (<pam-service>, <pam-entry>,
  pam-service->configuration, pam-service->directory,
  %pam-other-services, unix-pam-service): Move to...
* gnu/system/linux.scm: ... here.  New file.
* gnu/system/vm.scm (passwd-file): Move to...
* gnu/system/shadow.scm: ... here.  New file.
* gnu-system.am (GNU_SYSTEM_MODULES): Add
  gnu/system/{grub,linux,shadow}.scm.

4 files changed, 292 insertions, 27 deletions

diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
new file mode 100644
index 0000000000..695a044bfa
--- /dev/null
+++ b/gnu/system/grub.scm
@@ -0,0 +1,84 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system grub)
+  #:use-module (guix store)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (menu-entry
+            menu-entry?
+            grub-configuration-file))
+
+;;; Commentary:
+;;;
+;;; Configuration of GNU GRUB.
+;;;
+;;; Code:
+
+(define-record-type* <menu-entry>
+  menu-entry make-menu-entry
+  menu-entry?
+  (label           menu-entry-label)
+  (linux           menu-entry-linux)
+  (linux-arguments menu-entry-linux-arguments
+                   (default '()))
+  (initrd          menu-entry-initrd))
+
+(define* (grub-configuration-file store entries
+                                  #:key (default-entry 1) (timeout 5)
+                                  (system (%current-system)))
+  "Return the GRUB configuration file in STORE for ENTRIES, a list of
+<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
+  (define prologue
+    (format #f "
+set default=~a
+set timeout=~a
+search.file ~a~%"
+            default-entry timeout
+            (any (match-lambda
+                  (($ <menu-entry> _ linux)
+                   (let* ((drv (package-derivation store linux system))
+                          (out (derivation-path->output-path drv)))
+                     (string-append out "/bzImage"))))
+                 entries)))
+
+  (define entry->text
+    (match-lambda
+     (($ <menu-entry> label linux arguments initrd)
+      (let ((linux-drv  (package-derivation store linux system))
+            (initrd-drv (package-derivation store initrd system)))
+        ;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
+        (format #f "menuentry ~s {
+  linux ~a/bzImage ~a
+  initrd ~a/initrd
+}~%"
+                label
+                (derivation-path->output-path linux-drv)
+                (string-join arguments)
+                (derivation-path->output-path initrd-drv))))))
+
+  (add-text-to-store store "grub.cfg"
+                     (string-append prologue
+                                    (string-concatenate
+                                     (map entry->text entries)))
+                     '()))
+
+;;; grub.scm ends here
diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm
new file mode 100644
index 0000000000..b2daa13e06
--- /dev/null
+++ b/gnu/system/linux.scm
@@ -0,0 +1,145 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system linux)
+  #:use-module (guix store)
+  #:use-module (guix records)
+  #:use-module (guix derivations)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module ((guix utils) #:select (%current-system))
+  #:export (pam-service
+            pam-entry
+            pam-services->directory
+            %pam-other-services
+            unix-pam-service))
+
+;;; Commentary:
+;;;
+;;; Configuration of Linux-related things, including pluggable authentication
+;;; modules (PAM).
+;;;
+;;; Code:
+
+;; PAM services (see
+;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
+(define-record-type* <pam-service> pam-service
+  make-pam-service
+  pam-service?
+  (name       pam-service-name)                   ; string
+
+  ;; The four "management groups".
+  (account    pam-service-account                 ; list of <pam-entry>
+              (default '()))
+  (auth       pam-service-auth
+              (default '()))
+  (password   pam-service-password
+              (default '()))
+  (session    pam-service-session
+              (default '())))
+
+(define-record-type* <pam-entry> pam-entry
+  make-pam-entry
+  pam-entry?
+  (control    pam-entry-control)                  ; string
+  (module     pam-entry-module)                   ; file name
+  (arguments  pam-entry-arguments                 ; list of strings
+              (default '())))
+
+(define (pam-service->configuration service)
+  "Return the configuration string for SERVICE, to be dumped in
+/etc/pam.d/NAME, where NAME is the name of SERVICE."
+  (define (entry->string type entry)
+    (match entry
+      (($ <pam-entry> control module (arguments ...))
+       (string-append type "  "
+                      control " " module " "
+                      (string-join arguments)
+                      "\n"))))
+
+  (match service
+    (($ <pam-service> name account auth password session)
+     (string-concatenate
+      (append (map (cut entry->string "account" <>) account)
+              (map (cut entry->string "auth" <>) auth)
+              (map (cut entry->string "password" <>) password)
+              (map (cut entry->string "session" <>) session))))))
+
+(define (pam-services->directory store services)
+  "Return the derivation to build the configuration directory to be used as
+/etc/pam.d for SERVICES."
+  (let ((names (map pam-service-name services))
+        (files (map (match-lambda
+                     ((and service ($ <pam-service> name))
+                      (let ((config (pam-service->configuration service)))
+                        (add-text-to-store store
+                                           (string-append name ".pam")
+                                           config '()))))
+                    services)))
+    (define builder
+      '(begin
+         (use-modules (ice-9 match))
+
+         (let ((out (assoc-ref %outputs "out")))
+           (mkdir out)
+           (for-each (match-lambda
+                      ((name . file)
+                       (symlink file (string-append out "/" name))))
+                     %build-inputs)
+           #t)))
+
+    (build-expression->derivation store "pam.d" (%current-system)
+                                  builder
+                                  (zip names files))))
+
+(define %pam-other-services
+  ;; The "other" PAM configuration, which denies everything (see
+  ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
+  (let ((deny (pam-entry
+               (control "required")
+               (module "pam_deny.so"))))
+    (pam-service
+     (name "other")
+     (account (list deny))
+     (auth (list deny))
+     (password (list deny))
+     (session (list deny)))))
+
+(define unix-pam-service
+  (let ((unix (pam-entry
+               (control "required")
+               (module "pam_unix.so"))))
+    (lambda* (name #:key allow-empty-passwords?)
+      "Return a standard Unix-style PAM service for NAME.  When
+ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords."
+      ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
+      (let ((name* name))
+        (pam-service
+         (name name*)
+         (account (list unix))
+         (auth (list (if allow-empty-passwords?
+                         (pam-entry
+                          (control "required")
+                          (module "pam_unix.so")
+                          (arguments '("nullok")))
+                         unix)))
+         (password (list unix))
+         (session (list unix)))))))
+
+;;; linux.scm ends here
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
new file mode 100644
index 0000000000..71f8e0d771
--- /dev/null
+++ b/gnu/system/shadow.scm
@@ -0,0 +1,57 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system shadow)
+  #:use-module (guix store)
+  #:use-module (ice-9 match)
+  #:export (passwd-file))
+
+;;; Commentary:
+;;;
+;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.)
+;;;
+;;; Code:
+
+(define* (passwd-file store accounts #:key shadow?)
+  "Return a password file for ACCOUNTS, a list of vectors as returned by
+'getpwnam'.  If SHADOW? is true, then it is a /etc/shadow file, otherwise it
+is a /etc/passwd file."
+  ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
+  (define contents
+    (let loop ((accounts accounts)
+               (result   '()))
+      (match accounts
+        ((#(name pass uid gid comment home-dir shell) rest ...)
+         (loop rest
+               (cons (if shadow?
+                         (string-append name
+                                        ":"       ; XXX: use (crypt PASS …)?
+                                        ":::::::")
+                         (string-append name
+                                        ":" "x"
+                                        ":" (number->string uid)
+                                        ":" (number->string gid)
+                                        ":" comment ":" home-dir ":" shell))
+                     result)))
+        (()
+         (string-join (reverse result) "\n" 'suffix)))))
+
+  (add-text-to-store store (if shadow? "shadow" "passwd")
+                     contents '()))
+
+;;; shadow.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 6886e67c21..192ed1d5a3 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -34,9 +34,15 @@
   #:use-module ((gnu packages make-bootstrap)
                 #:select (%guile-static-stripped))
   #:use-module (gnu packages system)
+
+  #:use-module (gnu system shadow)
+  #:use-module (gnu system linux)
+  #:use-module (gnu system grub)
+
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
+
   #:export (expression->derivation-in-linux-vm
             qemu-image
             system-qemu-image))
@@ -346,33 +352,6 @@ It can be used to provide additional files, such as /etc files."
 ;;; Stand-alone VM image.
 ;;;
 
-(define* (passwd-file store accounts #:key shadow?)
-  "Return a password file for ACCOUNTS, a list of vectors as returned by
-'getpwnam'.  If SHADOW? is true, then it is a /etc/shadow file, otherwise it
-is a /etc/passwd file."
-  ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
-  (define contents
-    (let loop ((accounts accounts)
-               (result   '()))
-      (match accounts
-        ((#(name pass uid gid comment home-dir shell) rest ...)
-         (loop rest
-               (cons (if shadow?
-                         (string-append name
-                                        ":"       ; XXX: use (crypt PASS …)?
-                                        ":::::::")
-                         (string-append name
-                                        ":" "x"
-                                        ":" (number->string uid)
-                                        ":" (number->string gid)
-                                        ":" comment ":" home-dir ":" shell))
-                     result)))
-        (()
-         (string-join (reverse result) "\n" 'suffix)))))
-
-  (add-text-to-store store (if shadow? "shadow" "passwd")
-                     contents '()))
-
 (define (system-qemu-image store)
   "Return the derivation of a QEMU image of the GNU system."
   (define %pam-services