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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit f7447b1a32c5dc79d34a6bc9e66cca03ecb5cf56
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Jan 20 11:47:47 2024 +0100

    vm: Add ‘date’ field to <virtual-machine>.
    
    * gnu/system/vm.scm (<virtual-machine>)[date]: New field.
    (virtual-machine-compiler): Honor it.
    
    Change-Id: Idab1c152466d57cbc6784c031a99fdfd37080bcb
---
 gnu/system/vm.scm | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 8c27ff787d..33604d3229 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -1,5 +1,5 @@
 ;;; 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, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -63,6 +63,7 @@
   #:use-module (gnu system uuid)
 
   #:use-module ((srfi srfi-1) #:hide (partition))
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs bytevectors)
   #: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)
                     (default 'guess))
   (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
   (syntax-rules ()
@@ -353,22 +356,19 @@ FORWARDINGS is a list of host-port/guest-port pairs."
                                                 system target)
   (match vm
     (($ <virtual-machine> os qemu volatile? graphic? memory-size
-                          disk-image-size ())
-     (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)
+                          disk-image-size forwardings date)
      (let ((options
-            `("-nic" ,(string-append
-                       "user,model=virtio-net-pci,"
-                       (port-forwardings->qemu-options forwardings)))))
+            (append (if (null? forwardings)
+                        '()
+                        `("-nic" ,(string-append
+                                   "user,model=virtio-net-pci,"
+                                   (port-forwardings->qemu-options
+                                    forwardings))))
+                    (if date
+                        `("-rtc"
+                          ,(string-append
+                            "base=" (date->string date "~5")))
+                        '()))))
        (system-qemu-image/shared-store-script os
                                               #:system system
                                               #:target target