diff options
| -rw-r--r-- | gnu/system/vm.scm | 15 | ||||
| -rw-r--r-- | guix/build/install.scm | 17 | ||||
| -rw-r--r-- | guix/build/vm.scm | 9 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 2 |
4 files changed, 30 insertions, 13 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 4e7c439894..3c9c9c83e1 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -197,6 +197,7 @@ made available under the /xchg CIFS share." (disk-image-format "qcow2") (file-system-type "ext4") file-system-label + os-derivation grub-configuration (register-closures? #t) (inputs '()) @@ -204,9 +205,9 @@ made available under the /xchg CIFS share." "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE. Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root -partition. The returned image is a full disk image, with a GRUB installation -that uses GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION -must be the name of a file in the VM.) +partition. The returned image is a full disk image that runs OS-DERIVATION, +with a GRUB installation that uses GRUB-CONFIGURATION as its configuration +file (GRUB-CONFIGURATION must be the name of a file in the VM.) INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, @@ -240,6 +241,7 @@ the image." (((names . _) ...) names)))) (initialize-hard-disk "/dev/vda" + #:system-directory #$os-derivation #:grub.cfg #$grub-configuration #:closures graphs #:copy-closures? #$copy-inputs? @@ -298,6 +300,7 @@ to USB sticks meant to be read-only." (mlet* %store-monad ((os-drv (operating-system-derivation os)) (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:name name + #:os-derivation os-drv #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:disk-image-format "raw" @@ -334,7 +337,8 @@ of the GNU system as described by OS." (mlet* %store-monad ((os-drv (operating-system-derivation os)) (grub.cfg (operating-system-grub.cfg os))) - (qemu-image #:grub-configuration grub.cfg + (qemu-image #:os-derivation os-drv + #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:file-system-type file-system-type #:inputs `(("system" ,os-drv) @@ -376,7 +380,8 @@ with the host." (mlet* %store-monad ((os-drv (operating-system-derivation os)) (grub.cfg (operating-system-grub.cfg os))) - (qemu-image #:grub-configuration grub.cfg + (qemu-image #:os-derivation os-drv + #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:inputs `(("system" ,os-drv)) diff --git a/guix/build/install.scm b/guix/build/install.scm index 2a76394faa..ae51ebe48c 100644 --- a/guix/build/install.scm +++ b/guix/build/install.scm @@ -83,21 +83,30 @@ STORE." (directory "/var/empty") ; for no-login accounts (directory "/var/run") (directory "/run") + (directory "/var/guix/profiles/per-user/root" 0 0) + + ;; Link to the initial system generation. + ("/var/guix/profiles/system" -> "system-1-link") + ("/var/guix/gcroots/booted-system" -> "/run/booted-system") ("/var/guix/gcroots/current-system" -> "/run/current-system") + (directory "/bin") ("/bin/sh" -> "/run/current-system/profile/bin/bash") (directory "/tmp" 0 0 #o1777) ; sticky bit - (directory "/var/guix/profiles/per-user/root" 0 0) (directory "/root" 0 0) ; an exception (directory "/home" 0 0))) -(define (populate-root-file-system target) +(define (populate-root-file-system system target) "Make the essential non-store files and directories on TARGET. This -includes /etc, /var, /run, /bin/sh, etc." +includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (for-each (cut evaluate-populate-directive <> target) - (directives (%store-directory)))) + (directives (%store-directory))) + + ;; Add system generation 1. + (symlink system + (string-append target "/var/guix/profiles/system-1-link"))) (define (reset-timestamps directory) "Reset the timestamps of all the files under DIRECTORY, so that they appear diff --git a/guix/build/vm.scm b/guix/build/vm.scm index c1deb35664..805ce10bf9 100644 --- a/guix/build/vm.scm +++ b/guix/build/vm.scm @@ -172,7 +172,7 @@ volume name." (define* (initialize-root-partition target-directory #:key copy-closures? register-closures? - closures) + closures system-directory) "Initialize the root partition mounted at TARGET-DIRECTORY." (define target-store (string-append target-directory (%store-directory))) @@ -203,10 +203,11 @@ volume name." ;; Add the non-store directories and files. (display "populating...\n") - (populate-root-file-system target-directory)) + (populate-root-file-system system-directory target-directory)) (define* (initialize-hard-disk device #:key + system-directory grub.cfg disk-image-size (file-system-type "ext4") @@ -218,7 +219,8 @@ volume name." partition with (optionally) FILE-SYSTEM-LABEL as its volume name, and with GRUB installed. If REGISTER-CLOSURES? is true, register all of CLOSURES is the partition's store. If COPY-CLOSURES? is true, copy all of CLOSURES to the -partition." +partition. SYSTEM-DIRECTORY is the name of the directory of the 'system' +derivation." (define target-directory "/fs") @@ -236,6 +238,7 @@ partition." (mount partition target-directory file-system-type) (initialize-root-partition target-directory + #:system-directory system-directory #:copy-closures? copy-closures? #:register-closures? register-closures? #:closures closures) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index fc947e4016..0c1bff94b6 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -116,7 +116,7 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG." ;; Create a bunch of additional files. (format log-port "populating '~a'...~%" target) - (populate-root-file-system target) + (populate-root-file-system os-dir target) (when grub? (unless (false-if-exception (install-grub grub.cfg device target)) |