From e0ade40c2b7f39dc109ef03d43241033e14c4d4a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 12 Feb 2024 11:22:00 +0100
Subject: services: virtual-build-machine: Use a larger partition by default.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

So far the partition had too little free space.

* gnu/services/virtualization.scm (%default-virtual-build-machine-image-size):
New variable.
(virtual-build-machine-default-image): Define ‘partitions’ field.

Change-Id: Iffe0f316eecad8754d29f8c811cdc4836a818a3f
---
 gnu/services/virtualization.scm | 17 +++++++++++++++--
 1 file changed, 15 insertions(+), 2 deletions(-)

(limited to 'gnu/services')

diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index e1970e2b09..0fbd51de8d 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -57,7 +57,7 @@ (define-module (gnu services virtualization)
   #:autoload   (guix self) (make-config.scm)
   #:autoload   (guix platform) (platform-system)
 
-  #:use-module (srfi srfi-1)
+  #:use-module ((srfi srfi-1) #:hide (partition))
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
@@ -1225,6 +1225,11 @@ (define %virtual-build-machine-operating-system
                        (delete mingetty-service-type)
                        (delete console-font-service-type))))))
 
+(define %default-virtual-build-machine-image-size
+  ;; Size of the default disk image of virtual build machines.  It should be
+  ;; large enough to let users build a few things.
+  (* 20 (expt 2 30)))
+
 (define (virtual-build-machine-default-image config)
   (let* ((type (lookup-image-type-by-name 'mbr-raw))
          (base (os->image %virtual-build-machine-operating-system
@@ -1235,7 +1240,15 @@ (define (virtual-build-machine-default-image config)
            (format 'compressed-qcow2)
            (partition-table-type 'mbr)
            (shared-store? #f)
-           (size (* 10 (expt 2 30))))))
+           (size %default-virtual-build-machine-image-size)
+           (partitions (match (image-partitions base)
+                         ((root)
+                          ;; Increase the size of the root partition to match
+                          ;; that of the disk image.
+                          (let ((root-size (- size (* 50 (expt 2 20)))))
+                            (list (partition
+                                   (inherit root)
+                                   (size root-size))))))))))
 
 (define (virtual-build-machine-account-name config)
   (string-append "build-vm-"
-- 
cgit v1.2.3