tests: image: New test.
Add a new image test module to validate the image creation itself. The images structures are validated using guile-parted. Checking the content of those images is out of scope and should be performed in other modules (installation for instance). * gnu/tests/image.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.master
Mathieu Othacehe
parent
6454164412
commit
73fb14c28a
|
|
@ -750,6 +750,7 @@ GNU_SYSTEM_MODULES = \
|
|||
%D%/tests/guix.scm \
|
||||
%D%/tests/monitoring.scm \
|
||||
%D%/tests/nfs.scm \
|
||||
%D%/tests/image.scm \
|
||||
%D%/tests/install.scm \
|
||||
%D%/tests/ldap.scm \
|
||||
%D%/tests/linux-modules.scm \
|
||||
|
|
|
|||
|
|
@ -0,0 +1,270 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
|
||||
;;;
|
||||
;;; 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 tests image)
|
||||
#:use-module (gnu)
|
||||
#:use-module (gnu image)
|
||||
#:use-module (gnu tests)
|
||||
#:autoload (gnu system image) (system-image root-offset)
|
||||
#:use-module (gnu system uuid)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu packages guile)
|
||||
#:use-module (gnu packages guile-xyz)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (ice-9 format)
|
||||
#:export (%test-images))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This module provides tests for the image creation process that is
|
||||
;;; performed by "genimage" under the hood.
|
||||
;;;
|
||||
;;; The image partitionment is checked using Guile-Parted. The content of the
|
||||
;;; images is out of the scope of this module. Other test modules such as
|
||||
;;; (gnu tests installation) make sure that the produced images are viable.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; A dummy initializer creating a simple file in the partition.
|
||||
(define dummy-initializer
|
||||
#~(lambda* (root . rest)
|
||||
(mkdir root)
|
||||
(call-with-output-file
|
||||
(string-append root "/test")
|
||||
(lambda (port)
|
||||
(format port "content")))))
|
||||
|
||||
(define %simple-efi-os
|
||||
(operating-system
|
||||
(inherit %simple-os)
|
||||
(bootloader (bootloader-configuration
|
||||
(bootloader grub-efi-bootloader)
|
||||
(targets '("/boot/efi"))))))
|
||||
|
||||
;; An MBR disk image with a single ext4 partition.
|
||||
(define i1
|
||||
(image
|
||||
(format 'disk-image)
|
||||
(operating-system %simple-os)
|
||||
(partitions
|
||||
(list
|
||||
(partition
|
||||
(size (* 1024 1024)) ;1MiB
|
||||
(offset root-offset)
|
||||
(label "test")
|
||||
(file-system "ext4")
|
||||
(flags '(boot))
|
||||
(initializer dummy-initializer))))))
|
||||
|
||||
;; A GPT disk image with a single ext4 partition.
|
||||
(define i2
|
||||
(image
|
||||
(format 'disk-image)
|
||||
(operating-system %simple-efi-os)
|
||||
(partition-table-type 'gpt)
|
||||
(partitions
|
||||
(list
|
||||
(partition
|
||||
(size (* 1024 1024)) ;1MiB
|
||||
(offset root-offset)
|
||||
(label "test")
|
||||
(file-system "ext4")
|
||||
(flags '(boot))
|
||||
(initializer dummy-initializer))))))
|
||||
|
||||
;; An MBR disk image with multiple ext4 partitions.
|
||||
(define i3
|
||||
(image
|
||||
(format 'disk-image)
|
||||
(operating-system %simple-os)
|
||||
(partitions
|
||||
(list
|
||||
(partition
|
||||
(size (* 1024 1024)) ;1MiB
|
||||
(offset root-offset)
|
||||
(label "test")
|
||||
(file-system "ext4")
|
||||
(flags '(boot))
|
||||
(initializer dummy-initializer))
|
||||
(partition
|
||||
(size (* 1024 1024)) ;1MiB
|
||||
(label "test2")
|
||||
(file-system "ext4")
|
||||
(flags '())
|
||||
(initializer dummy-initializer))))))
|
||||
|
||||
;; A GPT disk image with multiple ext4 partitions.
|
||||
(define i4
|
||||
(image
|
||||
(format 'disk-image)
|
||||
(operating-system %simple-efi-os)
|
||||
(partition-table-type 'gpt)
|
||||
(partitions
|
||||
(list
|
||||
(partition
|
||||
(size (* 1024 1024)) ;1MiB
|
||||
(offset root-offset)
|
||||
(label "test")
|
||||
(file-system "ext4")
|
||||
(flags '(boot))
|
||||
(initializer dummy-initializer))
|
||||
(partition
|
||||
(size (* 1024 1024)) ;1MiB
|
||||
(label "test2")
|
||||
(file-system "ext4")
|
||||
(flags '())
|
||||
(initializer dummy-initializer))))))
|
||||
|
||||
;; A GPT disk image with fat32 and ext4 partitions.
|
||||
(define i5
|
||||
(image
|
||||
(format 'disk-image)
|
||||
(operating-system %simple-efi-os)
|
||||
(partition-table-type 'gpt)
|
||||
(partitions
|
||||
(list
|
||||
(partition
|
||||
(size (* 1024 1024 128)) ;128MiB
|
||||
(offset root-offset)
|
||||
(label "test")
|
||||
(file-system "fat32")
|
||||
(flags '(esp))
|
||||
(initializer dummy-initializer))
|
||||
(partition
|
||||
(size (* 1024 1024 256)) ;256MiB
|
||||
(label "test2")
|
||||
(file-system "ext4")
|
||||
(flags '(boot))
|
||||
(initializer dummy-initializer))))))
|
||||
|
||||
(define (run-images-test)
|
||||
(define test
|
||||
(with-imported-modules '((srfi srfi-64)
|
||||
(gnu build marionette))
|
||||
(with-extensions (list guile-parted guile-bytestructures)
|
||||
#~(begin
|
||||
(use-modules (gnu build marionette)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26)
|
||||
(srfi srfi-64)
|
||||
(parted))
|
||||
|
||||
(define (image->disk img)
|
||||
(disk-new (get-device img)))
|
||||
|
||||
(test-runner-current (system-test-runner #$output))
|
||||
(test-begin "images")
|
||||
|
||||
;; Image i1.
|
||||
(define i1-image
|
||||
#$(system-image i1))
|
||||
(define d1-device
|
||||
(get-device i1-image))
|
||||
|
||||
(test-equal "msdos"
|
||||
(disk-type-name (disk-probe d1-device)))
|
||||
|
||||
(test-equal 1
|
||||
(disk-get-primary-partition-count (disk-new d1-device)))
|
||||
|
||||
(test-assert
|
||||
(let* ((disk (disk-new d1-device))
|
||||
(partitions (disk-partitions disk))
|
||||
(boot-partition (find normal-partition? partitions)))
|
||||
(partition-get-flag boot-partition PARTITION-FLAG-BOOT)))
|
||||
|
||||
;; Image i2.
|
||||
(define i2-image
|
||||
#$(system-image i2))
|
||||
(define d2-device
|
||||
(get-device i2-image))
|
||||
|
||||
(test-equal "gpt"
|
||||
(disk-type-name (disk-probe d2-device)))
|
||||
|
||||
(test-equal 1
|
||||
(disk-get-primary-partition-count (disk-new d2-device)))
|
||||
|
||||
(test-equal "test"
|
||||
(let* ((disk (disk-new d2-device))
|
||||
(partitions (disk-partitions disk))
|
||||
(boot-partition (find normal-partition? partitions)))
|
||||
(partition-get-name boot-partition)))
|
||||
|
||||
;; Image i3.
|
||||
(define i3-image
|
||||
#$(system-image i3))
|
||||
(define d3-device
|
||||
(get-device i3-image))
|
||||
|
||||
(test-equal "msdos"
|
||||
(disk-type-name (disk-probe d3-device)))
|
||||
|
||||
(test-equal 2
|
||||
(disk-get-primary-partition-count (disk-new d3-device)))
|
||||
|
||||
;; Image i4.
|
||||
(define i4-image
|
||||
#$(system-image i4))
|
||||
(define d4-device
|
||||
(get-device i4-image))
|
||||
|
||||
(test-equal "gpt"
|
||||
(disk-type-name (disk-probe d4-device)))
|
||||
|
||||
(test-equal 2
|
||||
(disk-get-primary-partition-count (disk-new d4-device)))
|
||||
|
||||
;; Image i5.
|
||||
(define i5-image
|
||||
#$(system-image i5))
|
||||
(define d5-device
|
||||
(get-device i5-image))
|
||||
|
||||
(define (sector->byte sector)
|
||||
(/ (* sector (device-sector-size d5-device))
|
||||
MEBIBYTE-SIZE))
|
||||
|
||||
(test-equal "gpt"
|
||||
(disk-type-name (disk-probe d5-device)))
|
||||
|
||||
(test-equal 2
|
||||
(disk-get-primary-partition-count (disk-new d5-device)))
|
||||
|
||||
(test-equal '("fat32" "ext4")
|
||||
(map (compose filesystem-type-name partition-fs-type)
|
||||
(filter data-partition?
|
||||
(disk-partitions (disk-new d5-device)))))
|
||||
|
||||
;; The first partition has a 1MiB offset has a 128MiB size. The
|
||||
;; second partition should then start at 129MiB.
|
||||
(test-equal '(1 129)
|
||||
(map (compose sector->byte partition-start)
|
||||
(filter data-partition?
|
||||
(disk-partitions (disk-new d5-device)))))
|
||||
|
||||
(test-end)))))
|
||||
|
||||
(gexp->derivation "images-test" test))
|
||||
|
||||
(define %test-images
|
||||
(system-test
|
||||
(name "images")
|
||||
(description "Build and test basic system images.")
|
||||
(value (run-images-test))))
|
||||
Reference in New Issue