From 44d5f54e31039d78f156bd9562dca293124eaa76 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 9 Sep 2016 23:27:00 +0200 Subject: system: grub: Allow arbitrary kernel file names in 'menu-entry'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by Tomáš Čech . * gnu/system.scm (system-linux-image-file-name) (operating-system-kernel-file): New procedures. (operating-system-grub.cfg): Use 'operating-system-kernel-file' for the 'kernel' field of 'menu-entry'. (operating-system-parameters-file): Likewise for the 'kernel' entry. (read-boot-parameters): Adjust 'kernel' field so that it contains the absolute file name of the image. * gnu/system/grub.scm (grub-configuration-file)[linux-image-name]: Remove. [entry->gexp]: Assume LINUX is the absolute file name of the kernel image. * doc/guix.texi (GRUB Configuration): Add an example, and adjust 'kernel' field documentation accordingly. --- gnu/system.scm | 30 ++++++++++++++++++++++++++---- 1 file changed, 26 insertions(+), 4 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 080201011c..18b2806fe9 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -69,6 +69,7 @@ operating-system-host-name operating-system-hosts-file operating-system-kernel + operating-system-kernel-file operating-system-kernel-arguments operating-system-initrd operating-system-users @@ -246,6 +247,19 @@ from the initrd." "Return the list of swap services for OS." (map swap-service (operating-system-swap-devices os))) +(define* (system-linux-image-file-name #:optional (system (%current-system))) + "Return the basename of the kernel image file for SYSTEM." + ;; FIXME: Evaluate the conditional based on the actual current system. + (if (string-prefix? "mips" (%current-system)) + "vmlinuz" + "bzImage")) + +(define (operating-system-kernel-file os) + "Return an object representing the absolute file name of the kernel image of +OS." + (file-append (operating-system-kernel os) + "/" (system-linux-image-file-name os))) + (define* (operating-system-directory-base-entries os #:key container?) "Return the basic entries of the 'system' directory of OS for use as the value of the SYSTEM-SERVICE-TYPE service." @@ -710,12 +724,13 @@ listed in OS. The C library expects to find it under ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) (store-fs -> (operating-system-store-file-system os)) - (kernel -> (operating-system-kernel os)) + (label -> (kernel->grub-label (operating-system-kernel os))) + (kernel -> (operating-system-kernel-file os)) (root-device -> (if (eq? 'uuid (file-system-title root-fs)) (uuid->string (file-system-device root-fs)) (file-system-device root-fs))) (entries -> (list (menu-entry - (label (kernel->grub-label kernel)) + (label label) (linux kernel) (linux-arguments (cons* (string-append "--root=" root-device) @@ -739,7 +754,7 @@ this file is the reconstruction of GRUB menu entries for old configurations." #~(boot-parameters (version 0) (label #$label) (root-device #$(file-system-device root)) - (kernel #$(operating-system-kernel os)) + (kernel #$(operating-system-kernel-file os)) (kernel-arguments #$(operating-system-kernel-arguments os)) (initrd #$initrd)) @@ -768,7 +783,14 @@ this file is the reconstruction of GRUB menu entries for old configurations." (boot-parameters (label label) (root-device root) - (kernel linux) + + ;; In the past, we would store the directory name of the kernel instead + ;; of the absolute file name of its image. Detect that and correct it. + (kernel (if (string=? linux (direct-store-path linux)) + (string-append linux "/" + (system-linux-image-file-name)) + linux)) + (kernel-arguments (match (assq 'kernel-arguments rest) ((_ args) args) -- cgit v1.2.3 From ab20d74a4638dc6295aa9b9af276d2a98f238f9d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 9 Sep 2016 23:38:24 +0200 Subject: system: Build the initrd file name with 'file-append'. * gnu/system.scm (operating-system-initrd-file) (operating-system-grub.cfg): Use 'file-append' to construct the initrd file name. --- gnu/system.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 18b2806fe9..4c1de384fa 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -660,7 +660,7 @@ hardware-related operations as necessary when booting a Linux container." (mlet %store-monad ((initrd (make-initrd boot-file-systems #:linux (operating-system-kernel os) #:mapped-devices mapped-devices))) - (return #~(string-append #$initrd "/initrd")))) + (return (file-append initrd "/initrd")))) (define (locale-name->definition* name) "Variant of 'locale-name->definition' that raises an error upon failure." @@ -738,7 +738,7 @@ listed in OS. The C library expects to find it under #~(string-append "--load=" #$system "/boot") (operating-system-kernel-arguments os))) - (initrd #~(string-append #$system "/initrd")))))) + (initrd (file-append system "/initrd")))))) (grub-configuration-file (operating-system-bootloader os) store-fs entries #:old-entries old-entries))) -- cgit v1.2.3 From 9e41130b14ad32c4e1fa756f95d806703056cb60 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 10 Sep 2016 12:03:47 +0200 Subject: system: Use 'file-append' to denote file names. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/databases.scm, gnu/services/dbus.scm, gnu/services/desktop.scm, gnu/services/dict.scm, gnu/services/mail.scm, gnu/services/networking.scm, gnu/services/sddm.scm, gnu/services/spice.scm, gnu/services/ssh.scm, gnu/services/web.scm, gnu/services/xorg.scm, gnu/system.scm: Replace the #~(string-append #$pkg "/bin/foo") idiom with (file-append pkg "/bin/foo"). --- gnu/services/avahi.scm | 2 +- gnu/services/base.scm | 10 +++++----- gnu/services/databases.scm | 4 ++-- gnu/services/dbus.scm | 4 ++-- gnu/services/desktop.scm | 11 +++++------ gnu/services/dict.scm | 2 +- gnu/services/mail.scm | 4 ++-- gnu/services/networking.scm | 8 ++++---- gnu/services/sddm.scm | 18 +++++++++--------- gnu/services/spice.scm | 2 +- gnu/services/ssh.scm | 2 +- gnu/services/web.scm | 4 ++-- gnu/services/xorg.scm | 11 +++++------ gnu/system.scm | 24 ++++++++++++------------ 14 files changed, 52 insertions(+), 54 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index 807cc05a22..60e9e61f94 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -88,7 +88,7 @@ (system? #t) (comment "Avahi daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define %avahi-activation ;; Activation gexp. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 42094b5fb9..07c08d7567 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -516,7 +516,7 @@ stopped before 'kill' is called." (define device (rngd-configuration-device config)) (define rngd-command - (list #~(string-append #$rng-tools "/sbin/rngd") + (list (file-append rng-tools "/sbin/rngd") "-f" "-r" device)) (shepherd-service @@ -893,7 +893,7 @@ Service Switch}, for an example." syslog-configuration make-syslog-configuration syslog-configuration? (syslogd syslog-configuration-syslogd - (default #~(string-append #$inetutils "/libexec/syslogd"))) + (default (file-append inetutils "/libexec/syslogd"))) (config-file syslog-configuration-config-file (default %default-syslog.conf))) @@ -1009,7 +1009,7 @@ starting at FIRST-UID, and under GID." (comment (format #f "Guix Build User ~2d" n)) (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin")))) + (shell (file-append shadow "/sbin/nologin")))) 1+ 1)) @@ -1036,7 +1036,7 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (define %default-authorized-guix-keys ;; List of authorized substitute keys. - (list #~(string-append #$guix "/share/guix/hydra.gnu.org.pub"))) + (list (file-append guix "/share/guix/hydra.gnu.org.pub"))) (define-record-type* guix-configuration make-guix-configuration @@ -1167,7 +1167,7 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (system? #t) (comment "guix publish user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define guix-publish-service-type (service-type (name 'guix-publish) diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 86847f8c50..1eed85542b 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -76,7 +76,7 @@ host all all ::1/128 trust")) (system? #t) (comment "PostgreSQL server user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define postgresql-activation (match-lambda @@ -171,7 +171,7 @@ and stores the database cluster in @var{data-directory}." (group "mysql") (system? #t) (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define mysql-configuration-file (match-lambda diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 690561cccd..876f56d45f 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -128,13 +128,13 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (system? #t) (comment "D-Bus system bus user") (home-directory "/var/run/dbus") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define dbus-setuid-programs ;; Return the file name of the setuid program that we need. (match-lambda (($ dbus services) - (list #~(string-append #$dbus "/libexec/dbus-daemon-launch-helper"))))) + (list (file-append dbus "/libexec/dbus-daemon-launch-helper"))))) (define (dbus-activation config) "Return an activation gexp for D-Bus using @var{config}." diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 8dacf54668..dfd1ea6e92 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -460,9 +460,8 @@ Users need to be in the @code{lp} group to access the D-Bus service. (define polkit-setuid-programs (match-lambda (($ polkit) - (list #~(string-append #$polkit - "/lib/polkit-1/polkit-agent-helper-1") - #~(string-append #$polkit "/bin/pkexec"))))) + (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1") + (file-append polkit "/bin/pkexec"))))) (define polkit-service-type (service-type (name 'polkit) @@ -522,7 +521,7 @@ the capability to suspend the system if the user is logged in locally." (system? #t) (comment "colord daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define colord-service-type (service-type (name 'colord) @@ -738,8 +737,8 @@ seats.)" (define pam-elogind (pam-entry (control "required") - (module #~(string-append #$(elogind-package config) - "/lib/security/pam_elogind.so")))) + (module (file-append (elogind-package config) + "/lib/security/pam_elogind.so")))) (list (lambda (pam) (pam-service diff --git a/gnu/services/dict.scm b/gnu/services/dict.scm index b06922c911..da5d004701 100644 --- a/gnu/services/dict.scm +++ b/gnu/services/dict.scm @@ -73,7 +73,7 @@ (group "dicod") (system? #t) (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define (dicod-configuration-file config) (define database->text diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index c252d669de..46dbab6645 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -1505,7 +1505,7 @@ greyed out, instead of only later giving \"not selectable\" popup error. (system? #t) (comment "Dovecot daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))) + (shell (file-append shadow "/sbin/nologin"))) (user-group (name "dovenull") (system? #t)) (user-account @@ -1514,7 +1514,7 @@ greyed out, instead of only later giving \"not selectable\" popup error. (system? #t) (comment "Dovecot daemon login user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define %dovecot-activation ;; Activation gexp. diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index dee1b74d81..7495179f8e 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -194,7 +194,7 @@ gateway." 'dhcp-client (lambda (dhcp) (define dhclient - #~(string-append #$dhcp "/sbin/dhclient")) + (file-append dhcp "/sbin/dhclient")) (define pid-file "/var/run/dhclient.pid") @@ -306,7 +306,7 @@ restrict -6 ::1\n")) (system? #t) (comment "NTP daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define (ntp-service-activation config) @@ -361,7 +361,7 @@ keep the system clock synchronized with that of @var{servers}." (system? #t) (comment "Tor daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define-record-type (hidden-service name mapping) @@ -554,7 +554,7 @@ project's documentation} for more information." (system? #t) (comment "BitlBee daemon user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define %bitlbee-activation ;; Activation gexp for BitlBee. diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm index ab6672b0e5..ef1e78e9bf 100644 --- a/gnu/services/sddm.scm +++ b/gnu/services/sddm.scm @@ -48,9 +48,9 @@ (numlock sddm-configuration-numlock (default "on")) (halt-command sddm-configuration-halt-command - (default #~(string-append #$shepherd "/sbin/halt"))) + (default (file-append shepherd "/sbin/halt"))) (reboot-command sddm-configuration-reboot-command - (default #~(string-append #$shepherd "/sbin/reboot"))) + (default (file-append shepherd "/sbin/reboot"))) ;; [Theme] ;; valid values are elarun or maldives @@ -75,24 +75,24 @@ (hide-users sddm-configuration-hide-users (default "")) (hide-shells sddm-configuration-hide-shells - (default #~(string-append #$shadow "/sbin/nologin"))) + (default (file-append shadow "/sbin/nologin"))) ;; [Wayland] (session-command sddm-configuration-session-command - (default #~(string-append #$sddm "/share/sddm/scripts/wayland-session"))) + (default (file-append sddm "/share/sddm/scripts/wayland-session"))) (sessions-directory sddm-configuration-sessions-directory (default "/run/current-system/profile/share/wayland-sessions")) ;; [X11] (xorg-server-path sddm-configuration-xorg-server-path (default (xorg-start-command))) (xauth-path sddm-configuration-xauth-path - (default #~(string-append #$xauth "/bin/xauth"))) + (default (file-append xauth "/bin/xauth"))) (xephyr-path sddm-configuration-xephyr-path - (default #~(string-append #$xorg-server "/bin/Xephyr"))) + (default (file-append xorg-server "/bin/Xephyr"))) (xdisplay-start sddm-configuration-xdisplay-start - (default #~(string-append #$sddm "/share/sddm/scripts/Xsetup"))) + (default (file-append sddm "/share/sddm/scripts/Xsetup"))) (xdisplay-stop sddm-configuration-xdisplay-stop - (default #~(string-append #$sddm "/share/sddm/scripts/Xstop"))) + (default (file-append sddm "/share/sddm/scripts/Xstop"))) (xsession-command sddm-configuration-xsession-command (default (xinitrc))) (xsessions-directory sddm-configuration-xsessions-directory @@ -292,7 +292,7 @@ Relogin=" (if (sddm-configuration-relogin? config) (system? #t) (comment "SDDM user") (home-directory "/var/lib/sddm") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) ;; Add default themes to profile (define sddm-profile-service diff --git a/gnu/services/spice.scm b/gnu/services/spice.scm index 26f072e7a8..bd0a538346 100644 --- a/gnu/services/spice.scm +++ b/gnu/services/spice.scm @@ -43,7 +43,7 @@ (define spice-vdagentd-command (list - #~(string-append #$spice-vdagent "/sbin/spice-vdagentd") + (file-append spice-vdagent "/sbin/spice-vdagentd") "-x")) (list diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 9a7ea0fb46..462988cc80 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -122,7 +122,7 @@ (define lsh-command (append - (cons #~(string-append #$lsh "/sbin/lshd") + (cons (file-append lsh "/sbin/lshd") (if daemonic? (let ((syslog (if (lsh-configuration-syslog-output? config) '() diff --git a/gnu/services/web.scm b/gnu/services/web.scm index d86aab50b5..40e4d5f46f 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -67,7 +67,7 @@ (system? #t) (comment "nginx server user") (home-directory "/var/empty") - (shell #~(string-append #$shadow "/sbin/nologin"))))) + (shell (file-append shadow "/sbin/nologin"))))) (define nginx-activation (match-lambda @@ -86,7 +86,7 @@ (define nginx-shepherd-service (match-lambda (($ nginx log-directory run-directory config-file) - (let* ((nginx-binary #~(string-append #$nginx "/sbin/nginx")) + (let* ((nginx-binary (file-append nginx "/sbin/nginx")) (nginx-action (lambda args #~(lambda _ diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 87c4487037..d098d831e1 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -267,7 +267,7 @@ which should be passed to this script as the first argument. If not, the (define %default-slim-theme ;; Theme based on work by Felipe López. - #~(string-append #$%artwork-repository "/slim")) + (file-append %artwork-repository "/slim")) (define %default-slim-theme-name ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that @@ -374,8 +374,8 @@ reboot_cmd " shepherd "/sbin/reboot\n" (theme %default-slim-theme) (theme-name %default-slim-theme-name) (xauth xauth) (shepherd shepherd) (bash bash) - (auto-login-session #~(string-append #$windowmaker - "/bin/wmaker")) + (auto-login-session (file-append windowmaker + "/bin/wmaker")) (startx (xorg-start-command))) "Return a service that spawns the SLiM graphical login manager, which in turn starts the X display server with @var{startx}, a command as returned by @@ -450,14 +450,13 @@ command is @var{program}, to the set of setuid programs and add a PAM entry for it. For example: @lisp -(screen-locker-service xlockmore \"xlock\") + (screen-locker-service xlockmore \"xlock\") @end lisp makes the good ol' XlockMore usable." (service screen-locker-service-type (screen-locker program - #~(string-append #$package - #$(string-append "/bin/" program)) + (file-append package "/bin/" program) allow-empty-passwords?))) ;;; xorg.scm ends here diff --git a/gnu/system.scm b/gnu/system.scm index 4c1de384fa..7edb018f00 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -472,9 +472,9 @@ then source /run/current-system/profile/etc/profile.d/bash_completion.sh fi\n"))) (etc-service - `(("services" ,#~(string-append #$net-base "/etc/services")) - ("protocols" ,#~(string-append #$net-base "/etc/protocols")) - ("rpc" ,#~(string-append #$net-base "/etc/rpc")) + `(("services" ,(file-append net-base "/etc/services")) + ("protocols" ,(file-append net-base "/etc/protocols")) + ("rpc" ,(file-append net-base "/etc/rpc")) ("login.defs" ,#~#$login.defs) ("issue" ,#~#$issue) ("nsswitch.conf" ,#~#$nsswitch) @@ -482,8 +482,8 @@ fi\n"))) ("bashrc" ,#~#$bashrc) ("hosts" ,#~#$(or (operating-system-hosts-file os) (default-/etc/hosts (operating-system-host-name os)))) - ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/" - #$(operating-system-timezone os))) + ("localtime" ,(file-append tzdata "/share/zoneinfo/" + (operating-system-timezone os))) ("sudoers" ,(operating-system-sudoers-file os)))))) (define %root-account @@ -547,7 +547,7 @@ use 'plain-file' instead~%") @var{session-environment-service-type}, to be used in @file{/etc/environment}." `(("LANG" . ,(operating-system-locale os)) ("TZ" . ,(operating-system-timezone os)) - ("TZDIR" . ,#~(string-append #$tzdata "/share/zoneinfo")) + ("TZDIR" . ,(file-append tzdata "/share/zoneinfo")) ;; Tell 'modprobe' & co. where to look for modules. ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules") ;; These variables are honored by OpenSSL (libssl) and Git. @@ -571,12 +571,12 @@ use 'plain-file' instead~%") (define %setuid-programs ;; Default set of setuid-root programs. (let ((shadow (@ (gnu packages admin) shadow))) - (list #~(string-append #$shadow "/bin/passwd") - #~(string-append #$shadow "/bin/su") - #~(string-append #$inetutils "/bin/ping") - #~(string-append #$inetutils "/bin/ping6") - #~(string-append #$sudo "/bin/sudo") - #~(string-append #$fuse "/bin/fusermount")))) + (list (file-append shadow "/bin/passwd") + (file-append shadow "/bin/su") + (file-append inetutils "/bin/ping") + (file-append inetutils "/bin/ping6") + (file-append sudo "/bin/sudo") + (file-append fuse "/bin/fusermount")))) (define %sudoers-specification ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel' -- cgit v1.2.3 From d7b342d81556ddee9e369f78255bc76367a004ae Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 24 Sep 2016 17:39:00 +0900 Subject: system: 'read-boot-parameters' reads the 'initrd' parameter. * gnu/system.scm ()[initrd]: New field. (read-boot-parameters): Read the 'initrd' element and fill in the 'initrd' field of the result. --- gnu/system.scm | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 7edb018f00..bf79bf1c27 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -101,6 +101,7 @@ boot-parameters-root-device boot-parameters-kernel boot-parameters-kernel-arguments + boot-parameters-initrd read-boot-parameters local-host-aliases @@ -770,7 +771,8 @@ this file is the reconstruction of GRUB menu entries for old configurations." (label boot-parameters-label) (root-device boot-parameters-root-device) (kernel boot-parameters-kernel) - (kernel-arguments boot-parameters-kernel-arguments)) + (kernel-arguments boot-parameters-kernel-arguments) + (initrd boot-parameters-initrd)) (define (read-boot-parameters port) "Read boot parameters from PORT and return the corresponding @@ -794,7 +796,14 @@ this file is the reconstruction of GRUB menu entries for old configurations." (kernel-arguments (match (assq 'kernel-arguments rest) ((_ args) args) - (#f '()))))) ;the old format + (#f '()))) ;the old format + + (initrd + (match (assq 'initrd rest) + (('initrd ('string-append directory file)) ;the old format + (string-append directory file)) + (('initrd (? string? file)) + file))))) (x ;unsupported format (warning (_ "unrecognized boot parameters for '~a'~%") system) -- cgit v1.2.3 From 0f65f54ebd76324653fd5506a7dab42ee44d9255 Mon Sep 17 00:00:00 2001 From: Carlos Sánchez de La Lama Date: Wed, 14 Sep 2016 16:13:24 +0200 Subject: system: grub.cfg uses correct file names when store is not in root partition. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by csanchezdll@gmail.com (Carlos Sánchez de La Lama). * guix/scripts/system.scm (previous-grub-entries): Get the initrd file name from PARAMS. * gnu/system.scm (operating-system-grub.cfg): Use 'operating-system-initrd-file' to retrieve the initrd file name. * gnu/system/grub.scm (strip-mount-point): New procedure. (grub-configuration-file)[entry->gexp]: Call 'strip-mount-point' for LINUX and INITRD. Co-authored-by: Ludovic Courtès --- gnu/system.scm | 3 ++- gnu/system/grub.scm | 30 +++++++++++++++++++++++------- guix/scripts/system.scm | 9 +++++---- 3 files changed, 30 insertions(+), 12 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index bf79bf1c27..38ae8f1771 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -727,6 +727,7 @@ listed in OS. The C library expects to find it under (store-fs -> (operating-system-store-file-system os)) (label -> (kernel->grub-label (operating-system-kernel os))) (kernel -> (operating-system-kernel-file os)) + (initrd (operating-system-initrd-file os)) (root-device -> (if (eq? 'uuid (file-system-title root-fs)) (uuid->string (file-system-device root-fs)) (file-system-device root-fs))) @@ -739,7 +740,7 @@ listed in OS. The C library expects to find it under #~(string-append "--load=" #$system "/boot") (operating-system-kernel-arguments os))) - (initrd (file-append system "/initrd")))))) + (initrd initrd))))) (grub-configuration-file (operating-system-bootloader os) store-fs entries #:old-entries old-entries))) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 4592747083..3d294284e4 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -62,6 +62,17 @@ ;;; ;;; Code: +(define (strip-mount-point fs file) + "Strip the mount point of FS from FILE, which is a gexp or other lowerable +object denoting a file name." + (let ((mount-point (file-system-mount-point fs))) + (if (string=? mount-point "/") + file + #~(let ((file #$file)) + (if (string-prefix? #$mount-point file) + (substring #$file #$(string-length mount-point)) + file))))) + (define-record-type* grub-image make-grub-image grub-image? @@ -183,7 +194,8 @@ the store is. SYSTEM must be the target system string---e.g., (symbol->string (assoc-ref colors 'bg))))) (define font-file - #~(string-append #$grub "/share/grub/unicode.pf2")) + (strip-mount-point root-fs + (file-append grub "/share/grub/unicode.pf2"))) (mlet* %store-monad ((image (grub-background-image config))) (return (and image @@ -209,7 +221,7 @@ fi~%" #$(grub-root-search root-fs font-file) #$font-file - #$image + #$(strip-mount-point root-fs image) #$(theme-colors grub-theme-color-normal) #$(theme-colors grub-theme-color-highlight)))))) @@ -249,15 +261,19 @@ corresponding to old generations of the system." (define entry->gexp (match-lambda (($ label linux arguments initrd) - #~(format port "menuentry ~s { + ;; Use the right file names for LINUX and STORE-FS in case STORE-FS is + ;; not the "/" file system. + (let ((linux (strip-mount-point store-fs linux)) + (initrd (strip-mount-point store-fs initrd))) + #~(format port "menuentry ~s { ~a linux ~a ~a initrd ~a }~%" - #$label - #$(grub-root-search store-fs linux) - #$linux (string-join (list #$@arguments)) - #$initrd)))) + #$label + #$(grub-root-search store-fs linux) + #$linux (string-join (list #$@arguments)) + #$initrd))))) (mlet %store-monad ((sugar (eye-candy config store-fs system #~port))) (define builder diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 953c6243ed..a2cd97ac1f 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -383,7 +383,8 @@ it atomically, and then run OS's activation script." (uuid->string root) root)) (kernel (boot-parameters-kernel params)) - (kernel-arguments (boot-parameters-kernel-arguments params))) + (kernel-arguments (boot-parameters-kernel-arguments params)) + (initrd (boot-parameters-initrd params))) (menu-entry (label (string-append label " (#" (number->string number) ", " @@ -391,10 +392,10 @@ it atomically, and then run OS's activation script." (linux kernel) (linux-arguments (cons* (string-append "--root=" root-device) - #~(string-append "--system=" #$system) - #~(string-append "--load=" #$system "/boot") + (string-append "--system=" system) + (string-append "--load=" system "/boot") kernel-arguments)) - (initrd #~(string-append #$system "/initrd")))))) + (initrd initrd))))) (let* ((numbers (generation-numbers profile)) (systems (map (cut generation-file-name profile <>) -- cgit v1.2.3