summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/authentication.scm22
-rw-r--r--gnu/services/base.scm3
-rw-r--r--gnu/services/cuirass.scm109
-rw-r--r--gnu/services/cups.scm12
-rw-r--r--gnu/services/databases.scm88
-rw-r--r--gnu/services/dbus.scm37
-rw-r--r--gnu/services/dns.scm21
-rw-r--r--gnu/services/sysctl.scm10
-rw-r--r--gnu/services/virtualization.scm227
9 files changed, 201 insertions, 328 deletions
diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index 73969a5a6d..d7efc48cd0 100644
--- a/gnu/services/authentication.scm
+++ b/gnu/services/authentication.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,6 +32,7 @@
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix packages)
+ #:use-module (guix modules)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -521,6 +523,16 @@ password.")
(define (pam-ldap-pam-services config)
(list (pam-ldap-pam-service config)))
+(define %nslcd-activation
+ (with-imported-modules (source-module-closure '((gnu build activation)))
+ #~(begin
+ (use-modules (gnu build activation))
+ (let ((rundir "/var/run/nslcd")
+ (user (getpwnam "nslcd")))
+ (mkdir-p/perms rundir user #o755)
+ (when (file-exists? "/etc/nslcd.conf")
+ (chmod "/etc/nslcd.conf" #o400))))))
+
(define nslcd-service-type
(service-type
(name 'nslcd)
@@ -531,15 +543,7 @@ password.")
(service-extension etc-service-type
nslcd-etc-service)
(service-extension activation-service-type
- (const #~(begin
- (use-modules (guix build utils))
- (let ((rundir "/var/run/nslcd")
- (user (getpwnam "nslcd")))
- (mkdir-p rundir)
- (chown rundir (passwd:uid user) (passwd:gid user))
- (chmod rundir #o755)
- (when (file-exists? "/etc/nslcd.conf")
- (chmod "/etc/nslcd.conf" #o400))))))
+ (const %nslcd-activation))
(service-extension pam-root-service-type
pam-ldap-pam-services)
(service-extension nscd-service-type
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index f6a490f712..f50bcfdcb4 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -35,6 +35,7 @@
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
+ #:use-module (gnu services sysctl)
#:use-module (gnu system pam)
#:use-module (gnu system shadow) ; 'user-account', etc.
#:use-module (gnu system uuid)
@@ -2532,6 +2533,8 @@ to handle."
(udev-configuration
(rules (list lvm2 fuse alsa-utils crda))))
+ (service sysctl-service-type)
+
(service special-files-service-type
`(("/bin/sh" ,(file-append bash "/bin/sh"))
("/usr/bin/env" ,(file-append coreutils "/bin/env"))))))
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 4d5e3a1041..9de36eb1c9 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -50,17 +50,7 @@
<cuirass-remote-worker-configuration>
cuirass-remote-worker-configuration
cuirass-remote-worker-configuration?
- cuirass-remote-worker-service-type
-
- <build-manifest>
- build-manifest
- build-manifest?
-
- <simple-cuirass-configuration>
- simple-cuirass-configuration
- simple-cuirass-configuration?
-
- simple-cuirass-configuration->specs))
+ cuirass-remote-worker-service-type))
;;;; Commentary:
;;;
@@ -76,9 +66,11 @@
cuirass-remote-server-configuration make-cuirass-remote-server-configuration
cuirass-remote-server-configuration?
(backend-port cuirass-remote-server-configuration-backend-port ;int
- (default #f))
+ (default 5555))
+ (log-port cuirass-remote-server-configuration-log-port ;int
+ (default 5556))
(publish-port cuirass-remote-server-configuration-publish-port ;int
- (default #f))
+ (default 5557))
(log-file cuirass-remote-server-log-file ;string
(default "/var/log/cuirass-remote-server.log"))
(cache cuirass-remote-server-configuration-cache ;string
@@ -153,6 +145,7 @@
(requirement '(guix-daemon postgres postgres-roles networking))
(start #~(make-forkexec-constructor
(list (string-append #$cuirass "/bin/cuirass")
+ "register"
"--cache-directory" #$cache-directory
"--specifications"
#$(scheme-file "cuirass-specs.scm" specs)
@@ -184,19 +177,15 @@
(requirement '(cuirass))
(start #~(make-forkexec-constructor
(list (string-append #$cuirass "/bin/cuirass")
- "--cache-directory" #$cache-directory
+ "web"
"--database" #$database
- "--web"
- "--port" #$(number->string port)
"--listen" #$host
- "--interval" #$(number->string interval)
+ "--port" #$(number->string port)
#$@(if parameters
(list (string-append
"--parameters="
parameters))
'())
- #$@(if use-substitutes? '("--use-substitutes") '())
- #$@(if fallback? '("--fallback") '())
#$@extra-options)
#:user #$user
@@ -213,7 +202,8 @@
(provision '(cuirass-remote-server))
(requirement '(avahi-daemon cuirass))
(start #~(make-forkexec-constructor
- (list (string-append #$cuirass "/bin/remote-server")
+ (list (string-append #$cuirass "/bin/cuirass")
+ "remote-server"
(string-append "--database=" #$database)
(string-append "--cache=" #$cache)
(string-append "--user=" #$user)
@@ -280,8 +270,6 @@
(remote-cache (and remote-server
(cuirass-remote-server-configuration-cache
remote-server)))
- (db (dirname
- (cuirass-configuration-database config)))
(user (cuirass-configuration-user config))
(log "/var/log/cuirass")
(group (cuirass-configuration-group config)))
@@ -290,7 +278,6 @@
(use-modules (guix build utils))
(mkdir-p #$cache)
- (mkdir-p #$db)
(mkdir-p #$log)
(when #$remote-cache
@@ -299,7 +286,6 @@
(let ((uid (passwd:uid (getpw #$user)))
(gid (group:gid (getgr #$group))))
(chown #$cache uid gid)
- (chown #$db uid gid)
(chown #$log uid gid)
(when #$remote-cache
@@ -344,7 +330,7 @@
(log-file cuirass-remote-worker-log-file ;string
(default "/var/log/cuirass-remote-worker.log"))
(publish-port cuirass-remote-worker-configuration-publish-port ;int
- (default #f))
+ (default 5558))
(public-key cuirass-remote-worker-configuration-public-key ;string
(default #f))
(private-key cuirass-remote-worker-configuration-private-key ;string
@@ -361,7 +347,8 @@ CONFIG."
(provision '(cuirass-remote-worker))
(requirement '(avahi-daemon guix-daemon networking))
(start #~(make-forkexec-constructor
- (list (string-append #$cuirass "/bin/remote-worker")
+ (list (string-append #$cuirass "/bin/cuirass")
+ "remote-worker"
(string-append "--workers="
#$(number->string workers))
#$@(if server
@@ -399,73 +386,3 @@ CONFIG."
cuirass-remote-worker-shepherd-service)))
(description
"Run the Cuirass remote build worker service.")))
-
-(define-record-type* <build-manifest>
- build-manifest make-build-manifest
- build-manifest?
- (channel-name build-manifest-channel-name) ;symbol
- (manifest build-manifest-manifest)) ;string
-
-(define-record-type* <simple-cuirass-configuration>
- simple-cuirass-configuration make-simple-cuirass-configuration
- simple-cuirass-configuration?
- (build simple-cuirass-configuration-build
- (default 'all)) ;symbol or list of <build-manifest>
- (channels simple-cuirass-configuration-channels
- (default %default-channels)) ;list of <channel>
- (non-package-channels simple-cuirass-configuration-package-channels
- (default '())) ;list of channels name
- (systems simple-cuirass-configuration-systems
- (default (list (%current-system))))) ;list of strings
-
-(define* (simple-cuirass-configuration->specs config)
- (define (format-name name)
- (if (string? name)
- name
- (symbol->string name)))
-
- (define (format-manifests build-manifests)
- (map (lambda (build-manifest)
- (match-record build-manifest <build-manifest>
- (channel-name manifest)
- (cons (format-name channel-name) manifest)))
- build-manifests))
-
- (define (channel->input channel)
- (let ((name (channel-name channel))
- (url (channel-url channel))
- (branch (channel-branch channel)))
- `((#:name . ,(format-name name))
- (#:url . ,url)
- (#:load-path . ".")
- (#:branch . ,branch)
- (#:no-compile? #t))))
-
- (define (package-path channels non-package-channels)
- (filter-map (lambda (channel)
- (let ((name (channel-name channel)))
- (and (not (member name non-package-channels))
- (not (eq? name 'guix))
- (format-name name))))
- channels))
-
- (define (config->spec config)
- (match-record config <simple-cuirass-configuration>
- (build channels non-package-channels systems)
- `((#:name . "simple-config")
- (#:load-path-inputs . ("guix"))
- (#:package-path-inputs . ,(package-path channels
- non-package-channels))
- (#:proc-input . "guix")
- (#:proc-file . "build-aux/cuirass/gnu-system.scm")
- (#:proc . cuirass-jobs)
- (#:proc-args . ((systems . ,systems)
- ,@(if (eq? build 'all)
- '()
- `((subset . "manifests")
- (manifests . ,(format-manifests build))))))
- (#:inputs . ,(map channel->input channels))
- (#:build-outputs . ())
- (#:priority . 1))))
-
- #~(list '#$(config->spec config)))
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index 17ed04e58b..20e3917b93 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,6 +32,7 @@
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix gexp)
+ #:use-module (guix modules)
#:use-module (ice-9 match)
#:use-module ((srfi srfi-1) #:select (append-map find))
#:export (cups-service-type
@@ -871,13 +873,11 @@ IPP specifications.")
(define %cups-activation
;; Activation gexp.
- (with-imported-modules '((guix build utils))
+ (with-imported-modules (source-module-closure '((gnu build activation)
+ (guix build utils)))
#~(begin
- (use-modules (guix build utils))
- (define (mkdir-p/perms directory owner perms)
- (mkdir-p directory)
- (chown directory (passwd:uid owner) (passwd:gid owner))
- (chmod directory perms))
+ (use-modules (gnu build activation)
+ (guix build utils))
(define (build-subject parameters)
(string-concatenate
(map (lambda (pair)
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 979f3dd6c8..a841e7a50e 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -79,13 +79,6 @@
memcached-configuration-udp-port
memcached-configuration-additional-options
- mongodb-configuration
- mongodb-configuration?
- mongodb-configuration-mongodb
- mongodb-configuration-config-file
- mongodb-configuration-data-directory
- mongodb-service-type
-
mysql-service
mysql-service-type
mysql-configuration
@@ -523,87 +516,6 @@ created after the PostgreSQL database is started.")))
;;;
-;;; MongoDB
-;;;
-
-(define %default-mongodb-configuration-file
- (plain-file
- "mongodb.yaml"
- "# GNU Guix: MongoDB default configuration file
-processManagement:
- pidFilePath: /var/run/mongodb/pid
-storage:
- dbPath: /var/lib/mongodb
-"))
-
-
-(define-record-type* <mongodb-configuration>
- mongodb-configuration make-mongodb-configuration
- mongodb-configuration?
- (mongodb mongodb-configuration-mongodb
- (default mongodb))
- (config-file mongodb-configuration-config-file
- (default %default-mongodb-configuration-file))
- (data-directory mongodb-configuration-data-directory
- (default "/var/lib/mongodb")))
-
-(define %mongodb-accounts
- (list (user-group (name "mongodb") (system? #t))
- (user-account
- (name "mongodb")
- (group "mongodb")
- (system? #t)
- (comment "Mongodb server user")
- (home-directory "/var/lib/mongodb")
- (shell (file-append shadow "/sbin/nologin")))))
-
-(define mongodb-activation
- (match-lambda
- (($ <mongodb-configuration> mongodb config-file data-directory)
- #~(begin
- (use-modules (guix build utils))
- (let ((user (getpwnam "mongodb")))
- (for-each
- (lambda (directory)
- (mkdir-p directory)
- (chown directory
- (passwd:uid user) (passwd:gid user)))
- '("/var/run/mongodb" #$data-directory)))))))
-
-(define mongodb-shepherd-service
- (match-lambda
- (($ <mongodb-configuration> mongodb config-file data-directory)
- (shepherd-service
- (provision '(mongodb))
- (documentation "Run the Mongodb daemon.")
- (requirement '(user-processes loopback))
- (start #~(make-forkexec-constructor
- `(,(string-append #$mongodb "/bin/mongod")
- "--config"
- ,#$config-file)
- #:user "mongodb"
- #:group "mongodb"
- #:pid-file "/var/run/mongodb/pid"
- #:log-file "/var/log/mongodb.log"))
- (stop #~(make-kill-destructor))))))
-
-(define mongodb-service-type
- (service-type
- (name 'mongodb)
- (description "Run the MongoDB document database server.")
- (extensions
- (list (service-extension shepherd-root-service-type
- (compose list
- mongodb-shepherd-service))
- (service-extension activation-service-type
- mongodb-activation)
- (service-extension account-service-type
- (const %mongodb-accounts))))
- (default-value
- (mongodb-configuration))))
-
-
-;;;
;;; MySQL.
;;;
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index e015d3f68d..af1a1e4c3a 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,6 +29,7 @@
#:use-module (guix gexp)
#:use-module ((guix packages) #:select (package-name))
#:use-module (guix records)
+ #:use-module (guix modules)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (dbus-configuration
@@ -161,24 +163,23 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(define (dbus-activation config)
"Return an activation gexp for D-Bus using @var{config}."
- #~(begin
- (use-modules (guix build utils))
-
- (mkdir-p "/var/run/dbus")
-
- (let ((user (getpwnam "messagebus")))
- (chown "/var/run/dbus"
- (passwd:uid user) (passwd:gid user))
-
- ;; This directory contains the daemon's socket so it must be
- ;; world-readable.
- (chmod "/var/run/dbus" #o755))
-
- (unless (file-exists? "/etc/machine-id")
- (format #t "creating /etc/machine-id...~%")
- (invoke (string-append #$(dbus-configuration-dbus config)
- "/bin/dbus-uuidgen")
- "--ensure=/etc/machine-id"))))
+ (with-imported-modules (source-module-closure
+ '((gnu build activation)
+ (guix build utils)))
+ #~(begin
+ (use-modules (gnu build activation)
+ (guix build utils))
+
+ (let ((user (getpwnam "messagebus")))
+ ;; This directory contains the daemon's socket so it must be
+ ;; world-readable.
+ (mkdir-p/perms "/var/run/dbus" user #o755))
+
+ (unless (file-exists? "/etc/machine-id")
+ (format #t "creating /etc/machine-id...~%")
+ (invoke (string-append #$(dbus-configuration-dbus config)
+ "/bin/dbus-uuidgen")
+ "--ensure=/etc/machine-id")))))
(define dbus-shepherd-service
(match-lambda
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index d4aefe6285..55211cb08f 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,6 +29,7 @@
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix gexp)
+ #:use-module (guix modules)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@@ -607,17 +609,14 @@
(shell (file-append shadow "/sbin/nologin")))))
(define (knot-activation config)
- #~(begin
- (use-modules (guix build utils))
- (define (mkdir-p/perms directory owner perms)
- (mkdir-p directory)
- (chown directory (passwd:uid owner) (passwd:gid owner))
- (chmod directory perms))
- (mkdir-p/perms #$(knot-configuration-run-directory config)
- (getpwnam "knot") #o755)
- (mkdir-p/perms "/var/lib/knot" (getpwnam "knot") #o755)
- (mkdir-p/perms "/var/lib/knot/keys" (getpwnam "knot") #o755)
- (mkdir-p/perms "/var/lib/knot/keys/keys" (getpwnam "knot") #o755)))
+ (with-imported-modules (source-module-closure '((gnu build activation)))
+ #~(begin
+ (use-modules (gnu build activation))
+ (mkdir-p/perms #$(knot-configuration-run-directory config)
+ (getpwnam "knot") #o755)
+ (mkdir-p/perms "/var/lib/knot" (getpwnam "knot") #o755)
+ (mkdir-p/perms "/var/lib/knot/keys" (getpwnam "knot") #o755)
+ (mkdir-p/perms "/var/lib/knot/keys/keys" (getpwnam "knot") #o755))))
(define (knot-shepherd-service config)
(let* ((config-file (knot-config-file config))
diff --git a/gnu/services/sysctl.scm b/gnu/services/sysctl.scm
index eb7a61b2a9..aaea7cc30d 100644
--- a/gnu/services/sysctl.scm
+++ b/gnu/services/sysctl.scm
@@ -25,20 +25,26 @@
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (sysctl-configuration
- sysctl-service-type))
+ sysctl-service-type
+ %default-sysctl-settings))
;;;
;;; System Control Service.
;;;
+(define %default-sysctl-settings
+ ;; Default kernel parameters enabled with sysctl.
+ '(("fs.protected_hardlinks" . "1")
+ ("fs.protected_symlinks" . "1")))
+
(define-record-type* <sysctl-configuration>
sysctl-configuration make-sysctl-configuration
sysctl-configuration?
(sysctl sysctl-configuration-sysctl ; path of the 'sysctl' command
(default (file-append procps "/sbin/sysctl")))
(settings sysctl-configuration-settings ; alist of string pairs
- (default '())))
+ (default %default-sysctl-settings)))
(define (sysctl-configuration-settings->sysctl.conf settings)
"Return a file for @command{sysctl} to set kernel parameters as specified by
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index a45da14a80..36e9feb05c 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -554,13 +554,14 @@ potential infinite waits blocking libvirt."))
;;;
;; Platforms that QEMU can emulate.
-(define-record-type <qemu-platform>
- (qemu-platform name family magic mask)
+(define-record-type* <qemu-platform>
+ qemu-platform make-qemu-platform
qemu-platform?
(name qemu-platform-name) ;string
(family qemu-platform-family) ;string
(magic qemu-platform-magic) ;bytevector
- (mask qemu-platform-mask)) ;bytevector
+ (mask qemu-platform-mask) ;bytevector
+ (flags qemu-platform-flags (default "F"))) ;string
(define-syntax bv
(lambda (s)
@@ -577,125 +578,173 @@ potential infinite waits blocking libvirt."))
;;; '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")))
+ (qemu-platform
+ (name "i386")
+ (family "i386")
+ (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x03\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "i486")
+ (family "i386")
+ (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x06\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "alpha")
+ (family "alpha")
+ (magic (bv "\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x26\x90"))
+ (mask (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")))
+ (qemu-platform
+ (name "arm")
+ (family "arm")
+ (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x28\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "armeb")
+ (family "arm")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x28"))
+ (mask (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")))
+ (qemu-platform
+ (name "sparc")
+ (family "sparc")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x02"))
+ (mask (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")))
+ (qemu-platform
+ (name "sparc32plus")
+ (family "sparc")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x12"))
+ (mask (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")))
+ (qemu-platform
+ (name "ppc")
+ (family "ppc")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x14"))
+ (mask (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")))
+ (qemu-platform
+ (name "ppc64")
+ (family "ppc")
+ (magic (bv "\x7fELF\x02\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x15"))
+ (mask (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")))
+ (qemu-platform
+ (name "ppc64le")
+ (family "ppcle")
+ (magic (bv "\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x15\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "m68k")
+ (family "m68k")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x04"))
+ (mask (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")))
+ (qemu-platform
+ (name "mips")
+ (family "mips")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08"))
+ (mask (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")))
+ (qemu-platform
+ (name "mipsel")
+ (family "mips")
+ (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "mipsn32")
+ (family "mips")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08"))
+ (mask (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")))
+ (qemu-platform
+ (name "mipsn32el")
+ (family "mips")
+ (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "mips64")
+ (family "mips")
+ (magic (bv "\x7fELF\x02\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08"))
+ (mask (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")))
+ (qemu-platform
+ (name "mips64el")
+ (family "mips")
+ (magic (bv "\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08\x00"))
+ (mask (bv "\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff"))))
(define %riscv32
- (qemu-platform "riscv32" "riscv"
- (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\xf3\x00")
- (bv "\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+ (qemu-platform
+ (name "riscv32")
+ (family "riscv")
+ (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\xf3\x00"))
+ (mask (bv "\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff"))))
(define %riscv64
- (qemu-platform "riscv64" "riscv"
- (bv "\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\xf3\x00")
- (bv "\xff\xff\xff\xff\xff\xff\xff\x00\xff\xff\xff\xff\xff\xff\xff\xff\xfe\xff\xff\xff")))
+ (qemu-platform
+ (name "riscv64")
+ (family "riscv")
+ (magic (bv "\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\xf3\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "sh4")
+ (family "sh4")
+ (magic (bv "\x7fELF\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x2a\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "sh4eb")
+ (family "sh4")
+ (magic (bv "\x7fELF\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x2a"))
+ (mask (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")))
+ (qemu-platform
+ (name "s390x")
+ (family "s390x")
+ (magic (bv "\x7fELF\x02\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x16"))
+ (mask (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")))
+ (qemu-platform
+ (name "aarch64")
+ (family "arm")
+ (magic (bv "\x7fELF\x02\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\xb7\x00"))
+ (mask (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")))
+ (qemu-platform
+ (name "hppa")
+ (family "hppa")
+ (magic (bv "\x7f\x45\x4c\x46\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x0f"))
+ (mask (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
@@ -715,9 +764,7 @@ potential infinite waits blocking libvirt."))
(qemu qemu-binfmt-configuration-qemu
(default qemu))
(platforms qemu-binfmt-configuration-platforms
- (default '())) ;safest default
- (guix-support? qemu-binfmt-configuration-guix-support?
- (default #t)))
+ (default '()))) ;safest default
(define (qemu-platform->binfmt qemu platform)
"Return a gexp that evaluates to a binfmt string for PLATFORM, using the
@@ -733,14 +780,13 @@ given QEMU package."
(bytevector->u8-list bv))))
(match platform
- (($ <qemu-platform> name family magic mask)
+ (($ <qemu-platform> name family magic mask flags)
;; See 'Documentation/binfmt_misc.txt' in the kernel.
#~(string-append ":qemu-" #$name ":M::"
#$(bytevector->binfmt-string magic)
":" #$(bytevector->binfmt-string mask)
- ":" #$(file-append qemu "/bin/qemu-" name)
- ":" ;FLAGS go here
- ))))
+ ":" #$qemu:static "/bin/qemu-" #$name
+ ":" #$flags))))
(define %binfmt-mount-point
(file-system-mount-point %binary-format-file-system))
@@ -779,19 +825,6 @@ 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.)
- ;;
- ;; The 'F' flag of binfmt_misc is meant to address this problem by loading
- ;; the interpreter upfront rather than lazily, but apparently that is
- ;; insufficient (perhaps it loads the 'qemu-ARCH' binary upfront but looks
- ;; up its dependencies lazily?).
- (($ <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)
@@ -800,9 +833,7 @@ given QEMU package."
(const
(list %binary-format-file-system)))
(service-extension shepherd-root-service-type
- qemu-binfmt-shepherd-services)
- (service-extension guix-service-type
- qemu-binfmt-guix-chroot)))
+ qemu-binfmt-shepherd-services)))
(default-value (qemu-binfmt-configuration))
(description
"This service supports transparent emulation of binaries
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-21 11:01:10 +0000