diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/grub.scm | 84 | ||||
| -rw-r--r-- | gnu/system/linux.scm | 145 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 57 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 33 |
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 |