nonguix: Remove unnecessary modules from multiarch-container scripts.
* nonguix/multiarch-container.scm (packages->ld.so.conf)[computed-file]: Remove with-imported-modules and use-modules. (make-container-wrapper)[program-file]: Remove with-imported-modules. Signed-off-by: ison <ison@airmail.cc>
This commit is contained in:
parent
c7cb7dc6e5
commit
5bc3c9da84
|
@ -6,6 +6,7 @@
|
||||||
;;; Copyright © 2021 Kozo <kozodev@runbox.com>
|
;;; Copyright © 2021 Kozo <kozodev@runbox.com>
|
||||||
;;; Copyright © 2021, 2022 John Kehayias <john.kehayias@protonmail.com>
|
;;; Copyright © 2021, 2022 John Kehayias <john.kehayias@protonmail.com>
|
||||||
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
|
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
|
||||||
|
;;; Copyright © 2023 Attila Lendvai <attila@lendvai.name>
|
||||||
|
|
||||||
;;; The script provided by this package may optionally be started as
|
;;; The script provided by this package may optionally be started as
|
||||||
;;; a shell instead of automatically launching the wrapped entrypoint by setting
|
;;; a shell instead of automatically launching the wrapped entrypoint by setting
|
||||||
|
@ -161,30 +162,25 @@
|
||||||
in the Guix store"
|
in the Guix store"
|
||||||
(computed-file
|
(computed-file
|
||||||
"ld.so.conf"
|
"ld.so.conf"
|
||||||
(with-imported-modules
|
#~(begin
|
||||||
`((guix build union)
|
;; Need to quote "#$packages" as #$packages tries to "apply" the first item to the rest, like a procedure.
|
||||||
(guix build utils))
|
(let* ((packages '#$packages)
|
||||||
#~(begin
|
;; Add "/lib" to each package.
|
||||||
(use-modules (guix build union)
|
;; TODO Make this more general for other needed directories.
|
||||||
(guix build utils))
|
(dirs-lib
|
||||||
;; Need to quote "#$packages" as #$packages tries to "apply" the first item to the rest, like a procedure.
|
(lambda (packages)
|
||||||
(let* ((packages '#$packages)
|
(map (lambda (package)
|
||||||
;; Add "/lib" to each package.
|
(string-append package "/lib"))
|
||||||
;; TODO Make this more general for other needed directories.
|
packages)))
|
||||||
(dirs-lib
|
(fhs-lib-dirs
|
||||||
(lambda (packages)
|
(dirs-lib packages)))
|
||||||
(map (lambda (package)
|
(call-with-output-file #$output
|
||||||
(string-append package "/lib"))
|
(lambda (port)
|
||||||
packages)))
|
(for-each (lambda (directory)
|
||||||
(fhs-lib-dirs
|
(display directory port)
|
||||||
(dirs-lib packages)))
|
(newline port))
|
||||||
(call-with-output-file #$output
|
fhs-lib-dirs)))
|
||||||
(lambda (port)
|
#$output))))
|
||||||
(for-each (lambda (directory)
|
|
||||||
(display directory port)
|
|
||||||
(newline port))
|
|
||||||
fhs-lib-dirs)))
|
|
||||||
#$output)))))
|
|
||||||
|
|
||||||
(define (nonguix-container->package container)
|
(define (nonguix-container->package container)
|
||||||
"Return a package with wrapper script to launch the supplied container object
|
"Return a package with wrapper script to launch the supplied container object
|
||||||
|
@ -250,112 +246,110 @@ in a sandboxed FHS environment."
|
||||||
in a sandboxed FHS environment."
|
in a sandboxed FHS environment."
|
||||||
(program-file
|
(program-file
|
||||||
(ngc-wrapper-name container)
|
(ngc-wrapper-name container)
|
||||||
(with-imported-modules
|
#~(begin
|
||||||
`((guix build utils))
|
(use-modules (guix build utils))
|
||||||
#~(begin
|
(define (preserve-var var)
|
||||||
(use-modules (guix build utils))
|
(string-append "--preserve=" var))
|
||||||
(define (preserve-var var)
|
(define* (add-path path #:key writable?)
|
||||||
(string-append "--preserve=" var))
|
(let ((opt (if writable?
|
||||||
(define* (add-path path #:key writable?)
|
"--share="
|
||||||
(let ((opt (if writable?
|
"--expose=")))
|
||||||
"--share="
|
(if (pair? path)
|
||||||
"--expose=")))
|
(string-append opt (car path) "=" (cdr path))
|
||||||
(if (pair? path)
|
(string-append opt path))))
|
||||||
(string-append opt (car path) "=" (cdr path))
|
(define (exists-> file)
|
||||||
(string-append opt path))))
|
(if (and file (file-exists? file))
|
||||||
(define (exists-> file)
|
`(,file) '()))
|
||||||
(if (and file (file-exists? file))
|
(let* ((run #$(file-append fhs-internal "/bin/" (ngc-internal-name container)))
|
||||||
`(,file) '()))
|
(manifest-file #$(file-append fhs-manifest))
|
||||||
(let* ((run #$(file-append fhs-internal "/bin/" (ngc-internal-name container)))
|
(xdg-runtime (getenv "XDG_RUNTIME_DIR"))
|
||||||
(manifest-file #$(file-append fhs-manifest))
|
(home (getenv "HOME"))
|
||||||
(xdg-runtime (getenv "XDG_RUNTIME_DIR"))
|
(sandbox-home (or (getenv "GUIX_SANDBOX_HOME")
|
||||||
(home (getenv "HOME"))
|
(string-append home "/" #$(ngc-sandbox-home container))))
|
||||||
(sandbox-home (or (getenv "GUIX_SANDBOX_HOME")
|
(preserved-env '("^DBUS_"
|
||||||
(string-append home "/" #$(ngc-sandbox-home container))))
|
"^DISPLAY$"
|
||||||
(preserved-env '("^DBUS_"
|
"^DRI_PRIME$"
|
||||||
"^DISPLAY$"
|
"^GDK_SCALE$" ; For UI scaling.
|
||||||
"^DRI_PRIME$"
|
"^PRESSURE_VESSEL_" ; For pressure vessel options.
|
||||||
"^GDK_SCALE$" ; For UI scaling.
|
"_PROXY$"
|
||||||
"^PRESSURE_VESSEL_" ; For pressure vessel options.
|
"_proxy$"
|
||||||
"_PROXY$"
|
"^SDL_"
|
||||||
"_proxy$"
|
"^STEAM_"
|
||||||
"^SDL_"
|
"^VDPAU_DRIVER_PATH$" ; For VDPAU drivers.
|
||||||
"^STEAM_"
|
"^XAUTHORITY$"
|
||||||
"^VDPAU_DRIVER_PATH$" ; For VDPAU drivers.
|
;; Matching all ^XDG_ vars causes issues
|
||||||
"^XAUTHORITY$"
|
;; discussed in 80decf05.
|
||||||
;; Matching all ^XDG_ vars causes issues
|
"^XDG_DATA_HOME$"
|
||||||
;; discussed in 80decf05.
|
"^XDG_RUNTIME_DIR$"
|
||||||
"^XDG_DATA_HOME$"
|
;; The following are useful for debugging.
|
||||||
"^XDG_RUNTIME_DIR$"
|
"^CAPSULE_DEBUG$"
|
||||||
;; The following are useful for debugging.
|
"^G_MESSAGES_DEBUG$"
|
||||||
"^CAPSULE_DEBUG$"
|
"^LD_DEBUG$"
|
||||||
"^G_MESSAGES_DEBUG$"
|
"^LIBGL_DEBUG$"))
|
||||||
"^LD_DEBUG$"
|
(expose `("/dev/bus/usb" ; Needed for libusb.
|
||||||
"^LIBGL_DEBUG$"))
|
"/dev/dri"
|
||||||
(expose `("/dev/bus/usb" ; Needed for libusb.
|
"/dev/input" ; Needed for controller input.
|
||||||
"/dev/dri"
|
"/dev/uinput" ; Needed for Steam Input.
|
||||||
"/dev/input" ; Needed for controller input.
|
,@(exists-> "/dev/nvidia0") ; needed for nvidia proprietary driver
|
||||||
"/dev/uinput" ; Needed for Steam Input.
|
,@(exists-> "/dev/nvidiactl")
|
||||||
,@(exists-> "/dev/nvidia0") ; needed for nvidia proprietary driver
|
,@(exists-> "/dev/nvidia-modeset")
|
||||||
,@(exists-> "/dev/nvidiactl")
|
,@(exists-> "/etc/machine-id")
|
||||||
,@(exists-> "/dev/nvidia-modeset")
|
"/etc/localtime" ; Needed for correct time zone.
|
||||||
,@(exists-> "/etc/machine-id")
|
"/sys/class/drm" ; Needed for hw monitoring like MangoHud.
|
||||||
"/etc/localtime" ; Needed for correct time zone.
|
"/sys/class/hwmon" ; Needed for hw monitoring like MangoHud.
|
||||||
"/sys/class/drm" ; Needed for hw monitoring like MangoHud.
|
"/sys/class/hidraw" ; Needed for devices like the Valve Index.
|
||||||
"/sys/class/hwmon" ; Needed for hw monitoring like MangoHud.
|
"/sys/class/input" ; Needed for controller input.
|
||||||
"/sys/class/hidraw" ; Needed for devices like the Valve Index.
|
,@(exists-> "/sys/class/power_supply") ; Needed for power monitoring like MangoHud.
|
||||||
"/sys/class/input" ; Needed for controller input.
|
,@(exists-> "/sys/class/powercap") ; Needed for power monitoring like MangoHud.
|
||||||
,@(exists-> "/sys/class/power_supply") ; Needed for power monitoring like MangoHud.
|
"/sys/dev"
|
||||||
,@(exists-> "/sys/class/powercap") ; Needed for power monitoring like MangoHud.
|
"/sys/devices"
|
||||||
"/sys/dev"
|
,@(exists-> "/var/run/dbus")))
|
||||||
"/sys/devices"
|
;; /dev/hidraw is needed for SteamVR to access the HMD, although here we
|
||||||
,@(exists-> "/var/run/dbus")))
|
;; share all hidraw devices. Instead we could filter to only share specific
|
||||||
;; /dev/hidraw is needed for SteamVR to access the HMD, although here we
|
;; device. See, for example, this script:
|
||||||
;; share all hidraw devices. Instead we could filter to only share specific
|
;; https://arvchristos.github.io/post/matching-dev-hidraw-devices-with-physical-devices/
|
||||||
;; device. See, for example, this script:
|
(share `(,@(find-files "/dev" "hidraw")
|
||||||
;; https://arvchristos.github.io/post/matching-dev-hidraw-devices-with-physical-devices/
|
"/dev/shm"
|
||||||
(share `(,@(find-files "/dev" "hidraw")
|
;; "/tmp/.X11-unix" is needed for bwrap, and "/tmp" more generally
|
||||||
"/dev/shm"
|
;; for writing things like crash dumps and "steam_chrome_shm".
|
||||||
;; "/tmp/.X11-unix" is needed for bwrap, and "/tmp" more generally
|
"/tmp"
|
||||||
;; for writing things like crash dumps and "steam_chrome_shm".
|
,(string-append sandbox-home "=" home)
|
||||||
"/tmp"
|
,@(exists-> (string-append home "/.config/pulse"))
|
||||||
,(string-append sandbox-home "=" home)
|
,@(exists-> (string-append xdg-runtime "/pulse"))
|
||||||
,@(exists-> (string-append home "/.config/pulse"))
|
,@(exists-> (string-append xdg-runtime "/bus"))
|
||||||
,@(exists-> (string-append xdg-runtime "/pulse"))
|
,@(exists-> (getenv "XAUTHORITY"))))
|
||||||
,@(exists-> (string-append xdg-runtime "/bus"))
|
(DEBUG (equal? (getenv "DEBUG") "1"))
|
||||||
,@(exists-> (getenv "XAUTHORITY"))))
|
(args (cdr (command-line)))
|
||||||
(DEBUG (equal? (getenv "DEBUG") "1"))
|
(command (if DEBUG '()
|
||||||
(args (cdr (command-line)))
|
`("--" ,run ,@args))))
|
||||||
(command (if DEBUG '()
|
;; TODO: Remove once upstream change is merged and in stable pressure-vessel
|
||||||
`("--" ,run ,@args))))
|
;; (although may want to hold off for anyone using older pressure-vessel versions
|
||||||
;; TODO: Remove once upstream change is merged and in stable pressure-vessel
|
;; for whatever reason), see:
|
||||||
;; (although may want to hold off for anyone using older pressure-vessel versions
|
;; https://gitlab.steamos.cloud/steamrt/steam-runtime-tools/-/merge_requests/406
|
||||||
;; for whatever reason), see:
|
(setenv "PRESSURE_VESSEL_FILESYSTEMS_RO" "/gnu/store")
|
||||||
;; https://gitlab.steamos.cloud/steamrt/steam-runtime-tools/-/merge_requests/406
|
;; By default VDPAU drivers are searched for in libvdpau's store
|
||||||
(setenv "PRESSURE_VESSEL_FILESYSTEMS_RO" "/gnu/store")
|
;; path, so set this path to where the drivers will actually be
|
||||||
;; By default VDPAU drivers are searched for in libvdpau's store
|
;; located in the container.
|
||||||
;; path, so set this path to where the drivers will actually be
|
(setenv "VDPAU_DRIVER_PATH" "/lib64/vdpau")
|
||||||
;; located in the container.
|
(format #t "\n* Launching ~a in sandbox: ~a.\n\n"
|
||||||
(setenv "VDPAU_DRIVER_PATH" "/lib64/vdpau")
|
#$(package-name (ngc-wrap-package container)) sandbox-home)
|
||||||
(format #t "\n* Launching ~a in sandbox: ~a.\n\n"
|
(when DEBUG
|
||||||
#$(package-name (ngc-wrap-package container)) sandbox-home)
|
(format #t "* DEBUG set to 1: Starting shell. Launch application manually with: ~a.\n\n"
|
||||||
(when DEBUG
|
#$(ngc-internal-name container)))
|
||||||
(format #t "* DEBUG set to 1: Starting shell. Launch application manually with: ~a.\n\n"
|
(mkdir-p sandbox-home)
|
||||||
#$(ngc-internal-name container)))
|
(invoke #$(file-append pulseaudio "/bin/pulseaudio")
|
||||||
(mkdir-p sandbox-home)
|
"--start"
|
||||||
(invoke #$(file-append pulseaudio "/bin/pulseaudio")
|
"--exit-idle-time=60")
|
||||||
"--start"
|
(apply invoke
|
||||||
"--exit-idle-time=60")
|
`("guix" "shell"
|
||||||
(apply invoke
|
"--container" "--no-cwd" "--network"
|
||||||
`("guix" "shell"
|
,@(map preserve-var preserved-env)
|
||||||
"--container" "--no-cwd" "--network"
|
,@(map add-path expose)
|
||||||
,@(map preserve-var preserved-env)
|
,@(map (lambda (item)
|
||||||
,@(map add-path expose)
|
(add-path item #:writable? #t))
|
||||||
,@(map (lambda (item)
|
share)
|
||||||
(add-path item #:writable? #t))
|
"-m" ,manifest-file
|
||||||
share)
|
,@command))))))
|
||||||
"-m" ,manifest-file
|
|
||||||
,@command)))))))
|
|
||||||
|
|
||||||
(define (make-container-manifest container fhs-internal)
|
(define (make-container-manifest container fhs-internal)
|
||||||
"Return a scheme file-like object to be used as package manifest for FHS
|
"Return a scheme file-like object to be used as package manifest for FHS
|
||||||
|
|
Loading…
Reference in New Issue
Block a user