;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 pkill-9, ison ;;; ;;; This file is not part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . ;;; The steam script provided by this package may optionally be started as ;;; a shell instead of automatically launching Steam by setting the ;;; environment variable DEBUG=1. If the sandbox is started this way then ;;; Steam should subsequently be launched via fhs-internal-script. ;;; The sandbox shell aids in debugging missing container elements. For ;;; example a missing symlink may be created manually before launching Steam ;;; to verify that the fix works before filing a bug report. (define-module (nongnu packages steam-client) #:use-module ((nonguix licenses) #:prefix license:) #:use-module (gnu packages) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix utils) #:use-module (guix download) #:use-module (guix build utils) #:use-module (guix build-system gnu) #:use-module (guix build-system trivial) #:use-module (gnu packages audio) #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages compression) #:use-module (gnu packages cups) #:use-module (gnu packages curl) #:use-module (gnu packages fonts) #:use-module (gnu packages fontutils) #:use-module (gnu packages freedesktop) #:use-module (gnu packages gcc) #:use-module (gnu packages gl) #:use-module (gnu packages glib) #:use-module (gnu packages gnome) #:use-module (gnu packages gnupg) #:use-module (gnu packages gstreamer) #:use-module (gnu packages gtk) #:use-module (gnu packages image) #:use-module (gnu packages libcanberra) #:use-module (gnu packages libffi) #:use-module (gnu packages libidn) #:use-module (gnu packages libusb) #:use-module (gnu packages linux) #:use-module (gnu packages nss) #:use-module (gnu packages pcre) #:use-module (gnu packages pulseaudio) #:use-module (gnu packages python) #:use-module (gnu packages sdl) #:use-module (gnu packages selinux) #:use-module (gnu packages sqlite) #:use-module (gnu packages tbb) #:use-module (gnu packages tls) #:use-module (gnu packages video) #:use-module (gnu packages vulkan) #:use-module (gnu packages xdisorg) #:use-module (gnu packages xiph) #:use-module (gnu packages xml) #:use-module (gnu packages xorg) #:use-module (srfi srfi-1)) (define-record-type* nonguix-container make-nonguix-container nonguix-container? this-nonguix-container (name ngc-name) (version ngc-version (default #f)) (wrap-package ngc-wrap-package) (run ngc-run) (wrapper-name ngc-wrapper-name (default "nonguix-container-wrapper")) (manifest-name ngc-manifest-name (default "nonguix-container-manifest.scm")) (internal-name ngc-internal-name (default "fhs-internal")) (sandbox-home ngc-sandbox-home (default ".local/share/guix-sandbox-home")) (union64 ngc-union64 (default '())) (union32 ngc-union32 (default '())) (preserved-env ngc-preserved-env (default '())) (exposed ngc-exposed (default '())) (shared ngc-shared (default '())) (modules ngc-modules (default '())) (packages ngc-packages (default '())) (home-page ngc-home-page (default #f)) (synopsis ngc-synopsis (default #f)) (description ngc-description (default #f)) (license ngc-license (default #f))) (define glibc-for-fhs (package (inherit glibc) (name "glibc-for-fhs") (source (origin (inherit (package-source glibc)) (snippet #f))))) ; Re-enable ldconfig. (define libgcrypt-1.5.4 ; Half-Life needs libgcrypt.so.11. (package (inherit libgcrypt) (version "1.5.4") (source (origin (method url-fetch) (uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-" version ".tar.bz2")) (sha256 (base32 "0czvqxkzd5y872ipy6s010ifwdwv29sqbnqc4pf56sd486gqvy6m")))))) (define libffi-3.2 (package (inherit libffi) (version "3.2") (source (origin (method url-fetch) (uri (string-append "ftp://sourceware.org/pub/libffi/" (package-name libffi) "-" version ".tar.gz")) (sha256 (base32 "1vylvsrbzrpqk298i4g1p82jxqkxhl2qf941sf0j775fyvxq09kb")))))) (define steam-client (package (name "steam-client") (version "1.0.0.61") (source (origin (method url-fetch) (uri (string-append "http://repo.steampowered.com/steam/archive/precise/steam_" version ".tar.gz")) (sha256 (base32 "0c5xy57gwr14vp3wy3jpqi5dl6y7n01p2dy4jlgl9bf9x7616r6n")) (file-name (string-append name "-" version ".tar.gz")))) (build-system gnu-build-system) (arguments `(#:tests? #f #:make-flags (list "PREFIX=" (string-append "DESTDIR=" (assoc-ref %outputs "out"))) #:phases (modify-phases %standard-phases (delete 'configure) (add-after 'unpack 'patch-startscript (lambda _ (substitute* "steam" (("/usr") (assoc-ref %outputs "out"))) #t)) (add-after 'unpack 'patch-desktop-file (lambda _ (substitute* "steam.desktop" (("Exec=/usr/bin/steam") "Exec=steam")) #t)) ;; Steamdeps installs missing packages, which doesn't work with Guix. (add-after 'install-binaries 'remove-unneccessary-file (lambda _ (delete-file (string-append (assoc-ref %outputs "out") "/bin/steamdeps")) #t))))) (home-page "https://store.steampowered.com") (synopsis "Digital distribution platform for managing and playing games") (description "Steam is a digital software distribution platform created by Valve.") (license (license:nonfree "file:///share/doc/steam/steam_subscriber_agreement.txt")))) (define fhs-min-libs `(("glibc-for-fhs" ,glibc-for-fhs) ("glibc-locales" ,glibc-locales))) (define steam-client-libs `(("alsa-lib" ,alsa-lib) ("alsa-plugins:pulseaudio" ,alsa-plugins "pulseaudio") ("at-spi2-atk" ,at-spi2-atk) ; Required by steam client beta. ("at-spi2-core" ,at-spi2-core) ; Required by steam client beta. ("atk" ,atk) ("bash" ,bash) ("bzip2" ,bzip2) ("cairo" ,cairo) ("coreutils" ,coreutils) ("cups" ,cups) ("curl" ,curl) ("dbus" ,dbus) ("dbus-glib" ,dbus-glib) ("eudev" ,eudev) ("expat" ,expat) ("fontconfig" ,fontconfig) ("freetype" ,freetype) ("gcc:lib" ,gcc "lib") ("gconf" ,gconf) ("gdk-pixbuf" ,gdk-pixbuf) ("glib" ,glib) ("gtk+" ,gtk+-2) ("libappindicator" ,libappindicator) ("libcap" ,libcap) ("libffi-3.2" ,libffi-3.2) ("libice" ,libice) ("libselinux" ,libselinux) ("libsm" ,libsm) ("libusb" ,libusb) ("libva" ,libva) ("libx11" ,libx11) ("libxcomposite" ,libxcomposite) ("libxcursor" ,libxcursor) ("libxdamage" ,libxdamage) ("libxext" ,libxext) ("libxfixes" ,libxfixes) ("libxi" ,libxi) ("libxinerama" ,libxinerama) ("libxrandr" ,libxrandr) ("libxrender" ,libxrender) ("libxscrnsaver" ,libxscrnsaver) ("libxtst" ,libxtst) ("libxxf86vm" ,libxxf86vm) ("mesa" ,mesa) ("network-manager" ,network-manager) ("nspr" ,nspr) ("nss" ,nss) ("openal" ,openal) ("pango" ,pango) ("pulseaudio" ,pulseaudio) ("sdl2" ,sdl2) ("vulkan-loader" ,vulkan-loader) ("zlib" ,zlib))) (define steam-gameruntime-libs `(("ffmpeg" ,ffmpeg) ("flac" ,flac) ("font-dejavu" ,font-dejavu) ("font-liberation" ,font-liberation) ("freeglut" ,freeglut) ("glew" ,glew) ("glu" ,glu) ("gst-plugins-base" ,gst-plugins-base) ("gst-plugins-ugly" ,gst-plugins-ugly) ("gstreamer" ,gstreamer) ("libcaca" ,libcaca) ("libcanberra" ,libcanberra) ("libdrm" ,libdrm) ("libgcrypt-1.5.4" ,libgcrypt-1.5.4) ("libgpg-error" ,libgpg-error) ("libidn" ,libidn) ("libjpeg-turbo" ,libjpeg-turbo) ("libmikmod" ,libmikmod) ("libogg" ,libogg) ("libpciaccess" ,libpciaccess) ("libpng" ,libpng) ("libpng-1.2" ,libpng-1.2) ("librsvg" ,librsvg) ("libsamplerate" ,libsamplerate) ("libtheora" ,libtheora) ("libtiff" ,libtiff) ("libvdpau" ,libvdpau) ("libvorbis" ,libvorbis) ("libvpx" ,libvpx) ("libxcb" ,libxcb) ("libxft" ,libxft) ("libxml2" ,libxml2) ("libxmu" ,libxmu) ("openssl" ,openssl) ("pixman" ,pixman) ("sdl" ,sdl) ("sdl-image" ,sdl-image) ("sdl-mixer" ,sdl-mixer) ("sdl-ttf" ,sdl-ttf) ("sdl2-image" ,sdl2-image) ("sdl2-mixer" ,sdl2-mixer) ("sdl2-ttf" ,sdl2-ttf) ("speex" ,speex) ("sqlite" ,sqlite) ("tbb" ,tbb) ("util-linux" ,util-linux) ("xkeyboard-config" ,xkeyboard-config))) ;;; Building ld.so.conf using find-files from package union results in error ;;; "Argument list too long" when launching Steam. (define (fhs-ld.so.conf) "Return a file-like object for ld.so.conf" (plain-file "ld.so.conf" (let ((dirs '("/lib" "/lib/alsa-lib" "/lib/dri" "/lib/nss" "/lib/vdpau" "/lib64" "/lib64/alsa-lib" "/lib64/dri" "/lib64/nss" "/lib64/vdpau"))) (string-join dirs "\n")))) (define (ld.so.conf->ld.so.cache ld-conf) (computed-file "ld.so.cache" (with-imported-modules `((guix build utils)) #~(begin (use-modules (guix build utils)) (let ((ldconfig (string-append #$glibc-for-fhs "/sbin/ldconfig"))) (invoke ldconfig "-X" ; Don't update symbolic links. "-f" #$ld-conf ; Use #$configuration as configuration file. "-C" #$output)))))) ; Use #$output as cache file. (define* (fhs-union inputs #:key (name "fhs-union") (version "0.0") (system "x86_64-linux")) "Create a package housing the union of inputs." (package (name name) (version version) (source #f) (inputs inputs) (build-system trivial-build-system) (arguments `(#:system ,system #:modules ((guix build union)) #:builder (begin (use-modules (ice-9 match) (guix build union)) (match %build-inputs (((names . directories) ...) (union-build (assoc-ref %outputs "out") directories) #t))))) (home-page #f) (synopsis "Libraries used for FHS") (description "Libraries needed to build a guix container FHS.") (license #f))) (define (nonguix-container->package container) "Returns a package housing the script launcher-name which executes file at relative path pkg-run from pkg inside a guix container with an FHS environment." (let* ((fhs-internal (make-container-internal container)) (fhs-manifest (make-container-manifest container fhs-internal)) (fhs-wrapper (make-container-wrapper container fhs-manifest fhs-internal)) (container-name (ngc-name container)) (union64 (ngc-union64 container)) (union32 (ngc-union32 container)) (pkg (ngc-wrap-package container))) (package (name container-name) (version (or (ngc-version container) (package-version pkg))) (source #f) (inputs `(,@(if (null? union64) '() `(("fhs-union-64" ,union64))) ,@(if (null? union32) '() `(("fhs-union-32" ,union32))) ("fhs-wrapper" ,fhs-wrapper))) (build-system trivial-build-system) (arguments `(#:modules ((guix build utils)) #:builder (begin (use-modules (guix build utils)) (let* ((bin (string-append (assoc-ref %outputs "out") "/bin")) (wrapper-target (assoc-ref %build-inputs "fhs-wrapper")) (wrapper-dest (string-append bin "/" ,container-name))) (mkdir-p bin) (symlink wrapper-target wrapper-dest))))) (home-page (or (ngc-home-page container) (package-home-page pkg))) (synopsis (or (ngc-synopsis container) (package-synopsis pkg))) (description (or (ngc-description container) (package-description pkg))) (license (or (ngc-license container) (package-license pkg)))))) (define (make-container-wrapper container fhs-manifest fhs-internal) "Return a script file-like object that launches a guix container for pkg." (program-file (ngc-wrapper-name container) (with-imported-modules `((guix build utils)) #~(begin (use-modules (guix build utils)) (define (preserve-var var) (string-append "--preserve=" var)) (define* (add-path path #:key writable?) (let ((opt (if writable? "--share=" "--expose="))) (if (pair? path) (string-append opt (car path) "=" (cdr path)) (string-append opt path)))) (define (exists-> file) (if (and file (file-exists? file)) `(,file) '())) (let* ((UID (number->string (passwd:uid (getpwnam (getenv "USER"))))) (run #$(file-append fhs-internal "/bin/" (ngc-internal-name container))) (manifest-file #$(file-append fhs-manifest)) (home (getenv "HOME")) (sandbox-home (string-append home "/" #$(ngc-sandbox-home container))) (preserved-env '("DISPLAY" "SDL_AUDIODRIVER" "STEAM_RUNTIME" "STEAM_RUNTIME_HEAVY" "STEAM_RUNTIME_PREFER_HOST_LIBRARIES" "XAUTHORITY" "XDG_DATA_HOME" "XDG_RUNTIME_DIR")) (expose `("/dev/dri" "/dev/input" ; Needed for controller input. ,@(exists-> "/etc/machine-id") "/sys/class/input" ; Needed for controller input. "/sys/dev" "/sys/devices" "/var/run/dbus")) (share `("/dev/shm" ,(string-append sandbox-home "=" home) ,@(exists-> (string-append home "/.config/pulse")) ,@(exists-> (string-append "/run/user/" UID "/pulse")) ,@(exists-> (string-append "/run/user/" UID "/bus")) ,@(exists-> (getenv "XAUTHORITY")))) (DEBUG (equal? (getenv "DEBUG") "1")) (command (if DEBUG '() `("--" ,run "\"$@\"")))) (format #t "\n* Launching ~a in sandbox: ~a.\n\n" #$(package-name (ngc-wrap-package container)) sandbox-home) (when DEBUG (format #t "* DEBUG set to 1: Starting shell. Launch application manually with: ~a.\n\n" #$(ngc-internal-name container))) (mkdir-p sandbox-home) (system "pulseaudio -D > /dev/null 2>&1") (apply system* `("guix" "environment" "--ad-hoc" "--container" "--no-cwd" "--network" ,@(map preserve-var preserved-env) ,@(map add-path expose) ,@(map (lambda (item) (add-path item #:writable? #t)) share) "-m" ,manifest-file ,@command))))))) (define (make-container-manifest container fhs-internal) "Return a scheme file-like object containing a container manifest." (scheme-file (ngc-manifest-name container) #~(begin (use-package-modules #$@(ngc-modules container)) (use-modules (guix gexp) (guix utils) (guix profiles) (guix store) (guix scripts package) (srfi srfi-11)) ;; Copied from guix/scripts/package.scm. (define (store-item->manifest-entry item) "Return a manifest entry for ITEM, a \"/gnu/store/...\" file name." (let-values (((name version) (package-name->name+version (store-path-package-name item) #\-))) (manifest-entry (name name) (version version) (output "out") ;XXX: wild guess (item item)))) (manifest-add (packages->manifest (list #$@(ngc-packages container))) (map store-item->manifest-entry '(#$(file-append (ngc-wrap-package container)) #$(file-append (ngc-union64 container)) #$(file-append (ngc-union32 container)) #$(file-append fhs-internal))))))) (define (make-container-internal container) "Return a package housing the fhs-internal-script." (package (name (ngc-internal-name container)) (version (ngc-version container)) (source #f) (inputs `(("fhs-internal-script" ,(make-internal-script container)))) (build-system trivial-build-system) (arguments `(#:modules ((guix build utils)) #:builder (begin (use-modules (guix build utils)) (let* ((bin (string-append (assoc-ref %outputs "out") "/bin")) (internal-target (assoc-ref %build-inputs "fhs-internal-script")) (internal-dest (string-append bin "/" ,(ngc-internal-name container)))) (mkdir-p bin) (symlink internal-target internal-dest))))) (home-page #f) (synopsis "Script used ot set up sandbox") (description "Script used inside the FHS guix container to setup the environment.") (license #f))) (define (make-internal-script container) "Return a script file-like object that performas additional setup in the FHS container before launching pkg-run." (let* ((ld.so.conf (fhs-ld.so.conf)) (ld.so.cache (ld.so.conf->ld.so.cache ld.so.conf)) (pkg (ngc-wrap-package container)) (run (ngc-run container))) (program-file (ngc-internal-name container) (with-imported-modules `((guix build utils)) #~(begin (use-modules (guix build utils)) (define (new-symlink target dest) (unless (file-exists? dest) (symlink target dest))) (for-each mkdir-p '("/sbin" "/usr/bin" "/usr/share" "/run/current-system/profile/etc" "/run/current-system/profile/share")) (let ((guix-env (getenv "GUIX_ENVIRONMENT")) (union64 #$(file-append (ngc-union64 container))) (union32 #$(file-append (ngc-union32 container))) (ld.so.conf #$(file-append ld.so.conf)) (ld.so.cache #$(file-append ld.so.cache)) (args (cdr (command-line)))) (new-symlink (string-append union64 "/lib/locale") "/run/current-system/locale") (new-symlink (string-append union64 "/share/fonts") "/run/current-system/profile/share/fonts") (new-symlink (string-append guix-env "/etc/ssl") "/run/current-system/profile/etc/ssl") (new-symlink (string-append guix-env "/etc/ssl") "/etc/ssl") (new-symlink (string-append union64 "/bin/env") "/usr/bin/env") (new-symlink (string-append union64 "/bin/bash") "/bin/bash") (new-symlink (string-append union64 "/bin/pulseaudio") "/bin/pulseaudio") (new-symlink (string-append union32 "/lib") "/run/current-system/profile/lib") (new-symlink (string-append union64 "/lib") "/run/current-system/profile/lib64") (new-symlink (string-append union32 "/lib") "/lib") (new-symlink (string-append union64 "/lib") "/lib64") (new-symlink ld.so.conf "/etc/ld.so.conf") (new-symlink ld.so.cache "/etc/ld.so.cache") (new-symlink (string-append union64 "/sbin/ldconfig") "/sbin/ldconfig") (new-symlink (string-append union64 "/share/vulkan") "/usr/share/vulkan") (apply system* `(#$(file-append pkg run) ,@args)))))))) (define-public steam (nonguix-container->package (nonguix-container (name "steam") (wrap-package steam-client) (run "/bin/steam") (union64 (fhs-union `(,@steam-client-libs ,@steam-gameruntime-libs ,@fhs-min-libs) #:name "fhs-union-64")) (union32 (fhs-union `(,@steam-client-libs ,@steam-gameruntime-libs ,@fhs-min-libs) #:name "fhs-union-32" #:system "i686-linux")) (modules `(base certs compression file gawk gnome linux python)) (packages `(coreutils diffutils file findutils gawk grep gzip nss-certs python sed strace tar util-linux+udev which xz zenity)) (description "Steam is a digital software distribution platform created by Valve. This package provides a script for launching Steam in a Guix container which will use the directory @file{$HOME/.local/share/guix-sandbox-home} where all games will be installed."))))