From ee2a5da80a9bda25542c00a7a35a9ddddcbd58af Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 19 Jan 2021 18:09:28 +0100 Subject: scripts: system: Remove 'vm-image' command. Remove the 'vm-image' command that has been superseded by the 'image' command. * gnu/system/vm.scm (system-qemu-image): Remove it. * guix/scripts/system.scm (system-derivation-for-action): Mark 'vm-image' command as deprecated and use the image API to produce the VM image. (perform-action, show-help): Adapt accordingly. * tests/guix-system.sh: Ditto. * doc/guix.texi (Invoking guix system, Running Guix in a VM): Ditto. * etc/completion/fish/guix.fish: Ditto. * etc/completion/zsh/_guix: Ditto. --- gnu/system/vm.scm | 63 ------------------------------------------------------- 1 file changed, 63 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 1afae6b4ed..d7ae048b81 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -73,7 +73,6 @@ #:export (expression->derivation-in-linux-vm qemu-image virtualized-operating-system - system-qemu-image system-qemu-image/shared-store system-qemu-image/shared-store-script @@ -557,68 +556,6 @@ the operating system." #:single-file-output? #t #:references-graphs `((,graph ,os))))) - -;;; -;;; VM and disk images. -;;; - -(define* (system-qemu-image os - #:key - (file-system-type "ext4") - (disk-image-size (* 900 (expt 2 20)))) - "Return the derivation of a freestanding QEMU image of DISK-IMAGE-SIZE bytes -of the GNU system as described by OS." - (define file-systems-to-keep - ;; Keep only file systems other than root and not normally bound to real - ;; devices. - (remove (lambda (fs) - (let ((target (file-system-mount-point fs)) - (source (file-system-device fs))) - (or (string=? target "/") - (and (string? source) - (string-prefix? "/dev/" source)) - (uuid? source) - (file-system-label? source)))) - (operating-system-file-systems os))) - - (define root-uuid - ;; UUID of the root file system. - (operating-system-uuid os - (if (string=? file-system-type "iso9660") - 'iso9660 - 'dce))) - - - (let* ((os (operating-system - (inherit os) - - ;; As in 'virtualized-operating-system', use BIOS-style GRUB. - (bootloader (bootloader-configuration - (bootloader grub-bootloader) - (target "/dev/vda"))) - - ;; Assume we have an initrd with the whole QEMU shebang. - - ;; Force our own root file system. Refer to it by UUID so that - ;; it works regardless of how the image is used ("qemu -hda", - ;; Xen, etc.). - (file-systems (cons (file-system - (mount-point "/") - (device root-uuid) - (type file-system-type)) - file-systems-to-keep)))) - (bootcfg (operating-system-bootcfg os))) - (qemu-image #:os os - #:bootcfg-drv bootcfg - #:bootloader (bootloader-configuration-bootloader - (operating-system-bootloader os)) - #:disk-image-size disk-image-size - #:file-system-type file-system-type - #:file-system-uuid root-uuid - #:inputs `(("system" ,os) - ("bootcfg" ,bootcfg)) - #:copy-inputs? #t))) - ;;; ;;; VMs that share file systems with the host. -- cgit v1.2.3 From 6e8cdf1d26092cb9654e179b04730fff7c15c94f Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 20 Jan 2021 10:56:08 +0100 Subject: scripts: system: Accept records as input. * guix/scripts/system.scm (system-derivation-for-action): Replace "os" argument by "image". Remove "image-size", "image-type", "label" and "volatile-root?" arguments. (perform-action): Ditto. (process-action): Construct the record and pass it to "perform-action" procedure. * tests/guix-system.sh: Adapt accordingly. * gnu/system/images/hurd.scm: Return the default image. * gnu/system/images/novena.scm: Ditto. * gnu/system/images/pine64.scm: Ditto. * gnu/system/images/pinebook-pro.scm Ditto. --- gnu/system/images/hurd.scm | 3 + gnu/system/images/novena.scm | 3 + gnu/system/images/pine64.scm | 3 + gnu/system/images/pinebook-pro.scm | 3 + guix/scripts/system.scm | 132 ++++++++++++++++++------------------- tests/guix-system.sh | 7 +- 6 files changed, 80 insertions(+), 71 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index 4417952c5d..eac5b7f7e6 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -111,3 +111,6 @@ (inherit (os->image hurd-barebones-os #:type hurd-qcow2-image-type)) (name 'hurd-barebones.qcow2))) + +;; Return the default image. +hurd-barebones-qcow2-image diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm index dfaf2c60ee..1cd724ff88 100644 --- a/gnu/system/images/novena.scm +++ b/gnu/system/images/novena.scm @@ -59,3 +59,6 @@ (inherit (os->image novena-barebones-os #:type novena-image-type)) (name 'novena-barebones-raw-image))) + +;; Return the default image. +novena-barebones-raw-image diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm index 63b31399a5..613acd5cfd 100644 --- a/gnu/system/images/pine64.scm +++ b/gnu/system/images/pine64.scm @@ -64,3 +64,6 @@ (inherit (os->image pine64-barebones-os #:type pine64-image-type)) (name 'pine64-barebones-raw-image))) + +;; Return the default image. +pine64-barebones-raw-image diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm index 22997fd742..b56a7ea409 100644 --- a/gnu/system/images/pinebook-pro.scm +++ b/gnu/system/images/pinebook-pro.scm @@ -66,3 +66,6 @@ (inherit (os->image pinebook-pro-barebones-os #:type pinebook-pro-image-type)) (name 'pinebook-pro-barebones-raw-image))) + +;; Return the default image. +pinebook-pro-barebones-raw-image diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index ead20a071e..e3cf99acc6 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -680,13 +680,15 @@ checking this by themselves in their 'check' procedure." ;;; Action. ;;; -(define* (system-derivation-for-action os action - #:key image-size image-type - full-boot? container-shared-network? - mappings label - volatile-root?) - "Return as a monadic value the derivation for OS according to ACTION." - (mlet %store-monad ((target (current-target-system))) +(define* (system-derivation-for-action image action + #:key + full-boot? + container-shared-network? + mappings) + "Return as a monadic value the derivation for IMAGE according to ACTION." + (mlet %store-monad ((target (current-target-system)) + (os -> (image-operating-system image)) + (image-size -> (image-size image))) (case action ((build init reconfigure) (operating-system-derivation os)) @@ -704,25 +706,11 @@ checking this by themselves in their 'check' procedure." (* 70 (expt 2 20))) #:mappings mappings)) ((image disk-image vm-image) - (let* ((image-type (if (eq? action 'vm-image) - qcow2-image-type - image-type)) - (base-image (os->image os #:type image-type)) - (base-target (image-target base-image))) - (when (eq? action 'disk-image) - (warning (G_ "'disk-image' is deprecated: use 'image' instead~%"))) - (when (eq? action 'vm-image) - (warning (G_ "'vm-image' is deprecated: use 'image' instead~%"))) - (lower-object - (system-image - (image - (inherit (if label - (image-with-label base-image label) - base-image)) - (target (or base-target target)) - (size image-size) - (operating-system os) - (volatile-root? volatile-root?)))))) + (when (eq? action 'disk-image) + (warning (G_ "'disk-image' is deprecated: use 'image' instead~%"))) + (when (eq? action 'vm-image) + (warning (G_ "'vm-image' is deprecated: use 'image' instead~%"))) + (lower-object (system-image image))) ((docker-image) (system-docker-image os #:shared-network? container-shared-network?))))) @@ -768,7 +756,7 @@ and TARGET arguments." (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered)) (return (primitive-eval (lowered-gexp-sexp lowered)))))) -(define* (perform-action action os +(define* (perform-action action image #:key (validate-reconfigure ensure-forward-reconfigure) save-provenance? @@ -776,16 +764,13 @@ and TARGET arguments." install-bootloader? dry-run? derivations-only? use-substitutes? bootloader-target target - image-size image-type - volatile-root? - full-boot? label container-shared-network? + full-boot? + container-shared-network? (mappings '()) (gc-root #f)) - "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install + "Perform ACTION for IMAGE. INSTALL-BOOTLOADER? specifies whether to install bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the -target root directory; IMAGE-SIZE is the size of the image to be built, for -the 'image' action. IMAGE-TYPE is the type of image to be built. When -VOLATILE-ROOT? is #t, the root file system is mounted volatile. +target root directory. FULL-BOOT? is used for the 'vm' action; it determines whether to boot directly to the kernel or to the bootloader. CONTAINER-SHARED-NETWORK? @@ -807,6 +792,9 @@ static checks." '() (map boot-parameters->menu-entry (profile-boot-parameters)))) + (define os + (image-operating-system image)) + (define bootloader (operating-system-bootloader os)) @@ -829,11 +817,7 @@ static checks." (check-initrd-modules os))) (mlet* %store-monad - ((sys (system-derivation-for-action os action - #:label label - #:image-type image-type - #:image-size image-size - #:volatile-root? volatile-root? + ((sys (system-derivation-for-action image action #:full-boot? full-boot? #:container-shared-network? container-shared-network? #:mappings mappings)) @@ -1169,9 +1153,9 @@ Some ACTIONS support additional ARGS.\n")) ACTION must be one of the sub-commands that takes an operating system declaration as an argument (a file name.) OPTS is the raw alist of options resulting from command-line parsing." - (define (ensure-operating-system file-or-exp obj) - (unless (operating-system? obj) - (leave (G_ "'~a' does not return an operating system~%") + (define (ensure-operating-system-or-image file-or-exp obj) + (unless (or (operating-system? obj) (image? obj)) + (leave (G_ "'~a' does not return an operating system or an image~%") file-or-exp)) obj) @@ -1185,27 +1169,47 @@ resulting from command-line parsing." (expr (assoc-ref opts 'expression)) (system (assoc-ref opts 'system)) (target (assoc-ref opts 'target)) - (transform (if save-provenance? - (cut operating-system-with-provenance <> file) - identity)) - (os (transform - (ensure-operating-system - (or file expr) - (cond - ((and expr file) - (leave - (G_ "both file and expression cannot be specified~%"))) - (expr - (read/eval expr)) - (file - (load* file %user-module - #:on-error (assoc-ref opts 'on-error))) - (else - (leave (G_ "no configuration specified~%"))))))) - + (transform (lambda (obj) + (if (and save-provenance? (operating-system? obj)) + (operating-system-with-provenance obj file) + obj))) + (obj (transform + (ensure-operating-system-or-image + (or file expr) + (cond + ((and expr file) + (leave + (G_ "both file and expression cannot be specified~%"))) + (expr + (read/eval expr)) + (file + (load* file %user-module + #:on-error (assoc-ref opts 'on-error))) + (else + (leave (G_ "no configuration specified~%"))))))) (dry? (assoc-ref opts 'dry-run?)) (bootloader? (assoc-ref opts 'install-bootloader?)) (label (assoc-ref opts 'label)) + (image-type (lookup-image-type-by-name + (assoc-ref opts 'image-type))) + (image (let* ((image-type (if (eq? action 'vm-image) + qcow2-image-type + image-type)) + (image-size (assoc-ref opts 'image-size)) + (volatile? (assoc-ref opts 'volatile-root?)) + (base-image (if (operating-system? obj) + (os->image obj + #:type image-type) + obj)) + (base-target (image-target base-image))) + (image + (inherit (if label + (image-with-label base-image label) + base-image)) + (target (or base-target target)) + (size image-size) + (volatile-root? volatile?)))) + (os (image-operating-system image)) (target-file (match args ((first second) second) (_ #f))) @@ -1241,7 +1245,7 @@ resulting from command-line parsing." (warn-about-old-distro #:suggested-command "guix system reconfigure")) - (perform-action action os + (perform-action action image #:dry-run? dry? #:derivations-only? (assoc-ref opts 'derivations-only?) @@ -1250,11 +1254,6 @@ resulting from command-line parsing." (assoc-ref opts 'skip-safety-checks?) #:validate-reconfigure (assoc-ref opts 'validate-reconfigure) - #:image-type (lookup-image-type-by-name - (assoc-ref opts 'image-type)) - #:image-size (assoc-ref opts 'image-size) - #:volatile-root? - (assoc-ref opts 'volatile-root?) #:full-boot? (assoc-ref opts 'full-boot?) #:container-shared-network? (assoc-ref opts 'container-shared-network?) @@ -1264,7 +1263,6 @@ resulting from command-line parsing." (_ #f)) opts) #:install-bootloader? bootloader? - #:label label #:target target-file #:bootloader-target bootloader-target #:gc-root (assoc-ref opts 'gc-root))))) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 8bc0dcf2fc..238c8929a8 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -337,12 +337,11 @@ for example in gnu/system/examples/*.tmpl; do guix system -n disk-image $target "$example" done -# Verify that the disk image types can be built. +# Verify that the images can be built. guix system -n vm gnu/system/examples/vm-image.tmpl +guix system -n image gnu/system/images/pinebook-pro.scm guix system -n image -t qcow2 gnu/system/examples/vm-image.tmpl -# This invocation was taken care of in the loop above: -# guix system -n disk-image gnu/system/examples/bare-bones.tmpl -guix system -n disk-image -t iso9660 gnu/system/examples/bare-bones.tmpl +guix system -n image -t iso9660 gnu/system/examples/bare-bones.tmpl guix system -n docker-image gnu/system/examples/docker-image.tmpl # Verify that at least the raw image type is available. -- cgit v1.2.3 From 4ac9db0d75edcacb3a0c98659620cfea3c1e1993 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sun, 21 Feb 2021 21:15:05 +0100 Subject: image: Add rock64 support. * gnu/system/images/rock64.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Adjust accordingly. --- gnu/local.mk | 1 + gnu/system/images/rock64.scm | 64 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+) create mode 100644 gnu/system/images/rock64.scm (limited to 'gnu/system') diff --git a/gnu/local.mk b/gnu/local.mk index 95d5835fa4..b8bccc1b7c 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -664,6 +664,7 @@ GNU_SYSTEM_MODULES = \ %D%/system/images/novena.scm \ %D%/system/images/pine64.scm \ %D%/system/images/pinebook-pro.scm \ + %D%/system/images/rock64.scm \ \ %D%/machine.scm \ \ diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm new file mode 100644 index 0000000000..3f193e8528 --- /dev/null +++ b/gnu/system/images/rock64.scm @@ -0,0 +1,64 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Marius Bakke +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu system images rock64) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader u-boot) + #:use-module (gnu image) + #:use-module (gnu packages linux) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services networking) + #:use-module (gnu system) + #:use-module (gnu system file-systems) + #:use-module (gnu system image) + #:use-module (srfi srfi-26) + #:export (rock64-barebones-os + rock64-image-type + rock64-barebones-raw-image)) + +(define rock64-barebones-os + (operating-system + (host-name "jiehkkevarri") + (timezone "Europe/Oslo") + (locale "en_US.utf8") + (bootloader (bootloader-configuration + (bootloader u-boot-rock64-rk3328-bootloader) + (target "/dev/sda"))) + (initrd-modules '()) + (kernel linux-libre-arm64-generic) + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (services (append (list (service dhcp-client-service-type)) + %base-services)))) + +(define rock64-image-type + (image-type + (name 'rock64-raw) + (constructor (cut image-with-os (arm64-disk-image (expt 2 24)) <>)))) + +(define rock64-barebones-raw-image + (image + (inherit + (os->image rock64-barebones-os #:type rock64-image-type)) + (name 'rock64-barebones-raw-image))) + +rock64-barebones-raw-image -- cgit v1.2.3 From 7c5e5e0e0fbf11ebaaeb8f98ed6c75289ca31795 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 14 Feb 2021 10:55:31 +0000 Subject: system: hurd: Have the static networking provision 'networking. Some services require networking, I'm looking at the Guix Build Coordinator agent. Networking seems to work in the childhurd VM, so I think this change makes sense. * gnu/system/hurd.scm (%base-services/hurd): Add 'networking to the provision parameter for the static-networking service. --- gnu/system/hurd.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/system') diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 8b46e65e31..8f3a27834b 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -79,7 +79,7 @@ (list (static-networking (interface "lo") (ip "127.0.0.1") (requirement '()) - (provision '(loopback)) + (provision '(loopback networking)) (name-servers '("10.0.2.3"))))) (syslog-service) (service guix-service-type -- cgit v1.2.3 From 60fd4118f7f01ac88bae1b44811afb34ea565685 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Feb 2021 11:25:57 +0100 Subject: system: vm: Use Guile 3.0 in Docker images. * gnu/system/vm.scm (system-docker-image): Use GUILE-3.0. --- gnu/system/vm.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index d7ae048b81..3d0935b3af 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2016 Christopher Allan Webber ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe @@ -480,7 +480,7 @@ the operating system." (program-file "boot-program" #~(let ((system (cadr (command-line)))) (setenv "GUIX_NEW_SYSTEM" system) - (execl #$(file-append guile-2.2 "/bin/guile") + (execl #$(file-append guile-3.0 "/bin/guile") "guile" "--no-auto-compile" (string-append system "/boot"))))) -- cgit v1.2.3