system: Install /var/guix/profiles/system-1-link on new systems.
* guix/build/install.scm (directives): Add /var/guix/profiles/system. (populate-root-file-system): Add 'system' parameter. Create /var/guix/profiles/system-1-link. * guix/scripts/system.scm (install): Pass OS-DIR to 'populate-root-file-system'. * guix/build/vm.scm (initialize-root-partition): Add #:system-directory parameter, and pass it to 'populate-root-file-system'. (initialize-hard-disk): Add #:system-directory parameter, and pass it to 'initialize-root-partition'. * gnu/system/vm.scm (qemu-image): Add #:os-derivation parameter and pass it to 'initialize-hard-disk'. (system-disk-image, system-qemu-image, system-qemu-image/shared-store): Pass #:os-derivation to 'qemu-image.
This commit is contained in:
Ludovic Courtès
parent
dff624230a
commit
f2c403eab6
@ -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))
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user