pack: Create /tmp in Docker images.
Fixes <https://bugs.gnu.org/37161>. * guix/scripts/pack.scm (docker-image)[build]: Add a 'directory' entry for "/tmp" to DIRECTIVES. * tests/pack.scm ("docker-image + localstatedir"): Test the presence of /tmp. * gnu/tests/docker.scm (run-docker-test)["Load docker image and run it"]: Test the presence and permission bits of "/tmp".
This commit is contained in:
parent
2b7c89f4fc
commit
7979a287f8
|
@ -100,7 +100,7 @@ inside %DOCKER-OS."
|
||||||
marionette))
|
marionette))
|
||||||
|
|
||||||
(test-equal "Load docker image and run it"
|
(test-equal "Load docker image and run it"
|
||||||
'("hello world" "hi!" "JSON!")
|
'("hello world" "hi!" "JSON!" #o1777)
|
||||||
(marionette-eval
|
(marionette-eval
|
||||||
`(begin
|
`(begin
|
||||||
(define slurp
|
(define slurp
|
||||||
|
@ -131,8 +131,15 @@ inside %DOCKER-OS."
|
||||||
,(string-append #$docker-cli "/bin/docker")
|
,(string-append #$docker-cli "/bin/docker")
|
||||||
"run" repository&tag
|
"run" repository&tag
|
||||||
"-c" "(use-modules (json))
|
"-c" "(use-modules (json))
|
||||||
(display (json-string->scm (scm->json-string \"JSON!\")))")))
|
(display (json-string->scm (scm->json-string \"JSON!\")))"))
|
||||||
(list response1 response2 response3)))
|
|
||||||
|
;; Check whether /tmp exists.
|
||||||
|
(response4 (slurp
|
||||||
|
,(string-append #$docker-cli "/bin/docker")
|
||||||
|
"run" repository&tag "-c"
|
||||||
|
"(display (stat:perms (lstat \"/tmp\")))")))
|
||||||
|
(list response1 response2 response3
|
||||||
|
(string->number response4))))
|
||||||
marionette))
|
marionette))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
|
@ -511,8 +511,10 @@ the image."
|
||||||
(,source -> ,target))))))
|
(,source -> ,target))))))
|
||||||
|
|
||||||
(define directives
|
(define directives
|
||||||
;; Fully-qualified symlinks.
|
;; Create a /tmp directory, as some programs expect it, and
|
||||||
(append-map symlink->directives '#$symlinks))
|
;; create SYMLINKS.
|
||||||
|
`((directory "/tmp" ,(getuid) ,(getgid) #o1777)
|
||||||
|
,@(append-map symlink->directives '#$symlinks)))
|
||||||
|
|
||||||
|
|
||||||
(setenv "PATH" (string-append #$archiver "/bin"))
|
(setenv "PATH" (string-append #$archiver "/bin"))
|
||||||
|
|
|
@ -169,6 +169,7 @@
|
||||||
(when
|
(when
|
||||||
(and (file-exists? (string-append bin "/guile"))
|
(and (file-exists? (string-append bin "/guile"))
|
||||||
(file-exists? "var/guix/db/db.sqlite")
|
(file-exists? "var/guix/db/db.sqlite")
|
||||||
|
(file-is-directory? "tmp")
|
||||||
(string=? (string-append #$%bootstrap-guile "/bin")
|
(string=? (string-append #$%bootstrap-guile "/bin")
|
||||||
(pk 'binlink (readlink bin)))
|
(pk 'binlink (readlink bin)))
|
||||||
(string=? (string-append #$profile "/bin/guile")
|
(string=? (string-append #$profile "/bin/guile")
|
||||||
|
|
Loading…
Reference in New Issue