From b8300494c0cef32d7398aee705c9271346d0290e Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 8 Jan 2016 02:48:17 +0300 Subject: [PATCH] Move to (gnu system). * guix/scripts/system.scm (previous-grub-entries) (display-system-generation): Use accessors instead of matching . (boot-parameters, boot-parameters?, boot-parameters-label) (boot-parameters-root-device, boot-parameters-kernel) (boot-parameters-kernel-arguments, read-boot-parameters): Move to... * gnu/system.scm: ... here. Export them. --- gnu/system.scm | 41 ++++++++++++++++++++ guix/scripts/system.scm | 85 +++++++++++++---------------------------- 2 files changed, 68 insertions(+), 58 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index 4aedb7ee36..ee0280c069 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -88,6 +88,14 @@ (define-module (gnu system) operating-system-locale-directory operating-system-boot-script + boot-parameters + boot-parameters? + boot-parameters-label + boot-parameters-root-device + boot-parameters-kernel + boot-parameters-kernel-arguments + read-boot-parameters + local-host-aliases %setuid-programs %base-packages @@ -709,4 +717,37 @@ (define (operating-system-parameters-file os) #$(operating-system-kernel-arguments os)) (initrd #$initrd))))) + +;;; +;;; Boot parameters +;;; + +(define-record-type* + boot-parameters make-boot-parameters boot-parameters? + (label boot-parameters-label) + (root-device boot-parameters-root-device) + (kernel boot-parameters-kernel) + (kernel-arguments boot-parameters-kernel-arguments)) + +(define (read-boot-parameters port) + "Read boot parameters from PORT and return the corresponding + object or #f if the format is unrecognized." + (match (read port) + (('boot-parameters ('version 0) + ('label label) ('root-device root) + ('kernel linux) + rest ...) + (boot-parameters + (label label) + (root-device root) + (kernel linux) + (kernel-arguments + (match (assq 'kernel-arguments rest) + ((_ args) args) + (#f '()))))) ;the old format + (x ;unsupported format + (warning (_ "unrecognized boot parameters for '~a'~%") + system) + #f))) + ;;; system.scm ends here diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 1407dc73fa..564ed02d59 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 Ludovic Courtès +;;; Copyright © 2016 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -189,39 +190,6 @@ (define (maybe-copy to-copy) (mwhen grub? (install-grub* grub.cfg device target))))) - -;;; -;;; Boot parameters -;;; - -(define-record-type* - boot-parameters make-boot-parameters boot-parameters? - (label boot-parameters-label) - (root-device boot-parameters-root-device) - (kernel boot-parameters-kernel) - (kernel-arguments boot-parameters-kernel-arguments)) - -(define (read-boot-parameters port) - "Read boot parameters from PORT and return the corresponding - object or #f if the format is unrecognized." - (match (read port) - (('boot-parameters ('version 0) - ('label label) ('root-device root) - ('kernel linux) - rest ...) - (boot-parameters - (label label) - (root-device root) - (kernel linux) - (kernel-arguments - (match (assq 'kernel-arguments rest) - ((_ args) args) - (#f '()))))) ;the old format - (x ;unsupported format - (warning (_ "unrecognized boot parameters for '~a'~%") - system) - #f))) - ;;; ;;; Reconfiguration. @@ -285,22 +253,24 @@ (define* (previous-grub-entries #:optional (profile %system-profile)) "Return a list of 'menu-entry' for the generations of PROFILE." (define (system->grub-entry system number time) (unless-file-not-found - (let ((file (string-append system "/parameters"))) - (match (call-with-input-file file read-boot-parameters) - (($ label root kernel kernel-arguments) - (menu-entry - (label (string-append label " (#" - (number->string number) ", " - (seconds->string time) ")")) - (linux kernel) - (linux-arguments - (cons* (string-append "--root=" root) - #~(string-append "--system=" #$system) - #~(string-append "--load=" #$system "/boot") - kernel-arguments)) - (initrd #~(string-append #$system "/initrd")))) - (#f ;invalid format - #f))))) + (let* ((file (string-append system "/parameters")) + (params (call-with-input-file file + read-boot-parameters)) + (label (boot-parameters-label params)) + (root (boot-parameters-root-device params)) + (kernel (boot-parameters-kernel params)) + (kernel-arguments (boot-parameters-kernel-arguments params))) + (menu-entry + (label (string-append label " (#" + (number->string number) ", " + (seconds->string time) ")")) + (linux kernel) + (linux-arguments + (cons* (string-append "--root=" root) + #~(string-append "--system=" #$system) + #~(string-append "--load=" #$system "/boot") + kernel-arguments)) + (initrd #~(string-append #$system "/initrd")))))) (let* ((numbers (generation-numbers profile)) (systems (map (cut generation-file-name profile <>) @@ -366,18 +336,17 @@ (define* (display-system-generation number (unless (zero? number) (let* ((generation (generation-file-name profile number)) (param-file (string-append generation "/parameters")) - (params (call-with-input-file param-file read-boot-parameters))) + (params (call-with-input-file param-file read-boot-parameters)) + (label (boot-parameters-label params)) + (root (boot-parameters-root-device params)) + (kernel (boot-parameters-kernel params))) (display-generation profile number) (format #t (_ " file name: ~a~%") generation) (format #t (_ " canonical file name: ~a~%") (readlink* generation)) - (match params - (($ label root kernel) - ;; TRANSLATORS: Please preserve the two-space indentation. - (format #t (_ " label: ~a~%") label) - (format #t (_ " root device: ~a~%") root) - (format #t (_ " kernel: ~a~%") kernel)) - (_ - #f))))) + ;; TRANSLATORS: Please preserve the two-space indentation. + (format #t (_ " label: ~a~%") label) + (format #t (_ " root device: ~a~%") root) + (format #t (_ " kernel: ~a~%") kernel)))) (define* (list-generations pattern #:optional (profile %system-profile)) "Display in a human-readable format all the system generations matching