From 1eb21f95917689b6b0ecd295da32af0c4ec721ff Mon Sep 17 00:00:00 2001 From: Daniel Ziltener Date: Thu, 28 Dec 2023 22:05:45 +0100 Subject: [PATCH] . --- .guix-channel | 6 +- nonguix/build-system/binary.scm | 145 ----- nonguix/build-system/chromium-binary.scm | 209 ------- nonguix/build/binary-build-system.scm | 152 ----- .../build/chromium-binary-build-system.scm | 75 --- nonguix/build/utils.scm | 119 ---- nonguix/download.scm | 50 -- nonguix/licenses.scm | 29 - nonguix/modules.scm | 23 - nonguix/multiarch-container.scm | 561 ------------------ nonguix/utils.scm | 24 - 11 files changed, 5 insertions(+), 1388 deletions(-) delete mode 100644 nonguix/build-system/binary.scm delete mode 100644 nonguix/build-system/chromium-binary.scm delete mode 100644 nonguix/build/binary-build-system.scm delete mode 100644 nonguix/build/chromium-binary-build-system.scm delete mode 100644 nonguix/build/utils.scm delete mode 100644 nonguix/download.scm delete mode 100644 nonguix/licenses.scm delete mode 100644 nonguix/modules.scm delete mode 100644 nonguix/multiarch-container.scm delete mode 100644 nonguix/utils.scm diff --git a/.guix-channel b/.guix-channel index 3707908..53a748e 100644 --- a/.guix-channel +++ b/.guix-channel @@ -4,4 +4,8 @@ (channel (version 0) (news-file "news.txt") - (url "https://gitea.lyrion.ch/zilti/guixchannel")) + (url "https://gitea.lyrion.ch/zilti/guixchannel") + (dependencies + (channel + (name nonguix) + (url "https://gitlab.com/nonguix/nonguix.git")))) diff --git a/nonguix/build-system/binary.scm b/nonguix/build-system/binary.scm deleted file mode 100644 index 121162d..0000000 --- a/nonguix/build-system/binary.scm +++ /dev/null @@ -1,145 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2019 Julien Lepiller -;;; Copyright © 2021 Josselin Poiret - -(define-module (nonguix build-system binary) - #:use-module (guix store) - #:use-module (guix utils) - #:use-module (guix gexp) - #:use-module (guix monads) - #:use-module (guix derivations) - #:use-module (guix search-paths) - #:use-module (guix build-system) - #:use-module (guix build-system gnu) - #:use-module (guix build-system copy) - #:use-module (guix packages) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:use-module (nonguix utils) - #:export (%binary-build-system-modules - default-patchelf - default-glibc - lower - binary-build - binary-build-system)) - -;; Commentary: -;; -;; Standard build procedure for binary packages. This is implemented as an -;; extension of `copy-build-system'. -;; -;; Code: - -(define %binary-build-system-modules - ;; Build-side modules imported by default. - `((nonguix build binary-build-system) - (nonguix build utils) - ,@%copy-build-system-modules)) - -(define (default-patchelf) - "Return the default patchelf package." - - ;; Do not use `@' to avoid introducing circular dependencies. - (let ((module (resolve-interface '(gnu packages elf)))) - (module-ref module 'patchelf))) - -(define (default-glibc) - "Return the default glibc package." - ;; Do not use `@' to avoid introducing circular dependencies. - (let ((module (resolve-interface '(gnu packages base)))) - (module-ref module 'glibc))) - -(define* (lower name - #:key source inputs native-inputs outputs system target - (patchelf (default-patchelf)) - (glibc (default-glibc)) - #:allow-other-keys - #:rest arguments) - "Return a bag for NAME." - (define private-keywords - '(#:target #:patchelf #:inputs #:native-inputs)) - - (and (not target) ;XXX: no cross-compilation - (bag - (name name) - (system system) - (host-inputs `(,@(if source - `(("source" ,source)) - '()) - ,@inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - (build-inputs `(("patchelf" ,patchelf) - ,@native-inputs - ;; If current system is i686, the *32 packages will be the - ;; same as the non-32, but that's OK. - ("libc32" ,(to32 glibc)))) - (outputs outputs) - (build binary-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) - -(define* (binary-build name inputs - #:key - guile source - (outputs '("out")) - (patchelf-plan ''()) - (install-plan ''(("." "./"))) - (search-paths '()) - (out-of-source? #t) - (validate-runpath? #t) - (patch-shebangs? #t) - (strip-binaries? #t) - (strip-flags ''("--strip-debug")) - (strip-directories ''("lib" "lib64" "libexec" - "bin" "sbin")) - (phases '(@ (nonguix build binary-build-system) - %standard-phases)) - (system (%current-system)) - (imported-modules %binary-build-system-modules) - (modules '((nonguix build binary-build-system) - (guix build utils) - (nonguix build utils))) - (substitutable? #t) - allowed-references - disallowed-references) - "Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE -provides its own binaries." - (define builder - (with-imported-modules imported-modules - #~(begin - (use-modules #$@modules) - - #$(with-build-variables inputs outputs - #~(binary-build #:source #+source - #:system #$system - #:outputs %outputs - #:inputs %build-inputs - #:patchelf-plan #$patchelf-plan - #:install-plan #$install-plan - #:search-paths '#$(map search-path-specification->sexp - search-paths) - #:phases #$phases - #:out-of-source? #$out-of-source? - #:validate-runpath? #$validate-runpath? - #:patch-shebangs? #$patch-shebangs? - #:strip-binaries? #$strip-binaries? - #:strip-flags #$strip-flags - #:strip-directories #$strip-directories))))) - - (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) - system #:graft? #f))) - (gexp->derivation name builder - #:system system - #:target #f - #:substitutable? substitutable? - #:allowed-references allowed-references - #:disallowed-references disallowed-references - #:guile-for-build guile))) - -(define binary-build-system - (build-system - (name 'binary) - (description "The standard binary build system") - (lower lower))) - -;;; binary.scm ends here diff --git a/nonguix/build-system/chromium-binary.scm b/nonguix/build-system/chromium-binary.scm deleted file mode 100644 index 931a6ef..0000000 --- a/nonguix/build-system/chromium-binary.scm +++ /dev/null @@ -1,209 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2023 Giacomo Leidi - -(define-module (nonguix build-system chromium-binary) - #:use-module (gnu packages bash) - #:use-module (gnu packages compression) - #:use-module (gnu packages cups) - #:use-module (gnu packages databases) - #:use-module (gnu packages fontutils) - #:use-module (gnu packages gcc) - #:use-module (gnu packages gl) - #:use-module (gnu packages glib) - #:use-module (gnu packages gnome) - #:use-module (gnu packages gtk) - #:use-module (gnu packages kerberos) - #:use-module (gnu packages linux) - #:use-module (gnu packages nss) - #:use-module (gnu packages pulseaudio) - #:use-module (gnu packages xdisorg) - #:use-module (gnu packages xorg) - #:use-module (gnu packages xml) - #:use-module (guix store) - #:use-module (guix utils) - #:use-module (guix gexp) - #:use-module (guix monads) - #:use-module (guix derivations) - #:use-module (guix search-paths) - #:use-module (guix build-system) - #:use-module (guix build-system gnu) - #:use-module (guix packages) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:use-module (nonguix build-system binary) - #:use-module (nonguix utils) - #:export (%chromium-binary-build-system-modules - lower - chromium-binary-build - chromium-binary-build-system)) - -;; Commentary: -;; -;; Standard build procedure for Chromium based binary packages. This is -;; implemented as an extension of `binary-build-system'. -;; -;; Code: - -(define %chromium-binary-build-system-modules - ;; Build-side modules imported by default. - `((nonguix build chromium-binary-build-system) - (nonguix build utils) - ,@%binary-build-system-modules)) - -(define (build-patchelf-plan wrapper-plan inputs) - #~(let ((patchelf-inputs - (list #$@(map car inputs)))) - (map (lambda (file) - (cons file (list patchelf-inputs))) - #$wrapper-plan))) - -(define* (lower name - #:key source inputs native-inputs outputs system target - (patchelf (default-patchelf)) - (glibc (default-glibc)) - #:allow-other-keys - #:rest arguments) - "Return a bag for NAME." - (define private-keywords - '(#:target #:patchelf #:inputs #:native-inputs)) - (define host-inputs - `(,@(if source - `(("source" ,source)) - '()) - - ("alsa-lib" ,alsa-lib) - ("atk" ,atk) - ("at-spi2-atk" ,at-spi2-atk) - ("at-spi2-core" ,at-spi2-core) - ("bash-minimal" ,bash-minimal) - ("cairo" ,cairo) - ("cups" ,cups) - ("dbus" ,dbus) - ("eudev" ,eudev) - ("expat" ,expat) - ("fontconfig" ,fontconfig) - ("freetype" ,freetype) - ("gcc:lib" ,gcc "lib") - ("glib" ,glib) - ("gtk+" ,gtk+) - ("libdrm" ,libdrm) - ("libnotify" ,libnotify) - ("librsvg" ,librsvg) - ("libsecret" ,libsecret) - ("libx11" ,libx11) - ("libxcb" ,libxcb) - ("libxcomposite" ,libxcomposite) - ("libxcursor" ,libxcursor) - ("libxdamage" ,libxdamage) - ("libxext" ,libxext) - ("libxfixes" ,libxfixes) - ("libxi" ,libxi) - ("libxkbcommon" ,libxkbcommon) - ("libxkbfile" ,libxkbfile) - ("libxrandr" ,libxrandr) - ("libxrender" ,libxrender) - ("libxshmfence" ,libxshmfence) - ("libxtst" ,libxtst) - ("mesa" ,mesa) - ("mit-krb5" ,mit-krb5) - ("nspr" ,nspr) - ("nss" ,nss) - ("pango" ,pango) - ("pulseaudio" ,pulseaudio) - ("sqlcipher" ,sqlcipher) - ("xcb-util" ,xcb-util) - ("xcb-util-image" ,xcb-util-image) - ("xcb-util-keysyms" ,xcb-util-keysyms) - ("xcb-util-renderutil" ,xcb-util-renderutil) - ("xcb-util-wm" ,xcb-util-wm) - ("zlib" ,zlib) - - ,@inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - - (and (not target) ;XXX: no cross-compilation - (bag - (name name) - (system system) - (host-inputs host-inputs) - (build-inputs `(("patchelf" ,patchelf) - ,@native-inputs - ;; If current system is i686, the *32 packages will be the - ;; same as the non-32, but that's OK. - ("libc32" ,(to32 glibc)))) - (outputs outputs) - (build chromium-binary-build) - (arguments (append - (strip-keyword-arguments private-keywords arguments) - (list #:wrap-inputs host-inputs)))))) - -(define* (chromium-binary-build name inputs - #:key - guile source wrap-inputs - (outputs '("out")) - (wrapper-plan ''()) - (patchelf-plan ''()) - (install-plan ''(("." "./"))) - (search-paths '()) - (out-of-source? #t) - (validate-runpath? #t) - (patch-shebangs? #t) - (strip-binaries? #t) - (strip-flags ''("--strip-debug")) - (strip-directories ''("lib" "lib64" "libexec" - "bin" "sbin")) - (phases '(@ (nonguix build chromium-binary-build-system) - %standard-phases)) - (system (%current-system)) - (imported-modules %chromium-binary-build-system-modules) - (modules '((nonguix build chromium-binary-build-system) - (guix build utils) - (nonguix build utils))) - (substitutable? #t) - allowed-references - disallowed-references) - "Build SOURCE using binary-build-system." - (define builder - (with-imported-modules imported-modules - #~(begin - (use-modules #$@modules) - - #$(with-build-variables inputs outputs - #~(chromium-binary-build #:source #+source - #:system #$system - #:outputs %outputs - #:inputs %build-inputs - #:patchelf-plan - #$(if (equal? wrapper-plan ''()) - patchelf-plan - (build-patchelf-plan wrapper-plan - wrap-inputs)) - #:install-plan #$install-plan - #:search-paths '#$(map search-path-specification->sexp - search-paths) - #:phases #$phases - #:out-of-source? #$out-of-source? - #:validate-runpath? #$validate-runpath? - #:patch-shebangs? #$patch-shebangs? - #:strip-binaries? #$strip-binaries? - #:strip-flags #$strip-flags - #:strip-directories #$strip-directories))))) - - (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) - system #:graft? #f))) - (gexp->derivation name builder - #:system system - #:target #f - #:substitutable? substitutable? - #:allowed-references allowed-references - #:disallowed-references disallowed-references - #:guile-for-build guile))) - -(define chromium-binary-build-system - (build-system - (name 'chromium-binary) - (description "The Chromium based binary build system") - (lower lower))) - -;;; chromium-binary.scm ends here diff --git a/nonguix/build/binary-build-system.scm b/nonguix/build/binary-build-system.scm deleted file mode 100644 index 087ef89..0000000 --- a/nonguix/build/binary-build-system.scm +++ /dev/null @@ -1,152 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2019 Julien Lepiller -;;; Copyright © 2022 Attila Lendvai - -(define-module (nonguix build binary-build-system) - #:use-module ((guix build gnu-build-system) #:prefix gnu:) - #:use-module (nonguix build utils) - #:use-module (guix build utils) - #:use-module (ice-9 match) - #:export (%standard-phases - binary-build)) - -;; Commentary: -;; -;; Builder-side code of the standard binary build procedure. -;; -;; Code: - -(define (new-install) - "Return the copy-build-system `install' procedure." - (@@ (guix build copy-build-system) install)) - -(define* (old-install #:key install-plan outputs #:allow-other-keys) - "Copy files from the \"source\" build input to the \"out\" output according to INSTALL-PLAN. - -An INSTALL-PLAN is made of three elements: - -- A source path which is a file or directory from the \"source\" build input. -- Patterns of the files to copy (only useful if the source path is a directory). -- The target destination. - -If the target ends with a slash, it represents the target directory. If not, it -represent the target full path, which only makes sense for single files." - (define (install-file file target) - (let ((target (string-append (assoc-ref outputs "out") - "/" target - (if (string-suffix? "/" target) - (string-append "/" file) - "")))) - (mkdir-p (dirname target)) - (copy-file file target))) - - (define (install-file-pattern pattern target) - (for-each - (lambda (file) - (install-file file target)) - (find-files "." pattern))) - - (define (install plan) - (match plan - ((file-or-directory files target) - (if (file-is-directory? file-or-directory) - (with-directory-excursion file-or-directory - (for-each - (lambda (pattern) - (install-file-pattern pattern target)) - files)) - (install-file file-or-directory target))))) - - (for-each install install-plan) - #t) - -(define* (install #:key install-plan outputs #:allow-other-keys) - (define (install-old-format) - (warn "Install-plan format deprecated. -Please update to the format of the copy-build-system.") - (old-install #:install-plan install-plan #:outputs outputs)) - (match (car install-plan) - ((source (. matches) target) - (install-old-format)) - ((source #f target) - (install-old-format)) - (_ ((new-install) #:install-plan install-plan #:outputs outputs)))) - -(define* (patchelf #:key inputs outputs patchelf-plan #:allow-other-keys) - "Set the interpreter and the RPATH of files as per the PATCHELF-PLAN. - -The PATCHELF-PLAN elements are lists of: - -- The file to patch. -- The inputs (as strings) to include in the rpath, e.g. \"mesa\". - -Both executables and dynamic libraries are accepted. -The inputs are optional when the file is an executable." - (define (binary-patch binary interpreter runpath) - - (define* (maybe-make-rpath entries name #:optional (extra-path "/lib")) - (let ((entry (assoc-ref entries name))) - (if entry - (string-append entry extra-path) - #f))) - - (define* (make-rpath name #:optional (extra-path "/lib")) - (or (maybe-make-rpath outputs name extra-path) - (maybe-make-rpath inputs name extra-path) - (error (format #f "`~a' not found among the inputs nor the outputs." - name)))) - - (unless (string-contains binary ".so") - ;; Use `system*' and not `invoke' since this may raise an error if - ;; library does not end with .so. - (system* "patchelf" "--set-interpreter" interpreter binary)) - (when runpath - (let ((rpath (string-join - (map - (match-lambda - ((name extra-path) - (make-rpath name extra-path)) - (name - (make-rpath name))) - runpath) - ":"))) - (invoke "patchelf" "--set-rpath" rpath binary))) - #t) - - (when (and patchelf-plan - (not (null? patchelf-plan))) - (let ((interpreter (car (find-files (assoc-ref inputs "libc") "ld-linux.*\\.so"))) - (interpreter32 (car (find-files (assoc-ref inputs "libc32") "ld-linux.*\\.so")))) - (for-each - (lambda (plan) - (match plan - ((binary runpath) - (binary-patch binary (if (64-bit? binary) - interpreter - interpreter32) - runpath)) - ((binary) - (binary-patch binary (if (64-bit? binary) - interpreter - interpreter32) - #f)))) - patchelf-plan))) - #t) - -(define %standard-phases - ;; Everything is as with the GNU Build System except for the `configure' - ;; , `build', `check' and `install' phases. - (modify-phases gnu:%standard-phases - (delete 'bootstrap) - (delete 'configure) - (delete 'build) - (delete 'check) - (add-before 'install 'patchelf patchelf) - (replace 'install install))) - -(define* (binary-build #:key inputs (phases %standard-phases) - #:allow-other-keys #:rest args) - "Build the given package, applying all of PHASES in order." - (apply gnu:gnu-build #:inputs inputs #:phases phases args)) - -;;; binary-build-system.scm ends here diff --git a/nonguix/build/chromium-binary-build-system.scm b/nonguix/build/chromium-binary-build-system.scm deleted file mode 100644 index 0fed9bf..0000000 --- a/nonguix/build/chromium-binary-build-system.scm +++ /dev/null @@ -1,75 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2023 Giacomo Leidi - -(define-module (nonguix build chromium-binary-build-system) - #:use-module ((guix build gnu-build-system) #:prefix gnu:) - #:use-module ((nonguix build binary-build-system) #:prefix binary:) - #:use-module (nonguix build utils) - #:use-module (guix build utils) - #:use-module (ice-9 ftw) - #:use-module (ice-9 match) - #:export (%standard-phases - chromium-binary-build)) - -;; Commentary: -;; -;; Builder-side code of the Chromium binary build procedure. -;; -;; Code: - -(define* (install-wrapper #:key inputs outputs #:allow-other-keys) - (let* ((output (assoc-ref outputs "out")) - (bin (string-append output "/bin")) - (fontconfig-minimal (assoc-ref inputs "fontconfig")) - (nss (assoc-ref inputs "nss")) - (wrap-inputs (map cdr inputs)) - (lib-directories - (build-paths-from-inputs '("lib") wrap-inputs)) - (bin-directories - (build-paths-from-inputs - '("bin" "sbin" "libexec") - wrap-inputs))) - (for-each - (lambda (exe) - (display (string-append "Wrapping " exe "\n")) - (wrap-program exe - `("FONTCONFIG_PATH" ":" prefix - (,(string-join - (list - (string-append fontconfig-minimal "/etc/fonts") - output) - ":"))) - `("PATH" ":" prefix - (,(string-join - (append - bin-directories - (list - bin)) - ":"))) - `("LD_LIBRARY_PATH" ":" prefix - (,(string-join - (append - lib-directories - (list - (string-append nss "/lib/nss") - output)) - ":"))))) - (map - (lambda (exe) (string-append bin "/" exe)) - (filter - (lambda (exe) (not (string-prefix? "." exe))) - (scandir bin)))) - #t)) - -(define %standard-phases - ;; Everything is as with the binary-build-system except for the - ;; `install-wrapper' phase. - (modify-phases binary:%standard-phases - (add-after 'install 'install-wrapper install-wrapper))) - -(define* (chromium-binary-build #:key inputs (phases %standard-phases) - #:allow-other-keys #:rest args) - "Build the given package, applying all of PHASES in order." - (apply gnu:gnu-build #:inputs inputs #:phases phases args)) - -;;; chromium-binary-build-system.scm ends here diff --git a/nonguix/build/utils.scm b/nonguix/build/utils.scm deleted file mode 100644 index e7d6966..0000000 --- a/nonguix/build/utils.scm +++ /dev/null @@ -1,119 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2019 Pierre Neidhardt -;;; Copyright © 2020 Alex Griffin -;;; Copyright © 2023 Giacomo Leidi - -(define-module (nonguix build utils) - #:use-module (ice-9 match) - #:use-module (ice-9 binary-ports) - #:use-module (guix build utils) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:export (64-bit? - make-wrapper - concatenate-files - build-paths-from-inputs)) - -(define (64-bit? file) - "Return true if ELF file is in 64-bit format, false otherwise. -See https://en.wikipedia.org/wiki/Executable_and_Linkable_Format#File_header." - (with-input-from-file file - (lambda () - (= 2 - (array-ref (get-bytevector-n (current-input-port) 5) 4))) - #:binary #t)) - -(define* (make-wrapper wrapper real-file #:key (skip-argument-0? #f) #:rest vars) - "Like `wrap-program' but create WRAPPER around REAL-FILE. -The wrapper automatically changes directory to that of REAL-FILE. - -Example: - - (make-wrapper \"bin/foo\" \"sub-dir/original-foo\" - '(\"PATH\" \":\" = (\"/gnu/.../bar/bin\")) - '(\"CERT_PATH\" suffix (\"/gnu/.../baz/certs\" - \"/qux/certs\"))) - -will create 'bin/foo' with the following -contents: - - #!location/of/bin/bash - export PATH=\"/gnu/.../bar/bin\" - export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/gnu/.../baz/certs:/qux/certs\" - cd sub-dir - exec -a $0 sub-dir/original-foo \"$@\"." - (define (export-variable lst) - ;; Return a string that exports an environment variable. - (match lst - ((var sep '= rest) - (format #f "export ~a=\"~a\"" - var (string-join rest sep))) - ((var sep 'prefix rest) - (format #f "export ~a=\"~a${~a:+~a}$~a\"" - var (string-join rest sep) var sep var)) - ((var sep 'suffix rest) - (format #f "export ~a=\"$~a${~a+~a}~a\"" - var var var sep (string-join rest sep))) - ((var '= rest) - (format #f "export ~a=\"~a\"" - var (string-join rest ":"))) - ((var 'prefix rest) - (format #f "export ~a=\"~a${~a:+:}$~a\"" - var (string-join rest ":") var var)) - ((var 'suffix rest) - (format #f "export ~a=\"$~a${~a:+:}~a\"" - var var var (string-join rest ":"))))) - - (define (remove-keyword-arguments lst) - (match lst - (() '()) - (((? keyword? _) _ lst ...) - (remove-keyword-arguments lst)) - (_ lst))) - - (mkdir-p (dirname wrapper)) - (call-with-output-file wrapper - (lambda (port) - (format port - (if skip-argument-0? - "#!~a~%~a~%cd \"~a\"~%exec \"~a\" \"$@\"~%" - "#!~a~%~a~%cd \"~a\"~%exec -a \"$0\" \"~a\" \"$@\"~%") - (which "bash") - (string-join - (map export-variable (remove-keyword-arguments vars)) - "\n") - (dirname real-file) - (canonicalize-path real-file)))) - (chmod wrapper #o755)) - -(define (concatenate-files files result) - "Make RESULT the concatenation of all of FILES." - (define (dump file port) - (put-bytevector - port - (call-with-input-file file - get-bytevector-all))) - - (call-with-output-file result - (lambda (port) - (for-each (cut dump <> port) files)))) - -(define build-paths-for-input - (lambda (dirs input) - (filter-map - (lambda (sub-directory) - (let ((directory - (string-append - input "/" sub-directory))) - (and - (directory-exists? directory) - directory))) - dirs))) - -(define build-paths-from-inputs - (lambda (dirs inputs) - (reduce append '() - (map - (lambda (input) - (build-paths-for-input dirs input)) - inputs)))) diff --git a/nonguix/download.scm b/nonguix/download.scm deleted file mode 100644 index 0eb661a..0000000 --- a/nonguix/download.scm +++ /dev/null @@ -1,50 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2019 Julien Lepiller - -(define-module (nonguix download) - #:use-module (guix derivations) - #:use-module (guix monads) - #:use-module (guix packages) - #:use-module (guix store) - #:use-module (ice-9 match) - #:export (unredistributable-url-fetch)) - -(define* (unredistributable-url-fetch url hash-algo hash - #:optional name - #:key (system (%current-system)) - (guile (default-guile))) - "Return a fixed-output derivation that fetches URL (a string) which is expected -to have HASH of type HASH-ALGO (a symbol). By default, the file name is the base -name of URL; optionally, NAME can specify a different file name. - -This is a simpler version of url-fetch from Guix, that doesn't support mirror:// -or file:// uris. It is specifically designed to prevent substitution of the -source, for the purpose of downloading copyrighted content you have access to, -but you don't have the right to redistribute. By marking the derivation as non -substitutable, this fetch prevents you from giving others access to the source -if you run a substitute server on your machine." - (define file-name - (match url - ((head _ ...) - (basename head)) - (_ - (basename url)))) - - (mlet %store-monad () - (raw-derivation (or name file-name) "builtin:download" '() - #:system system - #:hash-algo hash-algo - #:hash hash - - ;; Honor the user's proxy and locale settings. - #:leaked-env-vars '("http_proxy" "https_proxy" - "LC_ALL" "LC_MESSAGES" "LANG" - "COLUMNS") - #:env-vars `(("url" . ,(object->string url))) - - ;; Do not offload because the remote daemon may not support - ;; the 'download' builtin. - #:local-build? #t - - ;; Do not substitute copyrighted material - #:substitutable? #f))) diff --git a/nonguix/licenses.scm b/nonguix/licenses.scm deleted file mode 100644 index a09452a..0000000 --- a/nonguix/licenses.scm +++ /dev/null @@ -1,29 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2019 Alex Griffin - -(define-module (nonguix licenses) - #:use-module (guix licenses) - #:export (nonfree - undistributable)) - -(define license (@@ (guix licenses) license)) - -(define* (nonfree uri #:optional (comment "")) - "Return a nonfree license, whose full text can be found -at URI, which may be a file:// URI pointing the package's tree." - (license "Nonfree" - uri - (string-append - "This a nonfree license. Check the URI for details. " - comment))) - -(define* (undistributable uri #:optional (comment "")) - "Return a nonfree license for packages which may not be redistributed, whose -full text can be found at URI, which may be a file:// URI pointing the -package's tree." - (license "Nonfree Undistributable" - uri - (string-append - "This a nonfree license. This package may NOT be redistributed " - "in prebuilt form. Check the URI for details. " - comment))) diff --git a/nonguix/modules.scm b/nonguix/modules.scm deleted file mode 100644 index cd07d44..0000000 --- a/nonguix/modules.scm +++ /dev/null @@ -1,23 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2020 Alex Griffin - -(define-module (nonguix modules) - #:use-module (ice-9 match) - #:export (import-nonguix-module?)) - -(define (nonguix-module-name? name) - "Return true if NAME (a list of symbols) denotes a Guix or Nonguix module." - (match name - (('guix _ ...) #t) - (('gnu _ ...) #t) - (('nonguix _ ...) #t) - (('nongnu _ ...) #t) - (_ #f))) - -;; Since we don't use deduplication support in 'populate-store', don't -;; import (guix store deduplication) and its dependencies, which -;; includes Guile-Gcrypt. -(define (import-nonguix-module? module) - "Return true if MODULE is not (guix store deduplication)" - (and (nonguix-module-name? module) - (not (equal? module '(guix store deduplication))))) diff --git a/nonguix/multiarch-container.scm b/nonguix/multiarch-container.scm deleted file mode 100644 index b333b71..0000000 --- a/nonguix/multiarch-container.scm +++ /dev/null @@ -1,561 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2020 pkill-9 -;;; Copyright © 2020, 2021 ison -;;; Copyright © 2021 pineapples -;;; Copyright © 2021 Jean-Baptiste Volatier -;;; Copyright © 2021 Kozo -;;; Copyright © 2021, 2022 John Kehayias -;;; Copyright © 2023 Giacomo Leidi -;;; Copyright © 2023 Attila Lendvai -;;; Copyright © 2023 Elijah Malaby - -;;; The script provided by this package may optionally be started as -;;; a shell instead of automatically launching the wrapped entrypoint by setting -;;; the environment variable DEBUG=1. If the sandbox is started this way then -;;; the package should subsequently be launched via fhs-internal. - -;;; The sandbox shell aids in debugging missing container elements. For -;;; example a missing symlink may be created manually before launching the -;;; package to verify that the fix works before filing a bug report. - -;;; A container wrapper creates the following store items: -;;; * Main container package [nonguix-container->package] (basically a dummy -;;; package with symlink to wrapper script) -;;; - Wrapper script [make-container-wrapper] (runs "guix shell") -;;; References: -;;; -> manifest.scm [make-container-manifest] (used by wrapper to guarantee -;;; exact store items) -;;; -> container-internal [make-container-internal] {inside container} -;;; (dummy package added to container with symlink to internal-script) -;;; - internal-script [make-internal-script] {inside container} -;;; (script run in-container which performs additional setup before -;;; launching the desired application) -;;; References: -;;; -> Wrapped package {inside container}. - -;;; Note: The extra container-internal package is necessary because there is no -;;; way to add the container package's own store path to its own manifest unless -;;; the manifest is printed inside the build phases. However, the (guix gexp) -;;; module is apparently disallowed inside build phases. - -(define-module (nonguix multiarch-container) - #:use-module (gnu packages) - #:use-module (gnu packages base) - #:use-module (gnu packages pulseaudio) - #:use-module (guix build-system trivial) - #:use-module (guix gexp) - #:use-module (guix records) - #:use-module (guix packages) - - #:export (nonguix-container - nonguix-container? - ngc-name - ngc-version - ngc-wrap-package - ngc-run - ngc-wrapper-name - ngc-manifest-name - ngc-internal-name - ngc-sandbox-home - ngc-ld.so.conf - ngc-ld.so.cache - ngc-union64 - ngc-union32 - ngc-preserved-env - ngc-exposed - ngc-shared - ngc-modules - ngc-packages - ngc-link-files - ngc-home-page - ngc-synopsis - ngc-description - ngc-license - - fhs-min-libs - fhs-union - ld.so.conf->ld.so.cache - packages->ld.so.conf - nonguix-container->package)) - -(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")) - (ld.so.conf ngc-ld.so.conf) - (ld.so.cache ngc-ld.so.cache) - (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 '())) - (link-files ngc-link-files (default '())) - (home-page ngc-home-page (default #f)) - (synopsis ngc-synopsis (default #f)) - (description ngc-description (default #f)) - (license ngc-license (default #f))) - -(define fhs-min-libs - `(("glibc" ,(@@ (gnu packages base) glibc-for-fhs)) - ("glibc-locales" ,glibc-locales))) - -(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 - (((_ . 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 (ld.so.conf->ld.so.cache ld-conf) - "Create a ld.so.cache file-like object from an ld.so.conf file." - (computed-file - "ld.so.cache" - (with-imported-modules - `((guix build utils)) - #~(begin - (use-modules (guix build utils)) - (let ((ldconfig (string-append #$glibc "/sbin/ldconfig"))) - (invoke ldconfig - "-X" ; Don't update symbolic links. - "-f" #$ld-conf ; Use #$ld-conf as configuration file. - "-C" #$output)))))) ; Use #$output as cache file. - -(define (packages->ld.so.conf packages) - "Takes a list of package objects and returns a file-like object for ld.so.conf -in the Guix store" - (computed-file - "ld.so.conf" - #~(begin - ;; Need to quote "#$packages" as #$packages tries to "apply" the first item to the rest, like a procedure. - (let* ((packages '#$packages) - ;; Add "/lib" to each package. - ;; TODO Make this more general for other needed directories. - (dirs-lib - (lambda (packages) - (map (lambda (package) - (string-append package "/lib")) - packages))) - (fhs-lib-dirs - (dirs-lib packages))) - (call-with-output-file #$output - (lambda (port) - (for-each (lambda (directory) - (display directory port) - (newline port)) - fhs-lib-dirs))) - #$output)))) - -(define (nonguix-container->package container) - "Return a package with wrapper script to launch the supplied container object -in a sandboxed 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)) - (pkg (ngc-wrap-package container))) - (package - (name (ngc-name container)) - (version (or (ngc-version container) - (package-version pkg))) - (source #f) - (inputs `(("wrap-package" ,(ngc-wrap-package container)) - ,@(if (null? (ngc-union64 container)) - '() - `(("fhs-union-64" ,(ngc-union64 container)))) - ,@(if (null? (ngc-union32 container)) - '() - `(("fhs-union-32" ,(ngc-union32 container)))) - ("fhs-internal" ,fhs-internal) - ("fhs-wrapper" ,fhs-wrapper) - ("fhs-manifest" ,fhs-manifest))) - (build-system trivial-build-system) - (arguments - `(#:modules ((guix build utils)) - #:builder - (begin - (use-modules (guix build utils)) - (let* ((out (assoc-ref %outputs "out")) - (internal-target (string-append (assoc-ref %build-inputs "fhs-internal") - "/bin/" ,(ngc-internal-name container))) - (internal-dest (string-append out "/sbin/" ,(ngc-internal-name container))) - (manifest-target (assoc-ref %build-inputs "fhs-manifest")) - (manifest-dest (string-append out "/etc/" ,(ngc-manifest-name container))) - (wrapper-target (assoc-ref %build-inputs "fhs-wrapper")) - (wrapper-dest (string-append out "/bin/" ,(ngc-name container))) - (link-files ',(ngc-link-files container))) - (mkdir-p (string-append out "/sbin")) - (mkdir-p (string-append out "/etc")) - (mkdir-p (string-append out "/bin")) - (symlink internal-target internal-dest) - (symlink wrapper-target wrapper-dest) - (symlink manifest-target manifest-dest) - (for-each - (lambda (link) - (mkdir-p (dirname (string-append out "/" link))) - (symlink (string-append (assoc-ref %build-inputs "wrap-package") - "/" link) - (string-append out "/" link))) - link-files))))) - (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 the supplied container object -in a sandboxed FHS environment." - (program-file - (ngc-wrapper-name container) - #~(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* ((run #$(file-append fhs-internal "/bin/" (ngc-internal-name container))) - (manifest-file #$(file-append fhs-manifest)) - (xdg-runtime (getenv "XDG_RUNTIME_DIR")) - (home (getenv "HOME")) - (sandbox-home (or (getenv "GUIX_SANDBOX_HOME") - (string-append home "/" #$(ngc-sandbox-home container)))) - (preserved-env '("^DBUS_" - "^DISPLAY$" - "^DRI_PRIME$" - "^GDK_SCALE$" ; For UI scaling. - "^GUIX_LOCPATH$" ; For pressure-vessel locales. - ;; For startup of added non-Steam games as it - ;; seems they start in an early environment - ;; before our additional settings. (Likely - ;; this can be removed when rewritten to use - ;; --emulate-fhs from upstream.) Note that - ;; this is explicitly set below. We could - ;; preserve what is set before launching the - ;; container, but any such directories would - ;; need to be shared with the container as - ;; well; this is not needed currently. - "^LD_LIBRARY_PATH$" - "^MANGOHUD" ; For MangoHud configuration. - "^PRESSURE_VESSEL_" ; For pressure vessel options. - "_PROXY$" - "_proxy$" - ;; To allow workaround for upstream bug - ;; - ;; and tracked on our end as - ;; . - ;; TODO: Remove once upstream fixes this bug. - "^QT_X11_NO_MITSHM$" - "^SDL_" - "^STEAM_" - "^VDPAU_DRIVER_PATH$" ; For VDPAU drivers. - "^XAUTHORITY$" - ;; Matching all ^XDG_ vars causes issues - ;; discussed in 80decf05. - "^XDG_DATA_HOME$" - "^XDG_RUNTIME_DIR$" - ;; The following are useful for debugging. - "^CAPSULE_DEBUG$" - "^G_MESSAGES_DEBUG$" - "^LD_DEBUG$" - "^LIBGL_DEBUG$")) - (expose `("/dev/bus/usb" ; Needed for libusb. - "/dev/dri" - "/dev/input" ; Needed for controller input. - "/dev/uinput" ; Needed for Steam Input. - ,@(exists-> "/dev/nvidia0") ; needed for nvidia proprietary driver - ,@(exists-> "/dev/nvidiactl") - ,@(exists-> "/dev/nvidia-modeset") - ,@(exists-> "/etc/machine-id") - "/etc/localtime" ; Needed for correct time zone. - "/sys/class/drm" ; Needed for hw monitoring like MangoHud. - "/sys/class/hwmon" ; Needed for hw monitoring like MangoHud. - "/sys/class/hidraw" ; Needed for devices like the Valve Index. - "/sys/class/input" ; Needed for controller input. - ,@(exists-> "/sys/class/power_supply") ; Needed for power monitoring like MangoHud. - ,@(exists-> "/sys/class/powercap") ; Needed for power monitoring like MangoHud. - "/sys/dev" - "/sys/devices" - ,@(exists-> "/var/run/dbus") - #$@(ngc-exposed container))) - ;; /dev/hidraw is needed for SteamVR to access the HMD, although here we - ;; share all hidraw devices. Instead we could filter to only share specific - ;; device. See, for example, this script: - ;; https://arvchristos.github.io/post/matching-dev-hidraw-devices-with-physical-devices/ - (share `(,@(find-files "/dev" "hidraw") - "/dev/shm" - ;; "/tmp/.X11-unix" is needed for bwrap, and "/tmp" more generally - ;; for writing things like crash dumps and "steam_chrome_shm". - "/tmp" - ,(string-append sandbox-home "=" home) - ,@(exists-> (string-append home "/.config/pulse")) - ,@(exists-> (string-append xdg-runtime "/pulse")) - ,@(exists-> (string-append xdg-runtime "/bus")) - ,@(exists-> (getenv "XAUTHORITY")) - #$@(ngc-shared container))) - (DEBUG (equal? (getenv "DEBUG") "1")) - (args (cdr (command-line))) - (command (if DEBUG '() - `("--" ,run ,@args)))) - ;; Set this so that e.g. non-Steam games added to Steam will launch - ;; properly. It seems otherwise they don't make it to launching - ;; Steam's pressure-vessel container (for Proton games). - (setenv "LD_LIBRARY_PATH" "/lib64:/lib") - ;; Set this so Steam's pressure-vessel container does not need to - ;; generate locales, improving startup time. This needs to be set to - ;; the "usual" path, probably so they are included in the - ;; pressure-vessel container. - (setenv "GUIX_LOCPATH" "/usr/lib/locale") - ;; By default VDPAU drivers are searched for in libvdpau's store - ;; path, so set this path to where the drivers will actually be - ;; located in the container. - (setenv "VDPAU_DRIVER_PATH" "/lib64/vdpau") - (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) - (invoke #$(file-append pulseaudio "/bin/pulseaudio") - "--start" - "--exit-idle-time=60") - (apply invoke - `("guix" "shell" - "--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 to be used as package manifest for FHS -containers. This manifest will use the 'modules' and 'packages' fields -specified in the container object, and will also include the exact store paths -of the containers 'wrap-package', 'union32', and 'union64' fields, as well as -the exact path for the fhs-internal package." - (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 dummy package housing the fhs-internal script." - (package - (name (ngc-internal-name container)) - (version (or (ngc-version container) - (package-version (ngc-wrap-package 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 to set up sandbox") - (description "Script used inside the FHS Guix container to set up the -environment.") - (license #f))) - -(define (make-internal-script container) - "Return an fhs-internal script which is used to perform additional steps to -set up the environment inside an FHS container before launching the desired -application." - ;; The ld cache is not created inside the container, meaning the paths it - ;; contains are directly to /gnu/store/. Instead, it could be generated with - ;; a generic ld.so.conf and result in paths more typical in an FHS distro, - ;; like /lib within the container. This may be useful for future compatibility. - (let* ((ld.so.conf (ngc-ld.so.conf container)) - (ld.so.cache (ngc-ld.so.cache container)) - (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) - (ice-9 getopt-long)) - (define (path->str path) - (if (list? path) - (string-join path "/") - path)) - (define (new-symlink pair) - (let ((target (path->str (car pair))) - (dest (path->str (cdr pair)))) - (unless (file-exists? dest) - (symlink target dest)))) - (define (icd-symlink file) - (new-symlink - `(,file . ("/usr/share/vulkan/icd.d" ,(basename file))))) - (define fhs-option-spec - '((asound32 (value #f)))) - (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)) - (all-args (cdr (command-line))) - (fhs-args (member "--" all-args)) - (package-args (if fhs-args - (reverse (cdr (member "--" (reverse all-args)))) - all-args))) - (delete-file "/bin/sh") - (rmdir "/bin") - (for-each - mkdir-p - '("/run/current-system/profile/etc" - "/run/current-system/profile/share" - "/sbin" - "/usr/lib" - "/usr/share/vulkan/icd.d")) - (for-each - new-symlink - `((,ld.so.cache . "/etc/ld.so.cache") - (,ld.so.conf . "/etc/ld.so.conf") ;; needed? - ;; For MangoHud implicit layers. - ((,guix-env "share/vulkan/implicit_layer.d") . - "/usr/share/vulkan/implicit_layer.d") - ((,guix-env "etc/ssl") . "/etc/ssl") - ((,guix-env "etc/ssl") . "/run/current-system/profile/etc/ssl") - ((,union32 "lib") . "/lib") - ((,union32 "lib") . "/run/current-system/profile/lib") - ((,union64 "bin") . "/bin") - ((,union64 "bin") . "/usr/bin") ; Steam hardcodes some paths like xdg-open. - ((,union64 "lib") . "/lib64") - ((,union64 "lib") . "/run/current-system/profile/lib64") - ((,union64 "lib/locale") . "/run/current-system/locale") - ;; Despite using GUIX_LOCPATH, stil need locales in their - ;; expected location for pressure-vessel to use them. - ((,union64 "lib/locale") . "/usr/lib/locale") - ((,union64 "sbin/ldconfig") . "/sbin/ldconfig") - ((,union64 "share/mime") . "/usr/share/mime") ; Steam tray icon. - ((,union64 "share/drirc.d") . "/usr/share/drirc.d") - ((,union64 "share/fonts") . "/run/current-system/profile/share/fonts") - ((,union64 "etc/fonts") . "/etc/fonts") - ((,union64 "share/vulkan/explicit_layer.d") . - "/usr/share/vulkan/explicit_layer.d"))) - (for-each - icd-symlink - ;; Use stat to follow links from packages like MangoHud. - `(,@(find-files (string-append union32 "/share/vulkan/icd.d") - #:directories? #t #:stat stat) - ,@(find-files (string-append union64 "/share/vulkan/icd.d") - #:directories? #t #:stat stat))) - ;; TODO: This is not the right place for this. - ;; Newer versions of Steam won't startup if they can't copy to here - ;; (previous would output this error but continue). - (if (file-exists? ".steam/root/bootstrap.tar.xz") - (chmod ".steam/root/bootstrap.tar.xz" #o644)) - - ;; Process FHS-specific command line options. - (let* ((options (getopt-long (or fhs-args '("")) fhs-option-spec)) - (asound32-opt (option-ref options 'asound32 #f)) - (asound-lib (if asound32-opt "lib" "lib64"))) - (if asound32-opt - (display "\n\n/etc/asound.conf configured for 32-bit.\n\n\n") - (display (string-append "\n\n/etc/asound.conf configured for 64-bit.\nLaunch " - #$(ngc-name container) - " with \"" - (basename #$(ngc-run container)) - " -- --asound32\" to use 32-bit instead.\n\n\n"))) - (with-output-to-file "/etc/asound.conf" - (lambda _ (format (current-output-port) "# Generated by nonguix's internal script - -# Use PulseAudio by default -pcm_type.pulse { - lib \"/~a/alsa-lib/libasound_module_pcm_pulse.so\" -} - -ctl_type.pulse { - lib \"/~a/alsa-lib/libasound_module_ctl_pulse.so\" -} - -pcm.!default { - type pulse - fallback \"sysdefault\" - hint { - show on - description \"Default ALSA Output (currently PulseAudio Sound Server)\" - } -} - -ctl.!default { - type pulse - fallback \"sysdefault\" -}\n\n" asound-lib asound-lib)))) - - (apply system* `(#$(file-append pkg run) ,@package-args)))))))) diff --git a/nonguix/utils.scm b/nonguix/utils.scm deleted file mode 100644 index 6703f4a..0000000 --- a/nonguix/utils.scm +++ /dev/null @@ -1,24 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;;; Copyright © 2019 Pierre Neidhardt -;;; Copyright © 2020 Jonathan Brielmaier - -(define-module (nonguix utils) - #:use-module (srfi srfi-26) - #:use-module (ice-9 match) - #:use-module (ice-9 textual-ports) - #:use-module (ice-9 popen) - #:use-module (guix utils) - #:use-module (guix packages)) - -(define-public (to32 package64) - "Build package for i686-linux. -Only x86_64-linux and i686-linux are supported. -- If i686-linux, return the package unchanged. -- If x86_64-linux, return the 32-bit version of the package." - (match (%current-system) - ("x86_64-linux" - (package - (inherit package64) - (arguments `(#:system "i686-linux" - ,@(package-arguments package64))))) - (_ package64)))