Providing a Guix System images catalog.

Providing a Guix System images catalog.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 1565 bytes --]


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

[-- Attachment #2: 0001-wip-system-Add-image-support.patch --]
[-- Type: text/x-diff, Size: 14899 bytes --]

From 0eefcc0bef8fb950611ec5801a9f4d2e256b6b59 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
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
 
             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>
   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  ;<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 =				\
   %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 <http://www.gnu.org/licenses/>.
 
 (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
 
-            hurd-disk-image
             efi-disk-image
             iso9660-image
 
+            system-image
+
             find-image
-            system-image))
+            %images
+            lookup-image-by-name))
 
 \f
 ;;;
@@ -89,18 +95,6 @@
    (flags '(boot))
    (initializer (gexp initialize-root-partition))))
 
-(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")))))))
 
+\f
+;;
+;; 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 <image>
@@ -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)))
 
 ;;; 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 © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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?))))
 
@@ -744,7 +747,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 os image
                          #:key
                          save-provenance?
                          skip-safety-checks?
@@ -801,7 +804,7 @@ static checks."
       (check-initrd-modules os)))
 
   (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-system-type
                                                 #:image-size image-size
@@ -884,6 +887,17 @@ upgrade, and restart each service that was not automatically restarted.\n"))))))
                   #:node-type (shepherd-service-node-type shepherds)
                   #:reverse-edges? #t)))
 
+\f
+;;;
+;;; Images.
+;;;
+
+(define (list-images)
+  "Print the available images"
+  (display (G_ "The available images are:\n"))
+  (newline)
+  (format #t "  ~{- ~a ~%~}" (map image-name (force %images))))
+
 \f
 ;;;
 ;;; 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=TYPE
                          for 'disk-image', produce a root file system of TYPE
                          (one of 'ext4', 'iso9660')"))
+  (display (G_ "
+      --list-images      list available images"))
   (display (G_ "
       --image-size=SIZE  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 specified~%")))
@@ -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~%")))))))
 
          (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"))
 
-               (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))
 
       (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 (= count 1)
                      (and expr (= count 0)))
            (fail)))
-- 
2.26.2

Re: Providing a Guix System images catalog.

[Jan Nieuwenhuizen]

Mathieu Othacehe writes:

Hello Mathieu,

> 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?
>
> This attached, wip patch, allows to run (on wip-hurd-vm branch):
>
> guix system image hurd-disk-image
>
> instead of:
>
> guix system disk-image --target=i586-pc-gnu  gnu/system/examples/bare-hurd.tmpl

That's pretty nice!  I wonder about how this composes; if I'd want to
add say a guix-daemon service to the bare-hurd, how would I do that?

What I also like about "gnu/system/examples/bare-hurd.tmpl" is that it's
easy to imagine where to make such a change.

Greetings,
Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

Re: Providing a Guix System images catalog.

[Ludovic Courtès]

Hi,

Jan Nieuwenhuizen <janneke@gnu.org> skribis:

> Mathieu Othacehe writes:
>
> Hello Mathieu,
>
>> 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?
>>
>> This attached, wip patch, allows to run (on wip-hurd-vm branch):
>>
>> guix system image hurd-disk-image
>>
>> instead of:
>>
>> guix system disk-image --target=i586-pc-gnu  gnu/system/examples/bare-hurd.tmpl
>
> That's pretty nice!

+1!

> I wonder about how this composes; if I'd want to add say a guix-daemon
> service to the bare-hurd, how would I do that?

How about leaving the ‘operating-system’ field of <image> to #f or some
default value, and then filling it in with the argument passed to ‘guix
system’?

Or better: at the API level, we’d look for an “image constructor” (or
“image type”), not an image, where an image constructor is a procedure
that takes an <operating-system> and returns an <image>.  In practice,
you’d wrap that in <image-type> with a ‘name’ field so you can still
look them up by name.

Thoughts?

Ludo’.

Re: Providing a Guix System images catalog.

[Mathieu Othacehe]

Hey,

>> That's pretty nice!
>
> +1!

Thanks to both of you for your quick feedback!

>> I wonder about how this composes; if I'd want to add say a guix-daemon
>> service to the bare-hurd, how would I do that?
>
> How about leaving the ‘operating-system’ field of <image> to #f or some
> default value, and then filling it in with the argument passed to ‘guix
> system’?
>
> Or better: at the API level, we’d look for an “image constructor” (or
> “image type”), not an image, where an image constructor is a procedure
> that takes an <operating-system> and returns an <image>.  In practice,
> you’d wrap that in <image-type> with a ‘name’ field so you can still
> look them up by name.

This sounds fair. However, I would still like that:

* The operating-systems are stored elsewhere than in an "examples"
directory.
  
* The "image" command could use a default operating-system that we are
  building with the CI, and making available on Guix website.

What about having a:

--8<---------------cut here---------------start------------->8---
gnu/system/images/hurd
├── hurd-bare-bones-os.scm
└── hurd.scm
--8<---------------cut here---------------end--------------->8---

hurd-bare-bones-os.scm would contain an operating-system with the
"image-type" set to the image contained in hurd.scm.

Conversely, the image in hurd.scm would point to the default
operating-system, that could be the one in hurd-bare-bones-os.scm.

Then, the user could type:

--8<---------------cut here---------------start------------->8---
guix system image hurd-disk-image
guix system disk-image hurd-bare-bones-os.scm
--8<---------------cut here---------------end--------------->8---

and have the same result.

We could also allow:

--8<---------------cut here---------------start------------->8---
guix system image hurd-disk-image --with-os hurd-bare-bones-os.scm
--8<---------------cut here---------------end--------------->8---

to override the default operating-system.

WDYT?

Thanks,

Mathieu

Re: Providing a Guix System images catalog.

[Mathieu Othacehe]

Hello,

>> I wonder about how this composes; if I'd want to add say a guix-daemon
>> service to the bare-hurd, how would I do that?
>
> How about leaving the ‘operating-system’ field of <image> to #f or some
> default value, and then filling it in with the argument passed to ‘guix
> system’?
>
> Or better: at the API level, we’d look for an “image constructor” (or
> “image type”), not an image, where an image constructor is a procedure
> that takes an <operating-system> and returns an <image>.  In practice,
> you’d wrap that in <image-type> with a ‘name’ field so you can still
> look them up by name.

Not sure to get what you mean after all. Could you maybe give a small
example of what you had in mind with the image-type :) ?

To give a short status on this one,

* The "target" part was added as
f292d4719dead6a615187f325fbc0bb0e99d10b4.

* I proposed this serie https://issues.guix.gnu.org/41839, that creates
a (gnu system image hurd) module for the purpose of CI.

So we now have an <image> record that contains all the required
information to be built as a Guix System disk-image targeting a specific
machine/architecture.

I think it would make sense to be able to build images directly from the
"guix system" command, but I'm not sure on how to make it composable
with an operating-system file.
  
Feedback welcome :)

Thanks,

Mathieu