bug#20239: [wishlist] Add build hook to build for other platforms using qemu

bug#20239: [wishlist] Add build hook to build for other platforms using qemu

[Mark H Weaver]

It would be great if we had a build hook to enable guix-daemon to
natively build packages for any system supported by qemu, by running the
build processes within qemu.

     Mark

bug#20239: [wishlist] Add build hook to build for other platforms using qemu

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> It would be great if we had a build hook to enable guix-daemon to
> natively build packages for any system supported by qemu, by running the
> build processes within qemu.

The interested hacker can look at (guix scripts offload) for an example
of such a build hook.  Build hooks are started by the daemon; they
receive build requests on stdin, which they can accept, reject, or
postpone.

Ludo’.

bug#20239: [wishlist] Add build hook to build for other platforms using qemu

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> It would be great if we had a build hook to enable guix-daemon to
> natively build packages for any system supported by qemu, by running the
> build processes within qemu.

QEMU has a ‘qemu-binfmt-conf.sh’ script that installs binfmt_misc
handlers for all the architecture-specific ELF variants.  Once you’ve
run this script, you can transparently run, say, ARM executables (the
kernel takes care of invoking ‘qemu-arm’ for you).

Without this, ‘qemu-arm’ & co. do not follow ‘execve’ syscalls, so
binfmt_misc is probably the only way to achieve what we want.

It actually works.  For instance, here I’m mimicking on my x86_64
machine what a .drv file for ARM describes:

  env -i TMPDIR=/tmp out=$PWD debug=$PWD "/gnu/store/mrq1big4g3icywwg8f6jd2cahq79wc6h-guile-2.0.14/bin/guile" --no-auto-compile -L "/gnu/store/kk5w5almhpx7g696vb9si8ham2r0z88l-module-import" -C "/gnu/store/80cdsxvx97c89slkajrkrdd9hw9p3smb-module-import-compiled" "/gnu/store/9667pad1s8ympbr8z0yr65qj061gzr19-coreutils-8.26-guile-builder"

(Here I’m using the ARM Guile, but for a slight speedup I could actually
use the native Guile.)

Then we just need to tell the daemon to not complain (“but I’m an
'x86_64-linux'”).

Ludo’.

bug#20239: [wishlist] Add build hook to build for other platforms using qemu

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1053 bytes --]

ludo@gnu.org (Ludovic Courtès) skribis:

> Mark H Weaver <mhw@netris.org> skribis:
>
>> It would be great if we had a build hook to enable guix-daemon to
>> natively build packages for any system supported by qemu, by running the
>> build processes within qemu.
>
> QEMU has a ‘qemu-binfmt-conf.sh’ script that installs binfmt_misc
> handlers for all the architecture-specific ELF variants.  Once you’ve
> run this script, you can transparently run, say, ARM executables (the
> kernel takes care of invoking ‘qemu-arm’ for you).

[...]

> Then we just need to tell the daemon to not complain (“but I’m an
> 'x86_64-linux'”).

The attached patch does that.

However, there’s an added complication: the file name of the qemu-*
executables registered in binfmt_misc are apparently resolved relative
to the root directory of the process that does ‘execve’.

So we would need to add a guix-daemon --chroot-directory=DIR argument
for each element in the closure of QEMU.  Not great.

Thoughts?

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1631 bytes --]

diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 9b7bb5391..bca75a4f9 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -1672,15 +1672,6 @@ void DerivationGoal::startBuilder()
     f.exceptions(boost::io::all_error_bits ^ boost::io::too_many_args_bit);
     startNest(nest, lvlInfo, f % showPaths(missingPaths) % curRound % nrRounds);
 
