From 641f9a2a1f3a1ad0b4c3003a2efc5c7975286cc1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 21 May 2014 23:31:46 +0200 Subject: vm: Modularize build-side code. * guix/build/install.scm (install-grub): Call 'error' if 'system*' returns non-zero. * guix/build/vm.scm (initialize-partition-table): Make 'partition-size' a positional parameter. Call 'error' when 'system*' returns non-zero'. (format-partition, initialize-root-partition): New procedures. (initialize-hard-disk): Use them. --- guix/build/install.scm | 10 +++-- guix/build/vm.scm | 102 ++++++++++++++++++++++++++++--------------------- 2 files changed, 64 insertions(+), 48 deletions(-) (limited to 'guix') 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-module (guix build install) (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 @@ (define* (install-grub grub.cfg device mount-point) (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 @@ (define-module (guix build vm) #: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 @@ (define (read-reference-graph port) (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 @@ (define (graph-from-file file) (define MS_BIND 4096) ; 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 @@ (define 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. -- cgit v1.2.3