diff options
| -rw-r--r-- | guix/build/install.scm | 10 | ||||
| -rw-r--r-- | guix/build/vm.scm | 102 |
2 files changed, 64 insertions, 48 deletions
diff --git a/guix/build/install.scm b/guix/build/install.scm index f61c16f13a..663a87b4b5 100644 --- a/guix/build/install.scm +++ b/guix/build/install.scm @@ -37,7 +37,7 @@ (define* (install-grub grub.cfg device mount-point) "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on -MOUNT-POINT. Return #t on success." +MOUNT-POINT." (let* ((target (string-append mount-point "/boot/grub/grub.cfg")) (pivot (string-append target ".new"))) (mkdir-p (dirname target)) @@ -47,9 +47,11 @@ MOUNT-POINT. Return #t on success." (copy-file grub.cfg pivot) (rename-file pivot target) - (zero? (system* "grub-install" "--no-floppy" - "--boot-directory" (string-append mount-point "/boot") - device)))) + (unless (zero? (system* "grub-install" "--no-floppy" + "--boot-directory" + (string-append mount-point "/boot") + device)) + (error "failed to install GRUB")))) (define (evaluate-populate-directive directive target) "Evaluate DIRECTIVE, an sexp describing a file or directory to create under diff --git a/guix/build/vm.scm b/guix/build/vm.scm index 3c51ff8f34..2a8843c633 100644 --- a/guix/build/vm.scm +++ b/guix/build/vm.scm @@ -25,6 +25,9 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (load-in-linux-vm + format-partition + initialize-root-partition + initialize-partition-table initialize-hard-disk)) ;;; Commentary: @@ -113,16 +116,20 @@ The data at PORT is the format produced by #:references-graphs." (loop (read-line port) result))))) -(define* (initialize-partition-table device +(define* (initialize-partition-table device partition-size #:key (label-type "msdos") - partition-size) + (offset (expt 2 20))) "Create on DEVICE a partition table of type LABEL-TYPE, with a single -partition of PARTITION-SIZE MiB. Return #t on success." - (display "creating partition table...\n") - (zero? (system* "parted" device "mklabel" label-type - "mkpart" "primary" "ext2" "1MiB" - (format #f "~aB" partition-size)))) +partition of PARTITION-SIZE bytes starting at OFFSET bytes. Return #t on +success." + (format #t "creating partition table with a ~a B partition...\n" + partition-size) + (unless (zero? (system* "parted" device "mklabel" label-type + "mkpart" "primary" "ext2" + (format #f "~aB" offset) + (format #f "~aB" partition-size))) + (error "failed to create partition table"))) (define* (populate-store reference-graphs target) "Populate the store under directory TARGET with the items specified in @@ -146,43 +153,19 @@ REFERENCE-GRAPHS, a list of reference-graph files." (define MS_BIND 4096) ; <sys/mounts.h> again! -(define* (initialize-hard-disk device - #:key - grub.cfg - disk-image-size - (file-system-type "ext4") - (closures '()) - copy-closures? - (register-closures? #t) - (directives '())) - "Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a -FILE-SYSTEM-TYPE partition, 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. Lastly, apply DIRECTIVES to -further populate the partition." - (define target-directory - "/fs") +(define (format-partition partition type) + "Create a file system TYPE on PARTITION." + (format #t "creating ~a partition...\n" type) + (unless (zero? (system* (string-append "mkfs." type) "-F" partition)) + (error "failed to create partition"))) +(define* (initialize-root-partition target-directory + #:key copy-closures? register-closures? + closures) + "Initialize the root partition mounted at TARGET-DIRECTORY." (define target-store (string-append target-directory (%store-directory))) - (define partition - (string-append device "1")) - - (unless (initialize-partition-table device - #:partition-size - (- disk-image-size (* 5 (expt 2 20)))) - (error "failed to create partition table")) - - (format #t "creating ~a partition...\n" file-system-type) - (unless (zero? (system* (string-append "mkfs." file-system-type) - "-F" partition)) - (error "failed to create partition")) - - (display "mounting partition...\n") - (mkdir target-directory) - (mount partition target-directory file-system-type) - (when copy-closures? ;; Populate the store. (populate-store (map (cut string-append "/xchg/" <>) closures) @@ -207,12 +190,43 @@ further populate the partition." (unless copy-closures? (system* "umount" target-store))) - ;; Evaluate the POPULATE directives. + ;; Add the non-store directories and files. (display "populating...\n") - (populate-root-file-system target-directory) + (populate-root-file-system target-directory)) + +(define* (initialize-hard-disk device + #:key + grub.cfg + disk-image-size + (file-system-type "ext4") + (closures '()) + copy-closures? + (register-closures? #t)) + "Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a +FILE-SYSTEM-TYPE partition, 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." + (define target-directory + "/fs") + + (define partition + (string-append device "1")) + + (initialize-partition-table device + (- disk-image-size (* 5 (expt 2 20)))) + + (format-partition partition file-system-type) + + (display "mounting partition...\n") + (mkdir target-directory) + (mount partition target-directory file-system-type) + + (initialize-root-partition target-directory + #:copy-closures? copy-closures? + #:register-closures? register-closures? + #:closures closures) - (unless (install-grub grub.cfg device target-directory) - (error "failed to install GRUB")) + (install-grub grub.cfg device target-directory) ;; 'guix-register' resets timestamps and everything, so no need to do it ;; once more in that case. |