diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/install.scm | 11 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 111 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 94 |
3 files changed, 146 insertions, 70 deletions
diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 0a78d030dd..f9aa7f6733 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -277,7 +277,13 @@ You have been warned. Thanks for being so brave. ;; Since this is running on a USB stick with a unionfs as the root ;; file system, use an appropriate cache configuration. (nscd-service (nscd-configuration - (caches %nscd-minimal-caches)))))) + (caches %nscd-minimal-caches))) + + ;; Having /bin/sh is a good idea. In particular it allows Tramp + ;; connections to this system to work. + (service special-files-service-type + `(("/bin/sh" ,(file-append (canonical-package bash) + "/bin/sh"))))))) (define %issue ;; Greeting. @@ -300,7 +306,7 @@ Use Alt-F2 for documentation. ;; the appropriate one. (cons* (file-system (mount-point "/") - (device "gnu-disk-image") + (device "GuixSD") (title 'label) (type "ext4")) @@ -341,7 +347,6 @@ Use Alt-F2 for documentation. (base-pam-services #:allow-empty-passwords? #t)) (packages (cons* (canonical-package glibc) ;for 'tzselect' & co. - shadow ;'passwd', for easy SSH access parted gptfdisk ddrescue grub ;mostly so xrefs to its manual work cryptsetup diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 3a5e76034a..5a7aec5c87 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -68,24 +68,25 @@ the derivations referenced by EXP are automatically copied to the initrd." ;; General Linux overview in `Documentation/early-userspace/README' and ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. - (mlet %store-monad ((init (gexp->script "init" exp - #:guile guile))) - (define builder - (with-imported-modules (source-module-closure - '((gnu build linux-initrd))) - #~(begin - (use-modules (gnu build linux-initrd)) - - (mkdir #$output) - (build-initrd (string-append #$output "/initrd") - #:guile #$guile - #:init #$init - ;; Copy everything INIT refers to into the initrd. - #:references-graphs '("closure") - #:gzip (string-append #$gzip "/bin/gzip"))))) - - (gexp->derivation name builder - #:references-graphs `(("closure" ,init))))) + (define init + (program-file "init" exp #:guile guile)) + + (define builder + (with-imported-modules (source-module-closure + '((gnu build linux-initrd))) + #~(begin + (use-modules (gnu build linux-initrd)) + + (mkdir #$output) + (build-initrd (string-append #$output "/initrd") + #:guile #$guile + #:init #$init + ;; Copy everything INIT refers to into the initrd. + #:references-graphs '("closure") + #:gzip (string-append #$gzip "/bin/gzip"))))) + + (gexp->derivation name builder + #:references-graphs `(("closure" ,init)))) (define (flat-linux-module-directory linux modules) "Return a flat directory containing the Linux kernel modules listed in @@ -132,7 +133,7 @@ MODULES and taken from LINUX." (basename module)))) (delete-duplicates modules))))) - (gexp->derivation "linux-modules" build-exp)) + (computed-file "linux-modules" build-exp)) (define* (raw-initrd file-systems #:key @@ -165,40 +166,41 @@ to it are lost." (open source target))) mapped-devices)) - (mlet %store-monad ((kodir (flat-linux-module-directory linux - linux-modules))) - (expression->initrd - (with-imported-modules (source-module-closure - '((gnu build linux-boot) - (guix build utils) - (guix build bournish) - (gnu build file-systems))) - #~(begin - (use-modules (gnu build linux-boot) - (guix build utils) - (guix build bournish) ;add the 'bournish' meta-command - (srfi srfi-26) - - ;; FIXME: The following modules are for - ;; LUKS-DEVICE-MAPPING. We should instead propagate - ;; this info via gexps. - ((gnu build file-systems) - #:select (find-partition-by-luks-uuid)) - (rnrs bytevectors)) - - (with-output-to-port (%make-void-port "w") - (lambda () - (set-path-environment-variable "PATH" '("bin" "sbin") - '#$helper-packages))) - - (boot-system #:mounts '#$(map file-system->spec file-systems) - #:pre-mount (lambda () - (and #$@device-mapping-commands)) - #:linux-modules '#$linux-modules - #:linux-module-directory '#$kodir - #:qemu-guest-networking? #$qemu-networking? - #:volatile-root? '#$volatile-root?))) - #:name "raw-initrd"))) + (define kodir + (flat-linux-module-directory linux linux-modules)) + + (expression->initrd + (with-imported-modules (source-module-closure + '((gnu build linux-boot) + (guix build utils) + (guix build bournish) + (gnu build file-systems))) + #~(begin + (use-modules (gnu build linux-boot) + (guix build utils) + (guix build bournish) ;add the 'bournish' meta-command + (srfi srfi-26) + + ;; FIXME: The following modules are for + ;; LUKS-DEVICE-MAPPING. We should instead propagate + ;; this info via gexps. + ((gnu build file-systems) + #:select (find-partition-by-luks-uuid)) + (rnrs bytevectors)) + + (with-output-to-port (%make-void-port "w") + (lambda () + (set-path-environment-variable "PATH" '("bin" "sbin") + '#$helper-packages))) + + (boot-system #:mounts '#$(map file-system->spec file-systems) + #:pre-mount (lambda () + (and #$@device-mapping-commands)) + #:linux-modules '#$linux-modules + #:linux-module-directory '#$kodir + #:qemu-guest-networking? #$qemu-networking? + #:volatile-root? '#$volatile-root?))) + #:name "raw-initrd")) (define* (file-system-packages file-systems #:key (volatile-root? #f)) "Return the list of statically-linked, stripped packages to check @@ -285,6 +287,9 @@ loaded at boot time in the order in which they appear." ,@(if (find (file-system-type-predicate "btrfs") file-systems) '("btrfs") '()) + ,@(if (find (file-system-type-predicate "iso9660") file-systems) + '("isofs") + '()) ,@(if volatile-root? '("fuse") '()) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 7ac8696158..66a2448ceb 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -34,6 +34,7 @@ #:select (qemu-command)) #:use-module (gnu packages base) #:use-module (gnu packages bootloaders) + #:use-module (gnu packages cdrom) #:use-module (gnu packages guile) #:use-module (gnu packages gawk) #:use-module (gnu packages bash) @@ -174,6 +175,52 @@ made available under the /xchg CIFS share." #:guile-for-build guile-for-build #:references-graphs references-graphs))) +(define* (iso9660-image #:key + (name "iso9660-image") + file-system-label + file-system-uuid + (system (%current-system)) + (qemu qemu-minimal) + os-drv + bootcfg-drv + bootloader + (inputs '())) + "Return a bootable, stand-alone iso9660 image. + +INPUTS is a list of inputs (as for packages)." + (expression->derivation-in-linux-vm + name + (with-imported-modules (source-module-closure '((gnu build vm) + (guix build utils))) + #~(begin + (use-modules (gnu build vm) + (guix build utils)) + + (let ((inputs + '#$(append (list qemu parted e2fsprogs dosfstools xorriso) + (map canonical-package + (list sed grep coreutils findutils gawk)))) + + ;; This variable is unused but allows us to add INPUTS-TO-COPY + ;; as inputs. + (to-register + '#$(map (match-lambda + ((name thing) thing) + ((name thing output) `(,thing ,output))) + inputs))) + + (set-path-environment-variable "PATH" '("bin" "sbin") inputs) + (make-iso9660-image #$(bootloader-package bootloader) + #$bootcfg-drv + #$os-drv + "/xchg/guixsd.iso" + #:volume-id #$file-system-label + #:volume-uuid #$file-system-uuid) + (reboot)))) + #:system system + #:make-disk-image? #f + #:references-graphs inputs)) + (define* (qemu-image #:key (name "qemu-image") (system (%current-system)) @@ -288,11 +335,17 @@ the image." system described by OS. Said image can be copied on a USB stick as is. When VOLATILE? is true, the root file system is made volatile; this is useful to USB sticks meant to be read-only." + (define normalize-label + ;; ISO labels are all-caps (case-insensitive), but since + ;; 'find-partition-by-label' is case-sensitive, make it all-caps here. + (if (string=? "iso9660" file-system-type) + string-upcase + identity)) (define root-label ;; Volume name of the root file system. Since we don't know which device ;; will hold it, we use the volume name to find it (using the UUID would ;; be even better, but somewhat less convenient.) - "gnu-disk-image") + (normalize-label "GuixSD")) (define file-systems-to-keep (remove (lambda (fs) @@ -318,19 +371,32 @@ to USB sticks meant to be read-only." (mlet* %store-monad ((os-drv (operating-system-derivation os)) (bootcfg (operating-system-bootcfg os))) - (qemu-image #:name name - #:os-drv os-drv - #:bootcfg-drv bootcfg - #:bootloader (bootloader-configuration-bootloader - (operating-system-bootloader os)) - #:disk-image-size disk-image-size - #:disk-image-format "raw" - #:file-system-type file-system-type - #:file-system-label root-label - #:copy-inputs? #t - #:register-closures? #t - #:inputs `(("system" ,os-drv) - ("bootcfg" ,bootcfg)))))) + (if (string=? "iso9660" file-system-type) + (iso9660-image #:name name + #:file-system-label root-label + #:file-system-uuid #f + #:os-drv os-drv + #:bootcfg-drv bootcfg + #:bootloader (bootloader-configuration-bootloader + (operating-system-bootloader os)) + #:inputs `(("system" ,os-drv) + ("bootcfg" ,bootcfg))) + (qemu-image #:name name + #:os-drv os-drv + #:bootcfg-drv bootcfg + #:bootloader (bootloader-configuration-bootloader + (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-label root-label + #:copy-inputs? #t + #:register-closures? #t + #:inputs `(("system" ,os-drv) + ("bootcfg" ,bootcfg))))))) (define* (system-qemu-image os #:key |