diff --git a/gnu-system.am b/gnu-system.am
index a5000bcdfe1082f1f3503a899f2c23f2948d8a8a..d88f6bf4e842f58217b3641d04be0f1c0d105447 100644
--- a/gnu-system.am
+++ b/gnu-system.am
@@ -179,6 +179,10 @@ GNU_SYSTEM_MODULES = \
gnu/packages/yasm.scm \
gnu/packages/zile.scm \
gnu/packages/zip.scm \
+ \
+ gnu/system/grub.scm \
+ gnu/system/linux.scm \
+ gnu/system/shadow.scm \
gnu/system/vm.scm
patchdir = $(guilemoduledir)/gnu/packages/patches
diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm
index 71c4fad7813674e56c8053d78eaca596a15be7da..8c981bf88dbc745757595729ccb8014cf0fcf114 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 @@ (define-module (gnu packages grub)
#: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 @@ (define-public grub
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 a479d791b64ec56d619456174dc45fd339aa8870..38bff72933e3947aa2ada82265e9be1a0f72d047 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -32,18 +32,7 @@ (define-module (gnu packages linux)
#: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 @@ (define-public linux-pam
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.
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
new file mode 100644
index 0000000000000000000000000000000000000000..695a044bfa1b2b2c96a5eab2e2a23caf4a8c005d
--- /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 0000000000000000000000000000000000000000..b2daa13e066f552e0bf716a68dc338edc103dd96
--- /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 0000000000000000000000000000000000000000..71f8e0d77113509dbf16cba3e948e147e9de6728
--- /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 6886e67c21456fd61a7ab71d274b6564f7449fcb..192ed1d5a3533156f80b7d9fb6e1086b15a44f58 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -34,9 +34,15 @@ (define-module (gnu system vm)
#: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 @@ (define (graph-from-file file)
;;; 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