linux-container: Add #:mounts to ‘eval/container’.

* gnu/system/linux-container.scm (eval/container): Add #:mounts
parameter and honor it.

Change-Id: I1d5970f53a3d67db93e937e392f9bf36e75d1573
This commit is contained in:
Ludovic Courtès 2025-04-04 16:07:15 +02:00
parent e9cd72875e
commit d4c3b31b86
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016-2017, 2019-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2017, 2019-2023, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Google LLC ;;; Copyright © 2020 Google LLC
@ -319,13 +319,14 @@ Run the container with the given options."))
(define* (eval/container exp (define* (eval/container exp
#:key #:key
(mappings '()) (mappings '())
(mounts '())
(namespaces %namespaces) (namespaces %namespaces)
(guest-uid 0) (guest-gid 0)) (guest-uid 0) (guest-gid 0))
"Evaluate EXP, a gexp, in a new process executing in separate namespaces as "Evaluate EXP, a gexp, in a new process executing in separate namespaces as
listed in NAMESPACES. Add MAPPINGS, a list of <file-system-mapping>, to the listed in NAMESPACES. Add MOUNTS, a list of <file-system>, and MAPPINGS, a
set of directories visible in the process's mount namespace. Inside the list of <file-system-mapping>, to the set of directories visible in the
namespaces, run code as GUEST-UID and GUEST-GID. Return the process' exit process's mount namespace. Inside the namespaces, run code as GUEST-UID and
status as a monadic value. GUEST-GID. Return the process' exit status as a monadic value.
This is useful to implement processes that, unlike derivations, are not This is useful to implement processes that, unlike derivations, are not
entirely pure and need to access the outside world or to perform side entirely pure and need to access the outside world or to perform side
@ -342,13 +343,14 @@ effects."
(mbegin %store-monad (mbegin %store-monad
(built-derivations inputs) (built-derivations inputs)
(mlet %store-monad ((closure ((store-lift requisites) items))) (mlet %store-monad ((closure ((store-lift requisites) items)))
(return (call-with-container (map file-system-mapping->bind-mount (return (call-with-container (append mounts
(append (map (lambda (item) (map file-system-mapping->bind-mount
(file-system-mapping (append (map (lambda (item)
(source item) (file-system-mapping
(target source))) (source item)
closure) (target source)))
mappings)) closure)
mappings)))
(lambda () (lambda ()
(apply execl (apply execl
(string-append (derivation-input-output-path (string-append (derivation-input-output-path