-    /* Right platform? */
-    if (!canBuildLocally(drv.platform)) {
-        if (settings.printBuildTrace)
-            printMsg(lvlError, format("@ unsupported-platform %1% %2%") % drvPath % drv.platform);
-        throw Error(
-            format("a `%1%' is required to build `%3%', but I am a `%2%'")
-            % drv.platform % settings.thisSystem % drvPath);
-    }
-
     /* Note: built-in builders are *not* running in a chroot environment so
        that we can easily implement them in Guile without having it as a
        derivation input (they are running under a separate build user,
@@ -2305,6 +2296,18 @@ void DerivationGoal::runChild()
 
         execve(drv.builder.c_str(), stringsToCharPtrs(args).data(), stringsToCharPtrs(envStrs).data());
 
+	int error = errno;
+
+	/* Right platform? */
+	if (error == ENOEXEC && !canBuildLocally(drv.platform)) {
+	    if (settings.printBuildTrace)
+		printMsg(lvlError, format("@ unsupported-platform %1% %2%") % drvPath % drv.platform);
+	    throw Error(
+		format("a `%1%' is required to build `%3%', but I am a `%2%'")
+		% drv.platform % settings.thisSystem % drvPath);
+	}
+
+	errno = error;
         throw SysError(format("executing `%1%'") % drv.builder);
 
     } catch (std::exception & e) {

bug#20239: [PATCH 0/4] Transparent emulation with QEMU and binfmt_misc

[Ludovic Courtès]

Hello!

I’ve finally implemented what we had discussed earlier: binfmt_misc
handlers that invoke QEMU to run code built for “foreign” architectures,
and an extension to the guix-daemon service that automatically adds
--chroot-directory flags for QEMU and all of its dependencies (as
returned by “guix gc -R $(guix build qemu)”.)  Pretty nice!

That adds a lot of stuff to the chroot, 87 store items currently.  I
believe it does not harm reproducibility though: these are unguessable
file names so it’s unlikely that a build process will use one of these
87 store items without having declared it as an input.  It’s still best
to avoid using it on our build farm though, to be sure.

Another issue is the extent to which QEMU faithfully emulates CPUs in
practice.  I have no idea, though I suspect Spectre attacks don’t work
in QEMU.  :-)  I think we’ll have to play with this and use ‘guix
challenge’ to see whether we get the same output as bare metal builds.

Note: for the real patch set, I’ll introduce a ‘guix’ package update in
the middle, without which we don’t get the ENOEXEC change in
‘guix-daemon’.

Feedback welcome!

Ludo’.

Ludovic Courtès (4):
  services: Add qemu-binfmt.
  services: guix: Add 'chroot-directories' field.
  services: qemu-binfmt: Extend guix-daemon with extra chroot
    directories.
  daemon: Always try to execute the builder regardless of the platform.

 doc/guix.texi                   |  88 +++++++++++++-
 gnu/services/base.scm           |  64 ++++++++--
 gnu/services/virtualization.scm | 261 +++++++++++++++++++++++++++++++++++++++-
 nix/libstore/build.cc           |  23 ++--
 4 files changed, 414 insertions(+), 22 deletions(-)

-- 
2.15.1

bug#20239: [PATCH 1/4] services: Add qemu-binfmt.

[Ludovic Courtès]

* 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
 
+@subsubheading Transparent Emulation with QEMU
+
+@cindex emulation
+@cindex @code{binfmt_misc}
+@code{qemu-binfmt-service-type} 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.
+
+@defvr {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:
+
+@example
+(service qemu-binfmt-service-type
+         (qemu-binfmt-configuration
+           (platforms (lookup-qemu-platforms "arm" "aarch64"))))
+@end 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}).
+@end defvr
+
+@deftp {Data Type} qemu-binfmt-configuration
+This is the configuration for the @code{qemu-binfmt} service.
+
+@table @asis
+@item @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).
+
+@item @code{qemu} (default: @code{qemu})
+The QEMU package to use.
+@end table
+@end deftp
+
+@deffn {Scheme Procedure} lookup-qemu-platforms @var{platforms}@dots{}
+Return the list of QEMU platform objects corresponding to
+@var{platforms}@dots{}.  @var{platforms} must be a list of strings
+corresponding to platform names, such as @code{"arm"}, @code{"sparc"},
+@code{"mips64el"}, and so on.
+@end deffn
+
+@deffn {Scheme Procedure} qemu-platform? @var{obj}
+Return true if @var{obj} is a platform object.
+@end deffn
+
+@deffn {Scheme Procedure} qemu-platform-name @var{platform}
+Return the name of @var{platform}---a string such as @code{"arm"}.
+@end 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 <ryan.moe@gmail.com>
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; 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))
+
+\f
+;;;
+;;; 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

