me/guix
Archived
1
0
Fork 0
Code Activity

vm: Add ‘date’ field to <virtual-machine>.

Browse source 
* gnu/system/vm.scm (<virtual-machine>)[date]: New field.
(virtual-machine-compiler): Honor it.

Change-Id: Idab1c152466d57cbc6784c031a99fdfd37080bcb
This commit is contained in:
Ludovic Courtès 2024-01-20 11:47:47 +01:00
parent f331a667d3
commit f7447b1a32
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
gnu/system/vm.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org> ;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@ -63,6 +63,7 @@
#:use-module (gnu system uuid) #:use-module (gnu system uuid)
#:use-module ((srfi srfi-1) #:hide (partition)) #:use-module ((srfi srfi-1) #:hide (partition))
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -326,7 +327,9 @@ useful when FULL-BOOT? is true."
(disk-image-size virtual-machine-disk-image-size ;integer (bytes) (disk-image-size virtual-machine-disk-image-size ;integer (bytes)
(default 'guess)) (default 'guess))
(port-forwardings virtual-machine-port-forwardings ;list of integer pairs (port-forwardings virtual-machine-port-forwardings ;list of integer pairs
(default '()))) (default '()))
(date virtual-machine-date ;SRFI-19 date | #f
(default #f)))
(define-syntax virtual-machine (define-syntax virtual-machine
(syntax-rules () (syntax-rules ()
@ -353,22 +356,19 @@ FORWARDINGS is a list of host-port/guest-port pairs."
system target) system target)
(match vm (match vm
(($ <virtual-machine> os qemu volatile? graphic? memory-size (($ <virtual-machine> os qemu volatile? graphic? memory-size
disk-image-size ()) disk-image-size forwardings date)
(system-qemu-image/shared-store-script os
#:system system
#:target target
#:qemu qemu
#:graphic? graphic?
#:volatile? volatile?
#:memory-size memory-size
#:disk-image-size
disk-image-size))
(($ <virtual-machine> os qemu volatile? graphic? memory-size
disk-image-size forwardings)
(let ((options (let ((options
(append (if (null? forwardings)
'()
`("-nic" ,(string-append `("-nic" ,(string-append
"user,model=virtio-net-pci," "user,model=virtio-net-pci,"
(port-forwardings->qemu-options forwardings))))) (port-forwardings->qemu-options
forwardings))))
(if date
`("-rtc"
,(string-append
"base=" (date->string date "~5")))
'()))))
(system-qemu-image/shared-store-script os (system-qemu-image/shared-store-script os
#:system system #:system system
#:target target #:target target