From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id 61zzOdjky14NGgAA0tVLHw (envelope-from ) for ; Mon, 25 May 2020 15:31:36 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id MJuGNdjky16JMAAA1q6Kng (envelope-from ) for ; Mon, 25 May 2020 15:31:36 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 28FA0940144 for ; Mon, 25 May 2020 15:31:36 +0000 (UTC) Received: from localhost ([::1]:50160 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jdF4h-0003hZ-0h for larch@yhetil.org; Mon, 25 May 2020 11:31:35 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:57472) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jdF4G-0003hM-19 for guix-devel@gnu.org; Mon, 25 May 2020 11:31:09 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51149) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jdF4F-0004Qe-Mr for guix-devel@gnu.org; Mon, 25 May 2020 11:31:07 -0400 Received: from [2a01:e0a:fa:a50:e5d3:131c:4654:9823] (port=52150 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jdF41-0007ei-O6 for guix-devel@gnu.org; Mon, 25 May 2020 11:31:05 -0400 From: Mathieu Othacehe To: guix-devel@gnu.org Subject: Providing a Guix System images catalog. Date: Mon, 25 May 2020 17:30:48 +0200 Message-ID: <875zckvxp3.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+larch=yhetil.org@gnu.org Sender: "Guix-devel" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-devel-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-devel-bounces@gnu.org X-Spam-Score: -1.01 X-TUID: dpTySbM9YEeH --=-=-= Content-Type: text/plain Hello, To build a Guix System image, one needs to pick an operating system file and call "guix system disk-image my-os.scm" to get an image. While this works fine on desktop, this is more tricky for the embedded devices. Which operating system to select in "examples" folder? What's the difference between --system and --target, which one should I use? My idea is to provide a catalog of images, that we would maintain (at least adding them to the CI). The image definition would select a default operating-system, an image type and a system/target to build/cross-build the image. This attached, wip patch, allows to run (on wip-hurd-vm branch): --8<---------------cut here---------------start------------->8--- guix system image hurd-disk-image --8<---------------cut here---------------end--------------->8--- instead of: --8<---------------cut here---------------start------------->8--- guix system disk-image --target=i586-pc-gnu gnu/system/examples/bare-hurd.tmpl --8<---------------cut here---------------end--------------->8--- and --8<---------------cut here---------------start------------->8--- guix system --list-images --8<---------------cut here---------------end--------------->8--- that for now reports: --8<---------------cut here---------------start------------->8--- The available images are: - hurd-disk-image --8<---------------cut here---------------end--------------->8--- We could extend it to other boards that we've been hacking on (beaglebone-black, pinebook-pro ...). Please tell me what do you think! Thanks, Mathieu --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-wip-system-Add-image-support.patch Content-Transfer-Encoding: quoted-printable >From 0eefcc0bef8fb950611ec5801a9f4d2e256b6b59 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 25 May 2020 17:18:23 +0200 Subject: [PATCH] wip: system: Add "--image " support. This allows to run: guix system --list-images to get a list of available system images, and guix system --image hurd-system-image to build one of them. --- gnu/image.scm | 9 +++++ gnu/local.mk | 2 ++ gnu/system/image.scm | 59 ++++++++++++++++++++------------ gnu/system/images/hurd.scm | 70 ++++++++++++++++++++++++++++++++++++++ guix/scripts/system.scm | 56 +++++++++++++++++++++++++----- 5 files changed, 166 insertions(+), 30 deletions(-) create mode 100644 gnu/system/images/hurd.scm diff --git a/gnu/image.scm b/gnu/image.scm index 3a02692950..3a0b8d858b 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -30,8 +30,11 @@ partition-initializer =20 image + image? image-name image-format + image-system + image-target image-size image-operating-system image-partitions @@ -63,7 +66,13 @@ (define-record-type* image make-image image? + (name image-name ;symbol + (default #f)) (format image-format) ;symbol + (system image-system + (default #f)) + (target image-target + (default #f)) (size image-size ;size in bytes as integer (default 'guess)) (operating-system image-operating-system ; diff --git a/gnu/local.mk b/gnu/local.mk index ad740ade82..b72ebede7f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -627,6 +627,8 @@ GNU_SYSTEM_MODULES =3D \ %D%/system/uuid.scm \ %D%/system/vm.scm \ \ + %D%/system/images/hurd.scm \ + \ %D%/machine.scm \ %D%/machine/digital-ocean.scm \ %D%/machine/ssh.scm \ diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 328dfe9d2f..0b1708747a 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (gnu system image) + #:use-module (guix discovery) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix monads) @@ -52,15 +53,20 @@ #:use-module (srfi srfi-35) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) - #:export (esp-partition + #:export (root-offset + root-label + + esp-partition root-partition =20 - hurd-disk-image efi-disk-image iso9660-image =20 + system-image + find-image - system-image)) + %images + lookup-image-by-name)) =20 ;;; @@ -89,18 +95,6 @@ (flags '(boot)) (initializer (gexp initialize-root-partition)))) =20 -(define hurd-disk-image - (image - (format 'disk-image) - (partitions - (list (partition - (size 'guess) - (offset root-offset) - (label root-label) - (file-system "ext2") - (flags '(boot)) - (initializer (gexp initialize-root-partition))))))) - (define efi-disk-image (image (format 'disk-image) @@ -556,6 +550,11 @@ image, depending on IMAGE format." #:grub-mkrescue-environment '(("MKRESCUE_SED_MODE" . "mbr_hfs"))))))) =20 + +;; +;; Image detection. +;; + (define (find-image file-system-type) "Find and return an image that could match the given FILE-SYSTEM-TYPE. = This is useful to adapt to interfaces written before the addition of the @@ -565,11 +564,29 @@ record." (return (match file-system-type ("iso9660" iso9660-image) - (_ (cond - ((and target - (hurd-triplet? target)) - hurd-disk-image) - (else - efi-disk-image)))))))) + (_ efi-disk-image)))))) + +(define (image-modules) + "Return the list of image modules." + (all-modules (map (lambda (entry) + `(,entry . "gnu/system/images/")) + %load-path) + #:warn warn-about-load-error)) + +(define %images + ;; The list of publically-known images. + (delay (fold-module-public-variables (lambda (obj result) + (if (image? obj) + (cons obj result) + result)) + '() + (image-modules)))) + +(define (lookup-image-by-name name) + "Return the image called NAME." + (or (srfi-1:find (lambda (image) + (eq? name (image-name image))) + (force %images)) + (leave (G_ "~a: no such image~%") name))) =20 ;;; image.scm ends here diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm new file mode 100644 index 0000000000..785dc6428c --- /dev/null +++ b/gnu/system/images/hurd.scm @@ -0,0 +1,70 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2020 Mathieu Othacehe +;;; +;;; 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 hurd) + #:use-module (guix gexp) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader grub) + #:use-module (gnu image) + #:use-module (gnu packages ssh) + #:use-module (gnu services) + #:use-module (gnu services ssh) + #:use-module (gnu system) + #:use-module (gnu system file-systems) + #:use-module (gnu system hurd) + #:use-module (gnu system image) + #:export (hurd-barebones-os + hurd-disk-image)) + +(define hurd-barebones-os + (operating-system + (inherit %hurd-default-operating-system) + (bootloader (bootloader-configuration + (bootloader grub-minimal-bootloader) + (target "/dev/sdX"))) + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "ext2")) + %base-file-systems)) + (host-name "guixygnu") + (timezone "GNUrope") + (packages (cons openssh %base-packages/hurd)) + (services (cons (service openssh-service-type + (openssh-configuration + (use-pam? #f) + (port-number 2222) + (permit-root-login #t) + (allow-empty-passwords? #t) + (password-authentication? #t))) + %base-services/hurd)))) + +(define hurd-disk-image + (image + (name 'hurd-disk-image) + (format 'disk-image) + (target "i586-pc-gnu") + (operating-system hurd-barebones-os) + (partitions + (list (partition + (size 'guess) + (offset root-offset) + (label root-label) + (file-system "ext2") + (flags '(boot)) + (initializer (gexp initialize-root-partition))))))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 3d7aa77cb7..14ea1cd000 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -700,6 +700,9 @@ checking this by themselves in their 'check' procedure." (inherit base-image) (size image-size) (operating-system os))))) + ((image) + (lower-object + (system-image base-image))) ((docker-image) (system-docker-image os #:shared-network? container-shared-network?))= )) =20 @@ -744,7 +747,7 @@ and TARGET arguments." (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered)) (return (primitive-eval (lowered-gexp-sexp lowered)))))) =20 -(define* (perform-action action os +(define* (perform-action action os image #:key save-provenance? skip-safety-checks? @@ -801,7 +804,7 @@ static checks." (check-initrd-modules os))) =20 (mlet* %store-monad - ((image (find-image file-system-type)) + ((image -> (or image (find-image file-system-type))) (sys (system-derivation-for-action os image action #:file-system-type file-sy= stem-type #:image-size image-size @@ -884,6 +887,17 @@ upgrade, and restart each service that was not automat= ically restarted.\n")))))) #:node-type (shepherd-service-node-type shepherds) #:reverse-edges? #t))) =20 + +;;; +;;; Images. +;;; + +(define (list-images) + "Print the available images" + (display (G_ "The available images are:\n")) + (newline) + (format #t " ~{- ~a ~%~}" (map image-name (force %images)))) + ;;; ;;; Options. @@ -922,6 +936,8 @@ Some ACTIONS support additional ARGS.\n")) disk-image build a disk image, suitable for a USB stick\n")) (display (G_ "\ docker-image build a Docker image\n")) + (display (G_ "\ + image build the specified image\n")) (display (G_ "\ init initialize a root file system to run GNU\n")) (display (G_ "\ @@ -943,6 +959,8 @@ Some ACTIONS support additional ARGS.\n")) --file-system-type=3DTYPE for 'disk-image', produce a root file system of T= YPE (one of 'ext4', 'iso9660')")) + (display (G_ " + --list-images list available images")) (display (G_ " --image-size=3DSIZE for 'vm-image', produce an image of SIZE")) (display (G_ " @@ -998,6 +1016,10 @@ Some ACTIONS support additional ARGS.\n")) (lambda (opt name arg result) (alist-cons 'file-system-type arg result))) + (option '("list-images") #f #f + (lambda (opt name arg result) + (list-images) + (exit 0))) (option '("image-size") #t #f (lambda (opt name arg result) (alist-cons 'image-size (size->number arg) @@ -1089,9 +1111,21 @@ resulting from command-line parsing." (let* ((file (match args (() #f) ((x . _) x))) + (image (and (eq? action 'image) + (match args + (() #f) + ((name . _) + (lookup-image-by-name + (string->symbol name)))))) (expr (assoc-ref opts 'expression)) - (system (assoc-ref opts 'system)) - (target (assoc-ref opts 'target)) + (system (let ((system (assoc-ref opts 'system))) + (if image + (or (image-system image) system) + system))) + (target (let ((target (assoc-ref opts 'target))) + (if image + (image-target image) + target))) (transform (if save-provenance? (cut operating-system-with-provenance <> file) identity)) @@ -1099,6 +1133,8 @@ resulting from command-line parsing." (ensure-operating-system (or file expr) (cond + (image + (image-operating-system image)) ((and expr file) (leave (G_ "both file and expression cannot be specifi= ed~%"))) @@ -1108,7 +1144,8 @@ resulting from command-line parsing." (load* file %user-module #:on-error (assoc-ref opts 'on-error))) (else - (leave (G_ "no configuration specified~%"))))))) + (leave + (G_ "no configuration specified~%"))))))) =20 (dry? (assoc-ref opts 'dry-run?)) (bootloader? (assoc-ref opts 'install-bootloader?)) @@ -1140,7 +1177,7 @@ resulting from command-line parsing." (warn-about-old-distro #:suggested-command "guix system reconfigure")) =20 - (perform-action action os + (perform-action action os image #:dry-run? dry? #:derivations-only? (assoc-ref opts 'derivations= -only?) @@ -1229,8 +1266,8 @@ argument list and OPTS is the option alist." (alist-cons 'argument arg result) (let ((action (string->symbol arg))) (case action - ((build container vm vm-image disk-image reconfigure init - extension-graph shepherd-graph + ((build container vm vm-image disk-image image + reconfigure init extension-graph shepherd-graph list-generations describe delete-generations roll-back switch-generation search docker-image) @@ -1262,7 +1299,8 @@ argument list and OPTS is the option alist." (exit 1)) =20 (case action - ((build container vm vm-image disk-image docker-image reconfigure) + ((build container vm vm-image disk-image image docker-image + reconfigure) (unless (or (=3D count 1) (and expr (=3D count 0))) (fail))) --=20 2.26.2 --=-=-=--