bug#20239: [PATCH 1/4] services: Add qemu-binfmt.

[Danny Milosavljevic]

LGTM!

bug#20239: [PATCH 1/4] services: Add qemu-binfmt.

[Ludovic Courtès]

Hello,

Ludovic Courtès <ludo@gnu.org> skribis:

> * 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.

I fixed a couple of bugs here:

  - open the “…/register” file once for each platform instead of once
    for all;
  - hex-encode all the characters in the magic and mask fields of
    binfmt_misc (before that binfmt_misc would ignore everything after
    the first NUL).

I also added cross-references under the description of --system in the
manual, and a note about the ‘F’ flag of binfmt_misc.

Pushed now!

Thanks,
Ludo’.

bug#20239: [PATCH 2/4] services: guix: Add 'chroot-directories' field.

[Ludovic Courtès]

* gnu/services/base.scm (<guix-configuration>)[chroot-directories]: New
field.
(guix-shepherd-service): Honor it.
(references-file): New procedure.
(guix-service-type)[compose, extend]: New fields.
---
 gnu/services/base.scm | 64 ++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 53 insertions(+), 11 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 7c20232a6..8e30bcd34 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1434,6 +1434,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
                     (default #t))
   (substitute-urls  guix-configuration-substitute-urls ;list of strings
                     (default %default-substitute-urls))
+  (chroot-directories guix-configuration-chroot-directories ;list of file-like/strings
+                      (default '()))
   (max-silent-time  guix-configuration-max-silent-time ;integer
                     (default 0))
   (timeout          guix-configuration-timeout    ;integer
@@ -1457,23 +1459,35 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
   (match-record config <guix-configuration>
     (guix build-group build-accounts authorize-key? authorized-keys
           use-substitutes? substitute-urls max-silent-time timeout
-          log-compression extra-options log-file http-proxy tmpdir)
+          log-compression extra-options log-file http-proxy tmpdir
+          chroot-directories)
     (list (shepherd-service
            (documentation "Run the Guix daemon.")
            (provision '(guix-daemon))
            (requirement '(user-processes))
+           (modules '((srfi srfi-1)))
            (start
             #~(make-forkexec-constructor
-               (list #$(file-append guix "/bin/guix-daemon")
-                     "--build-users-group" #$build-group
-                     "--max-silent-time" #$(number->string max-silent-time)
-                     "--timeout" #$(number->string timeout)
-                     "--log-compression" #$(symbol->string log-compression)
-                     #$@(if use-substitutes?
-                            '()
-                            '("--no-substitutes"))
-                     "--substitute-urls" #$(string-join substitute-urls)
-                     #$@extra-options)
+               (cons* #$(file-append guix "/bin/guix-daemon")
+                      "--build-users-group" #$build-group
+                      "--max-silent-time" #$(number->string max-silent-time)
+                      "--timeout" #$(number->string timeout)
+                      "--log-compression" #$(symbol->string log-compression)
+                      #$@(if use-substitutes?
+                             '()
+                             '("--no-substitutes"))
+                      "--substitute-urls" #$(string-join substitute-urls)
+                      #$@extra-options
+
+                      ;; Add CHROOT-DIRECTORIES and all their dependencies (if
+                      ;; these are store items) to the chroot.
+                      (append-map (lambda (file)
+                                    (append-map (lambda (directory)
+                                                  (list "--chroot-directory"
+                                                        directory))
+                                                (call-with-input-file file
+                                                  read)))
+                                  '#$(map references-file chroot-directories)))
 
                #:environment-variables
                (list #$@(if http-proxy
@@ -1514,6 +1528,24 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
              #$@(map (cut hydra-key-authorization <> guix) keys))
          #~#f))))
 
+(define* (references-file item #:optional (name "references"))
+  "Return a file that contains the list of references of ITEM."
+  (if (struct? item)                              ;lowerable object
+      (computed-file name
+                     (with-imported-modules (source-module-closure
+                                             '((guix build store-copy)))
+                       #~(begin
+                           (use-modules (guix build store-copy))
+
+                           (call-with-output-file #$output
+                             (lambda (port)
+                               (write (call-with-input-file "graph"
+                                        read-reference-graph)
+                                      port)))))
+                     #:options `(#:local-build? #f
+                                 #:references-graphs (("graph" ,item))))
+      (plain-file name "()")))
+
 (define guix-service-type
   (service-type
    (name 'guix)
@@ -1523,6 +1555,16 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
           (service-extension activation-service-type guix-activation)
           (service-extension profile-service-type
                              (compose list guix-configuration-guix))))
+
+   ;; Extensions can specify extra directories to add to the build chroot.
+   (compose concatenate)
+   (extend (lambda (config directories)
+             (guix-configuration
+              (inherit config)
+              (chroot-directories
+               (append (guix-configuration-chroot-directories config)
+                       directories)))))
+
    (default-value (guix-configuration))
    (description
     "Run the build daemon of GNU@tie{}Guix, aka. @command{guix-daemon}.")))
-- 
2.15.1

bug#20239: [PATCH 2/4] services: guix: Add 'chroot-directories' field.

[Danny Milosavljevic]

LGTM!

bug#20239: [PATCH 3/4] services: qemu-binfmt: Extend guix-daemon with extra chroot directories.

[Ludovic Courtès]

Fixes <https://bugs.gnu.org/20239>.

* gnu/services/virtualization.scm (<qemu-binfmt-configuration>)[guix-support?]:
New field.
(qemu-binfmt-guix-chroot): New procedure.
(qemu-binfmt-service-type)[extensions]: Add GUIX-SERVICE-TYPE.
* doc/guix.texi (Virtualization Services): Document 'guix-support?'.
---
 doc/guix.texi                   | 29 +++++++++++++++++++++++++++++
 gnu/services/virtualization.scm | 16 ++++++++++++++--
 2 files changed, 43 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5c836ae96..85d95c4da 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17698,6 +17698,35 @@ This is the configuration for the @code{qemu-binfmt} service.
 The list of emulated QEMU platforms.  Each item must be a @dfn{platform
 object} as returned by @code{lookup-qemu-platforms} (see below).
 
+@item @code{guix-support?} (default: @code{#f})
+When it is true, QEMU and all its dependencies are added to the build
+environment of @command{guix-daemon} (@pxref{Invoking guix-daemon,
+@code{--chroot-directory} option}).  This allows the @code{binfmt_misc}
+handlers to be used within the build environment, which in turn means
+that you can transparently build programs for another architecture.
+
+For example, let's suppose you're on an x86_64 machine and you have this
+service:
+
+@example
+(service qemu-binfmt-service-type
+         (qemu-binfmt-configuration
+           (platforms (lookup-qemu-platforms "arm"))
+           (qemu-support? #t)))
+@end example
+
+You can run:
+
+@example
+guix build -s armhf-linux inkscape
+@end example
+
+@noindent
+and it will build Inkscape for ARMv7 @emph{as if it were a native
+build}, transparently using QEMU to emulate the ARMv7 CPU.  Pretty handy
+if you'd like to test a package build for an architecture you don't have
+access to!
+
 @item @code{qemu} (default: @code{qemu})
 The QEMU package to use.
 @end table
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index ac6afe043..f716de622 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -662,7 +662,9 @@ potential infinite waits blocking libvirt."))
   (qemu        qemu-binfmt-configuration-qemu
                (default qemu))
   (platforms   qemu-binfmt-configuration-platforms
-               (default '())))                    ;safest default
+               (default '()))                     ;safest default
+  (guix-support? qemu-binfmt-configuration-guix-support?
+                 (default #f)))
 
 (define (qemu-platform->binfmt qemu platform)
   "Return a gexp that evaluates to a binfmt string for PLATFORM, using the
@@ -724,6 +726,14 @@ given QEMU package."
                                 '#$(map qemu-platform-name platforms))
                       #f)))))))
 
+(define qemu-binfmt-guix-chroot
+  (match-lambda
+    ;; Add QEMU and its dependencies to the guix-daemon chroot so that our
+    ;; binfmt_misc handlers work in the chroot (otherwise 'execve' would fail
+    ;; with ENOENT.)
+    (($ <qemu-binfmt-configuration> qemu platforms guix?)
+     (if guix? (list qemu) '()))))
+
 (define qemu-binfmt-service-type
   ;; TODO: Make a separate binfmt_misc service out of this?
   (service-type (name 'qemu-binfmt)
@@ -731,7 +741,9 @@ given QEMU package."
                  (list (service-extension file-system-service-type
                                           (const (list %binfmt-file-system)))
                        (service-extension shepherd-root-service-type
-                                          qemu-binfmt-shepherd-services)))
+                                          qemu-binfmt-shepherd-services)
+                       (service-extension guix-service-type
+                                          qemu-binfmt-guix-chroot)))
                 (default-value (qemu-binfmt-configuration))
                 (description
                  "This service supports transparent emulation of binaries
-- 
2.15.1

bug#20239: [PATCH 3/4] services: qemu-binfmt: Extend guix-daemon with extra chroot directories.

[Danny Milosavljevic]

LGTM!

bug#20239: [PATCH 4/4] daemon: Always try to execute the builder regardless of the platform.

[Ludovic Courtès]

* nix/libstore/build.cc (runChild): Move platform check after 'execve'
call.  Check specifically for ENOEXEC.
---
 nix/libstore/build.cc | 23 ++++++++++++++---------
 1 file changed, 14 insertions(+), 9 deletions(-)

diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 275d6a5f7..34647e677 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -1682,15 +1682,6 @@ void DerivationGoal::startBuilder()
     f.exceptions(boost::io::all_error_bits ^ boost::io::too_many_args_bit);
     startNest(nest, lvlInfo, f % showPaths(missingPaths) % curRound % nrRounds);
 
-    /* Right platform? */
-    if (!canBuildLocally(drv.platform)) {
-        if (settings.printBuildTrace)
-            printMsg(lvlError, format("@ unsupported-platform %1% %2%") % drvPath % drv.platform);
-        throw Error(
-            format("a `%1%' is required to build `%3%', but I am a `%2%'")
-            % drv.platform % settings.thisSystem % drvPath);
-    }
-
     /* Note: built-in builders are *not* running in a chroot environment so
        that we can easily implement them in Guile without having it as a
        derivation input (they are running under a separate build user,
@@ -2311,6 +2302,20 @@ void DerivationGoal::runChild()
 
         execve(drv.builder.c_str(), stringsToCharPtrs(args).data(), stringsToCharPtrs(envStrs).data());
 
+	int error = errno;
+
+	/* Right platform?  Check this after we've tried 'execve' to allow for
+	   transparent emulation of different platforms with binfmt_misc
+	   handlers that invoke QEMU.  */
+	if (error == ENOEXEC && !canBuildLocally(drv.platform)) {
+	    if (settings.printBuildTrace)
+		printMsg(lvlError, format("@ unsupported-platform %1% %2%") % drvPath % drv.platform);
+	    throw Error(
+		format("a `%1%' is required to build `%3%', but I am a `%2%'")
+		% drv.platform % settings.thisSystem % drvPath);
+	}
+
+	errno = error;
         throw SysError(format("executing `%1%'") % drv.builder);
 
     } catch (std::exception & e) {
-- 
2.15.1

bug#20239: [PATCH 4/4] daemon: Always try to execute the builder regardless of the platform.

[Danny Milosavljevic]

> +
> +	errno = error;
>          throw SysError(format("executing `%1%'") % drv.builder);

Indentation off.  Otherwise LGTM!