diff options
Diffstat (limited to 'gnu/packages')
| -rw-r--r-- | gnu/packages/grub.scm | 62 | ||||
| -rw-r--r-- | gnu/packages/linux.scm | 118 |
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. |