From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:37038) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dmwNB-0007SO-NP for guix-patches@gnu.org; Wed, 30 Aug 2017 02:21:10 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dmwN5-0003da-5D for guix-patches@gnu.org; Wed, 30 Aug 2017 02:21:09 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:52701) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dmwN5-0003dW-1B for guix-patches@gnu.org; Wed, 30 Aug 2017 02:21:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dmwN4-0000xn-R2 for guix-patches@gnu.org; Wed, 30 Aug 2017 02:21:02 -0400 Subject: [bug#28288] [PATCH 2/2] WIP Resent-Message-ID: From: Christopher Baines Date: Wed, 30 Aug 2017 07:20:10 +0100 Message-Id: <20170830062010.11902-2-mail@cbaines.net> In-Reply-To: <20170830062010.11902-1-mail@cbaines.net> References: <20170830062010.11902-1-mail@cbaines.net> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 28288@debbugs.gnu.org --- gnu/build/vm.scm | 19 +++++++++++++++++-- gnu/system/vm.scm | 16 +++++++++++----- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index 727494ad9..e2659cb5e 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -366,12 +366,27 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." (error "failed to create GRUB EFI image")))) (define* (make-iso9660-image grub config-file os-drv target - #:key (volume-id "GuixSD_image") (volume-uuid #f)) + #:key (volume-id "GuixSD_image") (volume-uuid #f) + register-closures? (closures '())) "Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as GRUB configuration and OS-DRV as the stuff in it." - (let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue"))) + (let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue")) + (target-store (string-append "/tmp/root" (%store-directory)))) (mkdir-p "/tmp/root/var/run") (mkdir-p "/tmp/root/run") + + ;; XXX: 'guix-register' wants to palpate the things it registers, so + ;; bind-mount the store on the target. + (mkdir-p target-store) + (mount (%store-directory) target-store "" MS_BIND) + + (when register-closures? + (display "registering closures...\n") + (for-each (lambda (closure) + (register-closure target + (string-append "/xchg/" closure))) + closures)) + (unless (zero? (apply system* `(,grub-mkrescue "-o" ,target ,(string-append "boot/grub/grub.cfg=" config-file) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 4494af003..b106dff0a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -192,6 +192,7 @@ made available under the /xchg CIFS share." os-drv bootcfg-drv bootloader + register-closures? (inputs '())) "Return a bootable, stand-alone iso9660 image. @@ -207,8 +208,13 @@ INPUTS is a list of inputs (as for packages)." (let ((inputs '#$(append (list qemu parted e2fsprogs dosfstools xorriso) (map canonical-package - (list sed grep coreutils findutils gawk)))) + (list sed grep coreutils findutils gawk)) + (if register-closures? (list guix) '()))) + + (graphs '#$(match inputs + (((names . _) ...) + names))) ;; This variable is unused but allows us to add INPUTS-TO-COPY ;; as inputs. (to-register @@ -222,6 +228,8 @@ INPUTS is a list of inputs (as for packages)." #$bootcfg-drv #$os-drv "/xchg/guixsd.iso" + #:register-closures? #$register-closures? + #:closures graphs #:volume-id #$file-system-label #:volume-uuid #$file-system-uuid) (reboot)))) @@ -391,6 +399,7 @@ to USB sticks meant to be read-only." #:file-system-label root-label #:file-system-uuid #f #:os-drv os-drv + #:register-closures? #t #:bootcfg-drv bootcfg #:bootloader (bootloader-configuration-bootloader (operating-system-bootloader os)) @@ -403,10 +412,7 @@ to USB sticks meant to be read-only." (operating-system-bootloader os)) #:disk-image-size disk-image-size #:disk-image-format "raw" - #:file-system-type (if (string=? "iso9660" - file-system-type) - "ext4" - file-system-type) + #:file-system-type file-system-type #:file-system-label root-label #:copy-inputs? #t #:register-closures? #t -- 2.14.1