~ruther/guix-local

e0ade40c2b7f39dc109ef03d43241033e14c4d4a — Ludovic Courtès 2 years ago 15fd5d6
services: virtual-build-machine: Use a larger partition by default.

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
1 files changed, 15 insertions(+), 2 deletions(-)

M gnu/services/virtualization.scm
M gnu/services/virtualization.scm => gnu/services/virtualization.scm +15 -2
@@ 57,7 57,7 @@
  #: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 @@ authpriv.*;auth.info                    /var/log/secure
                       (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 @@ authpriv.*;auth.info                    /var/log/secure
           (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-"