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.

2 files changed, 2 insertions, 178 deletions

diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm
index 71c4fad781..8c981bf88d 100644
--- a/gnu/packages/grub.scm
+++ b/gnu/packages/grub.scm
@@ -19,9 +19,6 @@
 (define-module (gnu packages grub)
   #:use-module (guix download)
   #:use-module (guix packages)
-  #:use-module (guix records)
-  #:use-module (guix store)
-  #:use-module (guix derivations)
   #:use-module ((guix licenses) #:select (gpl3+))
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages)
@@ -33,11 +30,7 @@
   #:use-module (gnu packages qemu)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages cdrom)
-  #:use-module (srfi srfi-1)
-  #:use-module (ice-9 match)
-  #:export (menu-entry
-            menu-entry?
-            grub-configuration-file))
+  #:use-module (srfi srfi-1))
 
 (define qemu-for-tests
   ;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown'
@@ -117,56 +110,3 @@ computer starts.  It is responsible for loading and transferring control to
 the operating system kernel software (such as the Hurd or the Linux).  The
 kernel, in turn, initializes the rest of the operating system (e.g., GNU).")
     (license gpl3+)))
-
-
-;;;
-;;; Configuration.
-;;;
-
-(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)))
-                     '()))
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index a479d791b6..38bff72933 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -32,18 +32,7 @@
   #:use-module (gnu packages algebra)
   #:use-module (guix packages)
   #:use-module (guix download)
-  #:use-module (guix build-system gnu)
-  #:use-module (guix store)
-  #:use-module (guix derivations)
-  #:use-module (guix records)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 match)
-  #:export (pam-service
-            pam-entry
-            pam-services->directory
-            %pam-other-services
-            unix-pam-service))
+  #:use-module (guix build-system gnu))
 
 (define-public (system->linux-architecture arch)
   "Return the Linux architecture name for ARCH, a Guix system name such as
@@ -271,111 +260,6 @@ be used through the PAM API to perform tasks, like authenticating a user
 at login.  Local and dynamic reconfiguration are its key features")
     (license bsd-3)))
 
-;; 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)))))))
-
 
 ;;;
 ;;; Miscellaneous.