[bug#40955] [PATCH 4/5] image: Add a new API.

[Ludovic Courtès]

Mathieu Othacehe <address@hidden> skribis:

> Raw disk-images and ISO9660 images are created in a Qemu virtual machine. This
> is quite fragile, very slow, and almost unusable without KVM.
>
> For all these reasons, add support for host image generation. This implies the
> use new image generation mechanisms.
>
> - Raw disk images: images of partitions are created using tools such as mke2fs
>   and mkdosfs depending on the partition file-system type. The partition
>   images are then assembled into a final image using genimage.
>
> - ISO9660 images: the ISO root directory is populated within the store. GNU
>   xorriso is then called on that directory, in the exact same way as this is
>   done in (gnu build vm) module.
>
> Those mechanisms are built upon the new (gnu image) module.
>
> * gnu/image.scm: New file.
> * gnu/system/image.scm: New file.
> * gnu/build/image: New file.
> * gnu/local.mk: Add them.
> * gnu/system/vm.scm (system-disk-image): Rename to system-disk-image-in-vm.
> * gnu/ci.scm (qemu-jobs): Adapt to new API.
> * gnu/tests/install.scm (run-install): Ditto.
> * guix/scripts/system.scm (system-derivation-for-action): Ditto.

Yay!

> +++ b/gnu/build/image.scm

Maybe we need to preserve some of the copyright lines of (gnu build vm).

> +(define (root-size root)
> +  "Given the ROOT directory, evalute and return its size. As this doesn't 
> take
> +the partition metadata size into account, take a 25% margin."
> +  (* 1.25 (file-size root)))

Perhaps ‘estimated-partition-size’ would be a better name?

Nitpick: two spaces after end-of-sentence periods.  :-)

