[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#20239: [PATCH 1/4] services: Add qemu-binfmt.
|
From: |
Ludovic Courtès |
|
Subject: |
bug#20239: [PATCH 1/4] services: Add qemu-binfmt. |
|
Date: |
Tue, 9 Jan 2018 17:14:24 +0100 |
* gnu/services/virtualization.scm (<qemu-platform>): New record type.
(bv): New macro.
(%i386, %i486, %alpha, %arm, %armeb, %sparc, %sparc32plus)
(%ppc, %ppc64, %ppc64le, %m68k, %mips, %mipsel, %mipsn32el)
(%mips64, %mips64el, %sh4, %sh4eb, %s390x, %aarch64, %hppa)
(%qemu-platforms): New variables.
(lookup-qemu-platforms): New procedure.
(<qemu-binfmt-configuration>): New record type.
(qemu-platform->binfmt): New procedures.
(%binfmt-mount-point, %binfmt-register-file, %binfmt-file-system)
(qemu-binfmt-service-type): New variables.
(qemu-binfmt-shepherd-services): New procedures.
* doc/guix.texi (Virtualization Services): Add "Transparent Emulation
with QEMU" heading.
---
doc/guix.texi | 59 +++++++++-
gnu/services/virtualization.scm | 249 +++++++++++++++++++++++++++++++++++++++-
2 files changed, 306 insertions(+), 2 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index e9ee5127a..5c836ae96 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -16956,8 +16956,10 @@ an absolute path can be specified here.
@node Virtualization Services
@subsubsection Virtualization services
+
The @code{(gnu services virtualization)} module provides services for
-the libvirt and virtlog daemons.
+the libvirt and virtlog daemons, as well as other virtualization-related
+services.
@subsubheading Libvirt daemon
@code{libvirtd} is the server side daemon component of the libvirt
@@ -17660,6 +17662,61 @@ Defaults to @samp{3}
@end deftypevr
address@hidden Transparent Emulation with QEMU
+
address@hidden emulation
address@hidden @code{binfmt_misc}
address@hidden provides support for transparent
+emulation of program binaries built for different architectures---e.g.,
+it allows you to transparently execute an ARMv7 program on an x86_64
+machine. It achieves this by combining the @uref{https://www.qemu.org,
+QEMU} emulator and the @code{binfmt_misc} feature of the kernel Linux.
+
address@hidden {Scheme Variable} qemu-binfmt-service-type
+This is the type of the QEMU/binfmt service for transparent emulation.
+Its value must be a @code{qemu-binfmt-configuration} object, which
+specifies the QEMU package to use as well as the architecture we want to
+emulated:
+
address@hidden
+(service qemu-binfmt-service-type
+ (qemu-binfmt-configuration
+ (platforms (lookup-qemu-platforms "arm" "aarch64"))))
address@hidden example
+
+In this example, we enable transparent emulation for the ARM and aarch64
+platforms. Running @code{herd stop qemu-binfmt} turns it off, and
+running @code{herd start qemu-binfmt} turns it back on (@pxref{Invoking
+herd, the @command{herd} command,, shepherd, The GNU Shepherd Manual}).
address@hidden defvr
+
address@hidden {Data Type} qemu-binfmt-configuration
+This is the configuration for the @code{qemu-binfmt} service.
+
address@hidden @asis
address@hidden @code{platforms} (default: @code{'()})
+The list of emulated QEMU platforms. Each item must be a @dfn{platform
+object} as returned by @code{lookup-qemu-platforms} (see below).
+
address@hidden @code{qemu} (default: @code{qemu})
+The QEMU package to use.
address@hidden table
address@hidden deftp
+
address@hidden {Scheme Procedure} lookup-qemu-platforms @address@hidden
+Return the list of QEMU platform objects corresponding to
address@hidden@dots{}. @var{platforms} must be a list of strings
+corresponding to platform names, such as @code{"arm"}, @code{"sparc"},
address@hidden"mips64el"}, and so on.
address@hidden deffn
+
address@hidden {Scheme Procedure} qemu-platform? @var{obj}
+Return true if @var{obj} is a platform object.
address@hidden deffn
+
address@hidden {Scheme Procedure} qemu-platform-name @var{platform}
+Return the name of @var{platform}---a string such as @code{"arm"}.
address@hidden deffn
@node Version Control Services
@subsubsection Version Control Services
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 845cdb07b..ac6afe043 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ryan Moe <address@hidden>
+;;; Copyright © 2018 Ludovic Courtès <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,16 +24,29 @@
#:use-module (gnu services dbus)
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
+ #:use-module (gnu system file-systems)
#:use-module (gnu packages admin)
#:use-module (gnu packages virtualization)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (guix packages)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:export (libvirt-configuration
libvirt-service-type
- virtlog-service-type))
+ virtlog-service-type
+
+ %qemu-platforms
+ lookup-qemu-platforms
+ qemu-platform?
+ qemu-platform-name
+
+ qemu-binfmt-configuration
+ qemu-binfmt-configuration?
+ qemu-binfmt-service-type))
(define (uglify-field-name field-name)
(let ((str (symbol->string field-name)))
@@ -490,3 +504,236 @@ potential infinite waits blocking libvirt."))
(generate-documentation
`((libvirt-configuration ,libvirt-configuration-fields))
'libvirt-configuration))
+
+
+;;;
+;;; Transparent QEMU emulation via binfmt_misc.
+;;;
+
+;; Platforms that QEMU can emulate.
+(define-record-type <qemu-platform>
+ (qemu-platform name family magic mask)
+ qemu-platform?
+ (name qemu-platform-name) ;string
+ (family qemu-platform-family) ;string
+ (magic qemu-platform-magic) ;bytevector
+ (mask qemu-platform-mask)) ;bytevector
+
+(define-syntax bv
+ (lambda (s)
+ "Expand the given string into a bytevector."
+ (syntax-case s ()
+ ((_ str)
+ (string? (syntax->datum #'str))
+ (let ((bv (u8-list->bytevector
+ (map char->integer
+ (string->list (syntax->datum #'str))))))
+ bv)))))
+
+;;; The platform descriptions below are taken from
+;;; 'scripts/qemu-binfmt-conf.sh' in QEMU.
+
+(define %i386
+ (qemu-platform "i386" "i386"
+ (bv
"\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x03\x00")
+ (bv
"\xff\xff\xff\xff\xff\xfe\xfe\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %i486
+ (qemu-platform "i486" "i386"
+ (bv
"\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x06\x00")
+ (bv
"\xff\xff\xff\xff\xff\xfe\xfe\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %alpha
+ (qemu-platform "alpha" "alpha"
+ (bv
"\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x26\x90")
+ (bv
"\xff\xff\xff\xff\xff\xfe\xfe\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %arm
+ (qemu-platform "arm" "arm"
+ (bv
"\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x28\x00")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %armeb
+ (qemu-platform "armeb" "arm"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x28")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %sparc
+ (qemu-platform "sparc" "sparc"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x02")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %sparc32plus
+ (qemu-platform "sparc32plus" "sparc"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x12")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %ppc
+ (qemu-platform "ppc" "ppc"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x14")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %ppc64
+ (qemu-platform "ppc64" "ppc"
+ (bv
"\x7fELF\x02\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x15")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %ppc64le
+ (qemu-platform "ppc64le" "ppcle"
+ (bv
"\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x15\x00")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\x00")))
+
+(define %m68k
+ (qemu-platform "m68k" "m68k"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x04")
+ (bv
"\xff\xff\xff\xff\xff\xff\xfe\xfe\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+;; XXX: We could use the other endianness on a MIPS host.
+(define %mips
+ (qemu-platform "mips" "mips"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %mipsel
+ (qemu-platform "mipsel" "mips"
+ (bv
"\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08\x00")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %mipsn32
+ (qemu-platform "mipsn32" "mips"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %mipsn32el
+ (qemu-platform "mipsn32el" "mips"
+ (bv
"\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08\x00")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %mips64
+ (qemu-platform "mips64" "mips"
+ (bv
"\x7fELF\x02\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %mips64el
+ (qemu-platform "mips64el" "mips"
+ (bv
"\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08\x00")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %sh4
+ (qemu-platform "sh4" "sh4"
+ (bv
"\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x2a\x00")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %sh4eb
+ (qemu-platform "sh4eb" "sh4"
+ (bv
"\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x2a")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %s390x
+ (qemu-platform "s390x" "s390x"
+ (bv
"\x7fELF\x02\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x16")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %aarch64
+ (qemu-platform "aarch64" "arm"
+ (bv
"\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\xb7\x00")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+
+(define %hppa
+ (qemu-platform "hppa" "hppa"
+ (bv
"\x7f\x45\x4c\x46\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x0f")
+ (bv
"\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff")))
+
+(define %qemu-platforms
+ (list %i386 %i486 %alpha %arm %sparc32plus %ppc %ppc64 %ppc64le %m68k
+ %mips %mipsel %mipsn32 %mipsn32el %mips64 %mips64el
+ %sh4 %sh4eb %s390x %aarch64 %hppa))
+
+(define (lookup-qemu-platforms . names)
+ "Return the list of QEMU platforms that match NAMES--a list of names such as
+\"arm\", \"hppa\", etc."
+ (filter (lambda (platform)
+ (member (qemu-platform-name platform) names))
+ %qemu-platforms))
+
+(define-record-type* <qemu-binfmt-configuration>
+ qemu-binfmt-configuration make-qemu-binfmt-configuration
+ qemu-binfmt-configuration?
+ (qemu qemu-binfmt-configuration-qemu
+ (default qemu))
+ (platforms qemu-binfmt-configuration-platforms
+ (default '()))) ;safest default
+
+(define (qemu-platform->binfmt qemu platform)
+ "Return a gexp that evaluates to a binfmt string for PLATFORM, using the
+given QEMU package."
+ (define (bytevector->ascii-string bv)
+ (list->string (map integer->char
+ (bytevector->u8-list bv))))
+
+ (match platform
+ (($ <qemu-platform> name family magic mask)
+ ;; See 'Documentation/binfmt_misc.txt' in the kernel.
+ #~(string-append ":qemu-" #$name ":M::"
+ #$(bytevector->ascii-string magic)
+ ":" #$(bytevector->ascii-string mask)
+ ":" #$(file-append qemu "/bin/qemu-" name)
+ ":" ;FLAGS go here
+ ))))
+
+(define %binfmt-mount-point
+ "/proc/sys/fs/binfmt_misc")
+
+(define %binfmt-register-file
+ (string-append %binfmt-mount-point "/register"))
+
+(define %binfmt-file-system
+ (file-system
+ (mount-point %binfmt-mount-point)
+ (type "binfmt_misc")
+ (device "binfmt_misc")
+ (title 'device)))
+
+(define qemu-binfmt-shepherd-services
+ (match-lambda
+ (($ <qemu-binfmt-configuration> qemu platforms)
+ (list (shepherd-service
+ (provision '(qemu-binfmt))
+ (documentation "Install binfmt_misc handlers for QEMU.")
+ (requirement '(file-system-/proc/sys/fs/binfmt_misc))
+ (start #~(lambda ()
+ ;; Register the handlers for all of PLATFORMS.
+ (call-with-output-file #$%binfmt-register-file
+ (lambda (port)
+ (for-each (lambda (str)
+ (display str port))
+ (list
+ #$@(map (cut qemu-platform->binfmt qemu
+ <>)
+ platforms)))))
+ #t))
+ (stop #~(lambda (_)
+ ;; Unregister the handlers.
+ (for-each (lambda (name)
+ (let ((file (string-append
+ #$%binfmt-mount-point
+ "/qemu-" name)))
+ (call-with-output-file file
+ (lambda (port)
+ (display "-1" port)))))
+ '#$(map qemu-platform-name platforms))
+ #f)))))))
+
+(define qemu-binfmt-service-type
+ ;; TODO: Make a separate binfmt_misc service out of this?
+ (service-type (name 'qemu-binfmt)
+ (extensions
+ (list (service-extension file-system-service-type
+ (const (list %binfmt-file-system)))
+ (service-extension shepherd-root-service-type
+ qemu-binfmt-shepherd-services)))
+ (default-value (qemu-binfmt-configuration))
+ (description
+ "This service supports transparent emulation of binaries
+compiled for other architectures using QEMU and the @code{binfmt_misc}
+functionality of the kernel Linux.")))
--
2.15.1