~ruther/guix-local

c52a9cee53db1e16df0c23ec10e352248e5372f8 — Ludovic Courtès 7 months ago 6d24249
linux-container: Export ‘%writable-/tmp’ and use it.

Fixes guix/guix#1994.

* gnu/build/linux-container.scm (%writable-/tmp): New variable.
* guix/scripts/environment.scm (launch-environment/container): Remove ‘tmpfs’
and use it.  Adjust ‘file-system’ declaration for /run/user/$UID.
* guix/scripts/home.scm (spawn-home-container): Likewise.

Reported-by: Romain GARBAGE <romain.garbage@inria.fr>
Change-Id: Ia8289fb5386971738caf2ccc1e815daa6ac28459
3 files changed, 21 insertions(+), 15 deletions(-)

M gnu/build/linux-container.scm
M guix/scripts/environment.scm
M guix/scripts/home.scm
M gnu/build/linux-container.scm => gnu/build/linux-container.scm +11 -0
@@ 30,6 30,7 @@
            unprivileged-user-namespace-supported?
            setgroups-supported?
            %namespaces
            %writable-/tmp
            run-container
            call-with-container
            container-excursion


@@ 387,6 388,16 @@ if there are no child processes left."
      (+ 128 (or (status:term-sig status)
                 (status:stop-sig status)))))

(define %writable-/tmp
  ;; Writable and volatile /tmp.
  (file-system
    (device "none")
    (mount-point "/tmp")
    (type "tmpfs")
    (flags '(no-suid no-dev))
    (options "mode=755,size=10%")
    (check? #f)))

(define* (call-with-container mounts thunk #:key (namespaces %namespaces)
                              (host-uids 1) (guest-uid 0) (guest-gid 0)
                              (lock-mounts? #t)

M guix/scripts/environment.scm => guix/scripts/environment.scm +6 -9
@@ 40,6 40,7 @@
  #:autoload   (ice-9 ftw) (scandir)
  #:autoload   (gnu build install) (evaluate-populate-directive)
  #:autoload   (gnu build linux-container) (call-with-container %namespaces
                                            %writable-/tmp
                                            user-namespace-supported?
                                            unprivileged-user-namespace-supported?
                                            setgroups-supported?)


@@ 771,13 772,6 @@ added to the container.

Preserve environment variables whose name matches the one of the regexps in
WHILE-LIST."
  (define tmpfs
    (file-system
      (device "none")
      (mount-point "/tmp")
      (type "tmpfs")
      (check? #f)))

  (define (optional-mapping->fs mapping)
    (and (file-exists? (file-system-mapping-source mapping))
         (file-system-mapping->bind-mount mapping)))


@@ 875,9 869,12 @@ WHILE-LIST."
                      (writable? #f)))
                   reqs)))
            (file-systems (append %container-file-systems
                                  (list tmpfs        ; RW /tmp
                                  (list %writable-/tmp
                                        (file-system ; RW /run
                                          (inherit tmpfs)
                                          (device "none")
                                          (type "tmpfs")
                                          (options "size=10%,mode=700")
                                          (check? #f)
                                          (mount-point
                                           (string-append "/run/user/"
                                                          (number->string uid))))

M guix/scripts/home.scm => guix/scripts/home.scm +4 -6
@@ 38,7 38,9 @@
                                     group-entry
                                     write-passwd
                                     write-group)
  #:autoload   (gnu build linux-container) (call-with-container %namespaces)
  #:autoload   (gnu build linux-container) (call-with-container
                                            %namespaces
                                            %writable-/tmp)
  #:use-module ((gnu system) #:select (operating-system?
                                       operating-system-user-services))
  #:autoload   (gnu system linux-container) (eval/container)


@@ 353,11 355,7 @@ immediately.  Return the exit status of the process in the container."
   #:namespaces (if network?
                    (delq 'net %namespaces)       ; share host network
                    %namespaces)
   #:mounts (list (file-system                    ;writable /tmp
                    (device "none")
                    (mount-point "/tmp")
                    (type "tmpfs")
                    (check? #f))
   #:mounts (list %writable-/tmp
                  (file-system
                    (device "none")
                    (mount-point