diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/examples/bare-bones.tmpl | 4 | ||||
| -rw-r--r-- | gnu/system/examples/lightweight-desktop.tmpl | 30 | ||||
| -rw-r--r-- | gnu/system/examples/vm-image.tmpl | 53 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 330 | ||||
| -rw-r--r-- | gnu/system/install.scm | 13 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 4 | ||||
| -rw-r--r-- | gnu/system/pam.scm | 31 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 4 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 82 |
9 files changed, 166 insertions, 385 deletions
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index 222ddda579..f7b8823d4f 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -43,5 +43,7 @@ ;; Add services to the baseline: a DHCP client and ;; an SSH server. (services (cons* (dhcp-client-service) - (lsh-service #:port-number 2222) + (service openssh-service-type + (openssh-configuration + (port-number 2222))) %base-services))) diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl index 389ec8574b..6fb6283d29 100644 --- a/gnu/system/examples/lightweight-desktop.tmpl +++ b/gnu/system/examples/lightweight-desktop.tmpl @@ -4,23 +4,31 @@ (use-modules (gnu) (gnu system nss)) (use-service-modules desktop) -(use-package-modules wm ratpoison certs suckless) +(use-package-modules bootloaders certs ratpoison suckless wm) (operating-system (host-name "antelope") (timezone "Europe/Paris") (locale "en_US.utf8") - ;; Assuming /dev/sdX is the target hard disk, and "my-root" - ;; is the label of the target root file system. - (bootloader (grub-configuration (device "/dev/sdX"))) - - (file-systems (cons (file-system - (device "my-root") - (title 'label) - (mount-point "/") - (type "ext4")) - %base-file-systems)) + ;; Use the UEFI variant of GRUB with the EFI System + ;; Partition on /dev/sda1. + (bootloader (grub-configuration (grub grub-efi) + (device "/dev/sda1"))) + + ;; Assume the target root file system is labelled "my-root". + (file-systems (cons* (file-system + (device "my-root") + (title 'label) + (mount-point "/") + (type "ext4")) + (file-system + ;; Specify partition here since FAT + ;; labels are currently unsupported. + (device "/dev/sda1") + (mount-point "/boot/efi") + (type "vfat")) + %base-file-systems)) (users (cons (user-account (name "alice") diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl new file mode 100644 index 0000000000..57ac71c535 --- /dev/null +++ b/gnu/system/examples/vm-image.tmpl @@ -0,0 +1,53 @@ +;;; This is an operating system configuration template for a "bare-bones" setup, +;;; suitable for booting in a virtualized environment, including virtual private +;;; servers (VPS). + +(use-modules (gnu)) +(use-package-modules bootloaders disk nvi) + +(define vm-image-motd (plain-file "motd" " +This is the GNU system. Welcome! + +This instance of GuixSD is a bare-bones template for virtualized environments. + +You will probably want to do these things first if you booted in a virtual +private server (VPS): + +* Set a password for 'root'. +* Set up networking. +* Expand the root partition to fill the space available by 0) deleting and +recreating the partition with fdisk, 1) reloading the partition table with +partprobe, and then 2) resizing the filesystem with resize2fs.\n")) + +(operating-system + (host-name "gnu") + (timezone "Etc/UTC") + (locale "en_US.utf8") + + ;; Assuming /dev/sdX is the target hard disk, and "my-root" is + ;; the label of the target root file system. + (bootloader (grub-configuration (device "/dev/sda") + (terminal-outputs '(console)))) + (file-systems (cons (file-system + (device "my-root") + (title 'label) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + + ;; This is where user accounts are specified. The "root" + ;; account is implicit, and is initially created with the + ;; empty password. + (users %base-user-accounts) + + ;; Globally-installed packages. + (packages (cons* nvi fdisk + grub ; mostly so xrefs to its manual work + parted ; partprobe + %base-packages)) + + (services (modify-services %base-services + (login-service-type config => + (login-configuration + (inherit config) + (motd vm-image-motd)))))) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm deleted file mode 100644 index 4f9bde6a62..0000000000 --- a/gnu/system/grub.scm +++ /dev/null @@ -1,330 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> -;;; -;;; 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 (guix monads) - #:use-module (guix gexp) - #:use-module (guix download) - #:use-module (gnu artwork) - #:use-module (gnu system file-systems) - #:autoload (gnu packages bootloaders) (grub) - #:autoload (gnu packages compression) (gzip) - #:autoload (gnu packages gtk) (guile-cairo guile-rsvg) - #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (srfi srfi-1) - #:use-module (rnrs bytevectors) - #:export (grub-image - grub-image? - grub-image-aspect-ratio - grub-image-file - - grub-theme - grub-theme? - grub-theme-images - grub-theme-color-normal - grub-theme-color-highlight - - %background-image - %default-theme - - grub-configuration - grub-configuration? - grub-configuration-device - grub-configuration-grub - - menu-entry - menu-entry? - - grub-configuration-file)) - -;;; Commentary: -;;; -;;; Configuration of GNU GRUB. -;;; -;;; Code: - -(define (strip-mount-point mount-point file) - "Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object -denoting a file name." - (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> - grub-image make-grub-image - grub-image? - (aspect-ratio grub-image-aspect-ratio ;rational number - (default 4/3)) - (file grub-image-file)) ;file-valued gexp (SVG) - -(define-record-type* <grub-theme> - grub-theme make-grub-theme - grub-theme? - (images grub-theme-images - (default '())) ;list of <grub-image> - (color-normal grub-theme-color-normal - (default '((fg . cyan) (bg . blue)))) - (color-highlight grub-theme-color-highlight - (default '((fg . white) (bg . blue))))) - -(define %background-image - (grub-image - (aspect-ratio 4/3) - (file (file-append %artwork-repository - "/grub/GuixSD-fully-black-4-3.svg")))) - -(define %default-theme - ;; Default theme contributed by Felipe López. - (grub-theme - (images (list %background-image)) - (color-highlight '((fg . yellow) (bg . black))) - (color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 - -(define-record-type* <grub-configuration> - grub-configuration make-grub-configuration - grub-configuration? - (grub grub-configuration-grub ; package - (default (@ (gnu packages bootloaders) grub))) - (device grub-configuration-device) ; string - (menu-entries grub-configuration-menu-entries ; list - (default '())) - (default-entry grub-configuration-default-entry ; integer - (default 0)) - (timeout grub-configuration-timeout ; integer - (default 5)) - (theme grub-configuration-theme ; <grub-theme> - (default %default-theme))) - -(define-record-type* <menu-entry> - menu-entry make-menu-entry - menu-entry? - (label menu-entry-label) - (device menu-entry-device ; file system uuid, label, or #f - (default #f)) - (device-mount-point menu-entry-device-mount-point - (default "/")) - (linux menu-entry-linux) - (linux-arguments menu-entry-linux-arguments - (default '())) ; list of string-valued gexps - (initrd menu-entry-initrd)) ; file name of the initrd as a gexp - - -;;; -;;; Background image & themes. -;;; - -(define* (svg->png svg #:key width height) - "Build a PNG of HEIGHT x WIDTH from SVG." - (gexp->derivation "grub-image.png" - (with-imported-modules '((gnu build svg)) - #~(begin - ;; We need these two libraries. - (add-to-load-path (string-append #$guile-rsvg - "/share/guile/site/" - (effective-version))) - (add-to-load-path (string-append #$guile-cairo - "/share/guile/site/" - (effective-version))) - - (use-modules (gnu build svg)) - (svg->png #$svg #$output - #:width #$width - #:height #$height))))) - -(define* (grub-background-image config #:key (width 1024) (height 768)) - "Return the GRUB background image defined in CONFIG with a ratio of -WIDTH/HEIGHT, or #f if none was found." - (let* ((ratio (/ width height)) - (image (find (lambda (image) - (= (grub-image-aspect-ratio image) ratio)) - (grub-theme-images (grub-configuration-theme config))))) - (if image - (svg->png (grub-image-file image) - #:width width #:height height) - (with-monad %store-monad - (return #f))))) - -(define* (eye-candy config store-device store-mount-point - #:key system port) - "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the -'grub.cfg' part concerned with graphics mode, background images, colors, and -all that. STORE-DEVICE designates the device holding the store, and -STORE-MOUNT-POINT is its mount point; these are used to determine where the -background image and fonts must be searched for. SYSTEM must be the target -system string---e.g., \"x86_64-linux\"." - (define setup-gfxterm-body - ;; Intel and EFI systems need to be switched into graphics mode, whereas - ;; most other modern architectures have no other mode and therefore don't - ;; need to be switched. - (if (string-match "^(x86_64|i[3-6]86)-" system) - " - # Leave 'gfxmode' to 'auto'. - insmod video_bochs - insmod video_cirrus - insmod gfxterm - - if [ \"${grub_platform}\" == efi ]; then - # This is for (U)EFI systems (these modules are unavailable in the - # non-EFI GRUB.) If we don't load them, GRUB boots in \"blind mode\", - # which isn't convenient. - insmod efi_gop - insmod efi_uga - else - # These are specific to non-EFI Intel machines. - insmod vbe - insmod vga - fi - - terminal_output gfxterm -" - "")) - - (define (theme-colors type) - (let* ((theme (grub-configuration-theme config)) - (colors (type theme))) - (string-append (symbol->string (assoc-ref colors 'fg)) "/" - (symbol->string (assoc-ref colors 'bg))))) - - (define font-file - (strip-mount-point store-mount-point - (file-append grub "/share/grub/unicode.pf2"))) - - (mlet* %store-monad ((image (grub-background-image config))) - (return (and image - #~(format #$port " -function setup_gfxterm {~a} - -# Set 'root' to the partition that contains /gnu/store. -~a - -if loadfont ~a; then - setup_gfxterm -fi - -insmod png -if background_image ~a; then - set color_normal=~a - set color_highlight=~a -else - set menu_color_normal=cyan/blue - set menu_color_highlight=white/blue -fi~%" - #$setup-gfxterm-body - #$(grub-root-search store-device font-file) - #$font-file - - #$(strip-mount-point store-mount-point image) - #$(theme-colors grub-theme-color-normal) - #$(theme-colors grub-theme-color-highlight)))))) - - -;;; -;;; Configuration file. -;;; - -(define (grub-root-search device file) - "Return the GRUB 'search' command to look for DEVICE, which contains FILE, -a gexp. The result is a gexp that can be inserted in the grub.cfg-generation -code." - ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but - ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of - ;; custom menu entries. In the latter case, don't emit a 'search' command. - (if (and (string? file) (not (string-prefix? "/" file))) - "" - (match device - ;; Preferably refer to DEVICE by its UUID or label. This is more - ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>. - ((? bytevector? uuid) - (format #f "search --fs-uuid --set ~a" - (uuid->string device))) - ((? string? label) - (format #f "search --label --set ~a" label)) - (#f - #~(format #f "search --file --set ~a" #$file))))) - -(define* (grub-configuration-file config entries - #:key - (system (%current-system)) - (old-entries '())) - "Return the GRUB configuration file corresponding to CONFIG, a -<grub-configuration> object, and where the store is available at STORE-FS, a -<file-system> object. OLD-ENTRIES is taken to be a list of menu entries -corresponding to old generations of the system." - (define all-entries - (append entries (grub-configuration-menu-entries config))) - - (define entry->gexp - (match-lambda - (($ <menu-entry> label device device-mount-point - linux arguments initrd) - ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point. - ;; Use the right file names for LINUX and INITRD in case - ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a - ;; separate partition. - (let ((linux (strip-mount-point device-mount-point linux)) - (initrd (strip-mount-point device-mount-point initrd))) - #~(format port "menuentry ~s { - ~a - linux ~a ~a - initrd ~a -}~%" - #$label - #$(grub-root-search device linux) - #$linux (string-join (list #$@arguments)) - #$initrd))))) - - (mlet %store-monad ((sugar (eye-candy config - (menu-entry-device (first entries)) - (menu-entry-device-mount-point - (first entries)) - #:system system - #:port #~port))) - (define builder - #~(call-with-output-file #$output - (lambda (port) - (format port - "# This file was generated from your GuixSD configuration. Any changes -# will be lost upon reconfiguration. -") - #$sugar - (format port " -set default=~a -set timeout=~a~%" - #$(grub-configuration-default-entry config) - #$(grub-configuration-timeout config)) - #$@(map entry->gexp all-entries) - - #$@(if (pair? old-entries) - #~((format port " -submenu \"GNU system, old configurations...\" {~%") - #$@(map entry->gexp old-entries) - (format port "}~%")) - #~())))) - - (gexp->derivation "grub.cfg" builder))) - -;;; grub.scm ends here diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 191ccf1680..0a78d030dd 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,7 @@ #:use-module (guix monads) #:use-module ((guix store) #:select (%store-prefix)) #:use-module (gnu services shepherd) + #:use-module (gnu services ssh) #:use-module (gnu packages admin) #:use-module (gnu packages bash) #:use-module (gnu packages bootloaders) @@ -262,6 +264,16 @@ You have been warned. Thanks for being so brave. ;; To facilitate copy/paste. (gpm-service) + ;; Add an SSH server to facilitate remote installs. + (service openssh-service-type + (openssh-configuration + (port-number 22) + (permit-root-login #t) + ;; The root account is passwordless, so make sure + ;; a password is set before allowing logins. + (allow-empty-passwords? #f) + (password-authentication? #t))) + ;; Since this is running on a USB stick with a unionfs as the root ;; file system, use an appropriate cache configuration. (nscd-service (nscd-configuration @@ -329,6 +341,7 @@ Use Alt-F2 for documentation. (base-pam-services #:allow-empty-passwords? #t)) (packages (cons* (canonical-package glibc) ;for 'tzselect' & co. + shadow ;'passwd', for easy SSH access parted gptfdisk ddrescue grub ;mostly so xrefs to its manual work cryptsetup diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index dfe198e43e..3a5e76034a 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -268,6 +268,7 @@ loaded at boot time in the order in which they appear." "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions "nvme" ;for new SSD NVMe devices + "nls_iso8859-1" ;for `mkfs.fat`, et.al ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system)) '("pata_acpi" "pata_atiixp" ;for ATA controllers "isci") ;for SAS controllers like Intel C602 @@ -281,9 +282,6 @@ loaded at boot time in the order in which they appear." ,@(if (find (file-system-type-predicate "9p") file-systems) virtio-9p-modules '()) - ,@(if (find (file-system-type-predicate "vfat") file-systems) - '("nls_iso8859-1") - '()) ,@(if (find (file-system-type-predicate "btrfs") file-systems) '("btrfs") '()) diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm index 4546c1a73a..eedf933946 100644 --- a/gnu/system/pam.scm +++ b/gnu/system/pam.scm @@ -204,21 +204,27 @@ dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." (env (pam-entry ; to honor /etc/environment. (control "required") (module "pam_env.so")))) - (lambda* (name #:key allow-empty-passwords? motd) + (lambda* (name #:key allow-empty-passwords? (allow-root? #f) motd) "Return a standard Unix-style PAM service for NAME. When -ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When MOTD is true, it -should be a file-like object used as the message-of-the-day." +ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When ALLOW-ROOT? is +true, allow root to run the command without authentication. When MOTD is +true, it should be a file-like object used as the message-of-the-day." ;; 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))) + (auth (append (if allow-root? + (list (pam-entry + (control "sufficient") + (module "pam_rootok.so"))) + '()) + (list (if allow-empty-passwords? + (pam-entry + (control "required") + (module "pam_unix.so") + (arguments '("nullok"))) + unix)))) (password (list (pam-entry (control "required") (module "pam_unix.so") @@ -256,7 +262,12 @@ authenticate to run COMMAND." ;; These programs are setuid-root. (map (cut unix-pam-service <> #:allow-empty-passwords? allow-empty-passwords?) - '("su" "passwd" "sudo")) + '("passwd" "sudo")) + ;; This is setuid-root, as well. Allow root to run "su" without + ;; authenticating. + (list (unix-pam-service "su" + #:allow-empty-passwords? allow-empty-passwords? + #:allow-root? #t)) ;; These programs are not setuid-root, and we want root to be able ;; to run them without having to authenticate (notably because diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 1acfcc4866..b30ef8e390 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -220,7 +220,7 @@ set debug-file-directory ~/.guix-profile/lib/debug\n"))) (raise (condition (&message (message - (format #f (_ "supplementary group '~a' \ + (format #f (G_ "supplementary group '~a' \ of user '~a' is undeclared") group (user-account-name user)))))))) @@ -230,7 +230,7 @@ of user '~a' is undeclared") (raise (condition (&message (message - (format #f (_ "primary group '~a' \ + (format #f (G_ "primary group '~a' \ of user '~a' is undeclared") (user-account-group user) (user-account-name user))))))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 5c6e7f684a..ad5e6b75bb 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -2,6 +2,8 @@ ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name> +;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,10 +47,11 @@ #:select (%guile-static-stripped)) #:use-module (gnu packages admin) + #:use-module (gnu bootloader) #:use-module (gnu system shadow) #:use-module (gnu system pam) #:use-module (gnu system linux-initrd) - #:use-module (gnu system grub) + #:use-module (gnu bootloader) #:use-module (gnu system file-systems) #:use-module (gnu system) #:use-module (gnu services) @@ -175,8 +178,9 @@ made available under the /xchg CIFS share." (disk-image-format "qcow2") (file-system-type "ext4") file-system-label - os-derivation - grub-configuration + os-drv + bootcfg-drv + bootloader (register-closures? #t) (inputs '()) copy-inputs?) @@ -200,7 +204,7 @@ the image." (guix build utils)) (let ((inputs - '#$(append (list qemu parted grub e2fsprogs) + '#$(append (list qemu parted e2fsprogs dosfstools) (map canonical-package (list sed grep coreutils findutils gawk)) (if register-closures? (list guix) '()))) @@ -222,17 +226,36 @@ the image." #:closures graphs #:copy-closures? #$copy-inputs? #:register-closures? #$register-closures? - #:system-directory #$os-derivation)) + #:system-directory #$os-drv)) (partitions (list (partition (size #$(- disk-image-size - (* 10 (expt 2 20)))) + (* 50 (expt 2 20)))) (label #$file-system-label) (file-system #$file-system-type) - (bootable? #t) - (initializer initialize))))) + (flags '(boot)) + (initializer initialize)) + ;; Append a small EFI System Partition for + ;; use with UEFI bootloaders. + (partition + ;; The standalone grub image is about 10MiB, but + ;; leave some room for custom or multiple images. + (size (* 40 (expt 2 20))) + (label "GNU-ESP") ;cosmetic only + ;; Use "vfat" here since this property is used + ;; when mounting. The actual FAT-ness is based + ;; on filesystem size (16 in this case). + (file-system "vfat") + (flags '(esp)))))) (initialize-hard-disk "/dev/vda" #:partitions partitions - #:grub.cfg #$grub-configuration) + #:grub-efi #$grub-efi + #:bootloader-package + #$(bootloader-package bootloader) + #:bootcfg #$bootcfg-drv + #:bootcfg-location + #$(bootloader-configuration-file bootloader) + #:bootloader-installer + #$(bootloader-installer bootloader)) (reboot))))) #:system system #:make-disk-image? #t @@ -284,10 +307,12 @@ to USB sticks meant to be read-only." file-systems-to-keep))))) (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (grub.cfg (operating-system-grub.cfg os))) + (bootcfg (operating-system-bootcfg os))) (qemu-image #:name name - #:os-derivation os-drv - #:grub-configuration grub.cfg + #:os-drv os-drv + #:bootcfg-drv bootcfg + #:bootloader (bootloader-configuration-bootloader + (operating-system-bootloader os)) #:disk-image-size disk-image-size #:disk-image-format "raw" #:file-system-type file-system-type @@ -295,7 +320,7 @@ to USB sticks meant to be read-only." #:copy-inputs? #t #:register-closures? #t #:inputs `(("system" ,os-drv) - ("grub.cfg" ,grub.cfg)))))) + ("bootcfg" ,bootcfg)))))) (define* (system-qemu-image os #:key @@ -328,13 +353,15 @@ of the GNU system as described by OS." file-systems-to-keep))))) (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (grub.cfg (operating-system-grub.cfg os))) - (qemu-image #:os-derivation os-drv - #:grub-configuration grub.cfg + (bootcfg (operating-system-bootcfg os))) + (qemu-image #:os-drv os-drv + #:bootcfg-drv bootcfg + #:bootloader (bootloader-configuration-bootloader + (operating-system-bootloader os)) #:disk-image-size disk-image-size #:file-system-type file-system-type #:inputs `(("system" ,os-drv) - ("grub.cfg" ,grub.cfg)) + ("bootcfg" ,bootcfg)) #:copy-inputs? #t)))) @@ -423,16 +450,18 @@ When FULL-BOOT? is true, return an image that does a complete boot sequence, bootloaded included; thus, make a disk image that contains everything the bootloader refers to: OS kernel, initrd, bootloader data, etc." (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (grub.cfg (operating-system-grub.cfg os))) + (bootcfg (operating-system-bootcfg os))) ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains - ;; GRUB.CFG and all its dependencies, including the output of OS-DRV. + ;; BOOTCFG and all its dependencies, including the output of OS-DRV. ;; This is more than needed (we only need the kernel, initrd, GRUB for its ;; font, and the background image), but it's hard to filter that. - (qemu-image #:os-derivation os-drv - #:grub-configuration grub.cfg + (qemu-image #:os-drv os-drv + #:bootcfg-drv bootcfg + #:bootloader (bootloader-configuration-bootloader + (operating-system-bootloader os)) #:disk-image-size disk-image-size #:inputs (if full-boot? - `(("grub.cfg" ,grub.cfg)) + `(("bootcfg" ,bootcfg)) '()) ;; XXX: Passing #t here is too slow, so let it off by default. @@ -470,7 +499,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." (mappings '()) full-boot? (disk-image-size - (* (if full-boot? 500 30) + (* (if full-boot? 500 70) (expt 2 20)))) "Return a derivation that builds a script to run a virtual machine image of OS that shares its store with the host. @@ -489,11 +518,8 @@ it is mostly useful when FULL-BOOT? is true." #:full-boot? full-boot? #:disk-image-size disk-image-size))) (define kernel-arguments - #~(list "--root=/dev/vda1" - (string-append "--system=" #$os-drv) - (string-append "--load=" #$os-drv "/boot") - #$@(if graphic? #~() #~("console=ttyS0")) - #+@(operating-system-kernel-arguments os))) + #~(list #$@(if graphic? #~() #~("console=ttyS0")) + #+@(operating-system-kernel-arguments os os-drv "/dev/vda1"))) (define qemu-exec #~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system))) |