index
:
tracifyjs
apprentice
templatifyjs
about
summary
about
summary
refs
log
tree
commit
diff
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2024 Zheng Junjie <873216071@qq.com> ;;; ;;; 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 system vm) #:use-module (guix config) #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix monads) #:use-module (guix records) #:use-module (guix modules) #:use-module (guix utils) #:use-module (gcrypt hash) #:use-module (guix base32) #:use-module ((guix self) #:select (make-config.scm)) #:use-module ((gnu build marionette) #:select (qemu-command)) #:use-module (gnu packages base) #:use-module (gnu packages bootloaders) #:use-module (gnu packages cdrom) #:use-module (gnu packages compression) #:use-module (gnu packages guile) #:autoload (gnu packages gnupg) (guile-gcrypt) #:use-module (gnu packages gawk) #:use-module (gnu packages bash) #:use-module (gnu packages virtualization) #:use-module (gnu packages disk) #:use-module (gnu packages linux) #:use-module (gnu bootloader) #:use-module (gnu bootloader grub) #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu system image) #:use-module (gnu system linux-container) #:use-module (gnu system linux-initrd) #:use-module (gnu bootloader) #:use-module (gnu system file-systems) #:use-module (gnu system) #:use-module (gnu services) #:use-module (gnu services base) #: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) #:export (virtualized-operating-system system-qemu-image/shared-store-script linux-image-startup-command virtual-machine virtual-machine? virtual-machine-operating-system virtual-machine-qemu virtual-machine-cpu-count virtual-machine-volatile? virtual-machine-graphic? virtual-machine-memory-size virtual-machine-disk-image-size virtual-machine-port-forwardings virtual-machine-date)) ;;; Commentary: ;;; ;;; Tools to evaluate build expressions within virtual machines. ;;; ;;; Code: ;; By default, the msize value is 8 KiB, which according to QEMU is ;; insufficient and would degrade performance. The msize value should roughly ;; match the bandwidth of the system's IO (see: ;; https://wiki.qemu.org/Documentation/9psetup#msize). Use 100 MiB as a ;; conservative default. (define %default-msize-value (* 100 (expt 2 20))) ;100 MiB ;;; ;;; VMs that share file systems with the host. ;;; (define (file-system->mount-tag fs) "Return a 9p mount tag for host file system FS." ;; QEMU mount tags must be ASCII, at most 31-byte long, cannot contain ;; slashes, and cannot start with '_'. Compute an identifier that ;; corresponds to the rules. (string-append "TAG" (string-drop (bytevector->base32-string (sha1 (string->utf8 fs))) 4))) (define (mapping->file-system mapping) "Return a 9p file system that realizes MAPPING." (match mapping (($ <file-system-mapping> source target writable?) (file-system (mount-point target) (device (file-system->mount-tag source)) (type