> +(define* (make-ext4-image partition target root
> +                          #:key (owner 0))

Would it make sense to separate #:owner-uid and #:owner-gid?

It does mean that we can only create images where all the files have the
same UID/GID.

Looking at (gnu build install), there’s one case where it might be
problematic: the store’s GID is supposed to match the ‘guixbuilder’
group.  But the good news is that the daemon does this:

    if (chown(chrootStoreDir.c_str(), 0, buildUser.getGID()) == -1)
        throw SysError(format("cannot change ownership of ‘%1%’") % 
chrootStoreDir);

So we can just remove the UID/GID from the directives that are in (gnu
build install).

> +(define* (genimage config target)
> +  "Use genimage to generate in TARGET directory, the image described in the
> +given CONFIG file."
> +  ;; genimage needs a 'root' directory.
> +  (mkdir "root")
> +  (invoke "genimage" "--config" config
> +          "--outputpath" target))

I had missed that bit, so we still need genimage in the end?

> +(define (register-bootcfg-root target bootcfg)
> +  "On file system TARGET, register BOOTCFG as a GC root."
> +  (let ((directory (string-append target "/var/guix/gcroots")))
> +    (mkdir-p directory)
> +    (symlink bootcfg (string-append directory "/bootcfg"))))

Maybe just ‘register-gc-root’?

> +(define* (register-closure prefix closure
> +                           #:key
> +                           (deduplicate? #t) (reset-timestamps? #t)
> +                           (schema (sql-schema)))
> +  "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
> +target store and CLOSURE is the name of a file containing a reference graph 
> as
> +produced by #:references-graphs..  As a side effect, if RESET-TIMESTAMPS? is
> +true, reset timestamps on store files and, if DEDUPLICATE? is true,
> +deduplicates files common to CLOSURE and the rest of PREFIX."
> +  (let ((items (call-with-input-file closure read-reference-graph)))
> +    (register-items items
> +                    #:prefix prefix
> +                    #:deduplicate? deduplicate?
> +                    #:reset-timestamps? reset-timestamps?
> +                    #:registration-time %epoch
> +                    #:schema schema)))

This is duplicated from (guix build vm).  Should we instead factorize it
in (guix build store-copy)?

> +(define-module (gnu image)
> +  #:use-module (guix records)
> +  #:use-module (ice-9 match)

(ice-9 match) can be removed.

> +  #:use-module ((srfi srfi-1) #:prefix scm:)

I’d suggest either ‘srfi-1:’ as the prefix or, better, hide whichever
binding is causing a name clash.

> +(define-syntax-rule (with-imported-modules* exp ...)
> +  (with-extensions gcrypt-sqlite3&co
> +    (with-imported-modules `(,@(source-module-closure
> +                                '((gnu build vm)
> +                                  (gnu build image)
> +                                  (guix store database))
> +                                #:select? not-config?)
> +                             ((guix config) => ,(make-config.scm)))
> +      #~(begin
> +          (use-modules (gnu build vm)
> +                       (gnu build image)
> +                       (guix store database)
> +                       (guix build utils))
> +          exp ...))))

Probably a better name would be ‘gexp*’ (or ‘image-gexp’) to make it
clear that it builds a gexp.

> +(define* (system-disk-image image
> +                            #:key
> +                            (name "disk-image")
> +                            bootcfg
> +                            bootloader
> +                            register-closures?
> +                            (inputs '()))

[...]

> +  (define (image->genimage-cfg image)
> +    "Return as a file-like object, the genimage configuration file describing
> +the given IMAGE."
> +    (define (format->image-type format)
> +      "Return the genimage format corresponding to FORMAT. For now, only the
> +hdimage format (raw disk-image) is supported."

Use comments instead of docstrings for inner procedures in all this file
(docstrings could not be accessed anyway).  Also, two spaces after
end-of-sentence periods.  :-)

> +      (case format
> +        ((disk-image) "hdimage")
> +        (else
> +         (error
> +          (format #f "Unsupported image type ~a~%." format)))))

For host-side code, better use “proper” error reporting that can be
gracefully dealt with.  So at least:

  (raise (condition (&message (message (format #f (G_ …) …)))))

and/or a specific error condition type (well, we can leave that for
later).

> +    (gexp->derivation name
> +                      #~(symlink
> +                         (string-append #$image-dir "/" #$genimage-name)
> +                         #$output)
> +                      #:substitutable? substitutable?)))

Can we use ‘computed-file’ as well instead of ‘gexp->derivation’?  That
way, the API is entirely non-monadic and hopefully easier to use.

It does mean that we need to adjust (gnu ci), (gnu tests …), and (guix
scripts system), but maybe that’s OK.

Anyhow, the switch to non-monadic style could be made later, but not too
late so we can still consider the API as not-quite-public.  :-)

> +    (gexp->derivation name builder
> +                      #:references-graphs inputs
> +                      #:substitutable? substitutable?)))

Same here.

> +(define* (make-system-image image)
> +  "Return the derivation of IMAGE. It can be a raw disk-image or an ISO9660
> +image, depending on IMAGE format."
> +  (let* ((image-os (image-operating-system image))
> +         (format (image-format image))
> +         (file-systems-to-keep
> +          (scm:remove
> +           (lambda (fs)
> +             (string=? (file-system-mount-point fs) "/"))
> +           (operating-system-file-systems image-os)))
> +         (root-file-system-type (image->root-file-system image))
> +         (substitutable? (image-substitutable? image))
> +         (volatile-root? (image-volatile-root? image))

To improve readability, maybe you can use inner ‘define’ for these
things.

> +         (os (operating-system
> +               (inherit image-os)
> +               (initrd (lambda (file-systems . rest)
> +                         (apply (operating-system-initrd image-os)
> +                                file-systems
> +                                #:volatile-root? volatile-root?
> +                                rest)))
> +               (bootloader (if (eq? format 'iso9660)
> +                               (bootloader-configuration
> +                                (inherit
> +                                 (operating-system-bootloader image-os))
> +                                (bootloader grub-mkrescue-bootloader))
> +                               (operating-system-bootloader image-os)))
> +               (file-systems (cons (file-system
> +                                     (mount-point "/")
> +                                     (device "/dev/placeholder")
> +                                     (type root-file-system-type))
> +                                   file-systems-to-keep))))

Perhaps define an auxiliary ‘operating-system-for-image’ procedure, just
like we have ‘virtualized-operating-system’ & co.

That’s all!

Thanks,
Ludo’.