.
This commit is contained in:
parent
6a2fb1a65b
commit
1eb21f9591
GPG Key ID:
B38976E82C9DAE42
@ -4,4 +4,8 @@
|
|||||||
(channel
|
(channel
|
||||||
(version 0)
|
(version 0)
|
||||||
(news-file "news.txt")
|
(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"))))
|
||||||
|
|||||||
@ -1,145 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
|
|
||||||
;;; Copyright © 2021 Josselin Poiret <dev@jpoiret.xyz>
|
|
||||||
|
|
||||||
(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
|
|
||||||
@ -1,209 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
|
|
||||||
|
|
||||||
(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
|
|
||||||
@ -1,152 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
|
|
||||||
;;; Copyright © 2022 Attila Lendvai <attila@lendvai.name>
|
|
||||||
|
|
||||||
(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
|
|
||||||
@ -1,75 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
|
|
||||||
|
|
||||||
(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
|
|
||||||
@ -1,119 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
|
|
||||||
;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
|
|
||||||
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
|
|
||||||
|
|
||||||
(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))))
|
|
||||||
@ -1,50 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
@ -1,29 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
@ -1,23 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
|
|
||||||
|
|
||||||
(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)))))
|
|
||||||
@ -1,561 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2020 pkill-9
|
|
||||||
;;; Copyright © 2020, 2021 ison <ison@airmail.cc>
|
|
||||||
;;; Copyright © 2021 pineapples
|
|
||||||
;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me>
|
|
||||||
;;; Copyright © 2021 Kozo <kozodev@runbox.com>
|
|
||||||
;;; Copyright © 2021, 2022 John Kehayias <john.kehayias@protonmail.com>
|
|
||||||
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
|
|
||||||
;;; Copyright © 2023 Attila Lendvai <attila@lendvai.name>
|
|
||||||
;;; 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>
|
|
||||||
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
|
|
||||||
;; <https://github.com/ValveSoftware/steam-for-linux/issues/9306>
|
|
||||||
;; and tracked on our end as
|
|
||||||
;; <https://gitlab.com/nonguix/nonguix/-/issues/267>.
|
|
||||||
;; 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))))))))
|
|
||||||
@ -1,24 +0,0 @@
|
|||||||
;;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
||||||
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
|
|
||||||
;;; Copyright © 2020 Jonathan Brielmaier <jonathan.brielmaier@web.de>
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
Loading…
Reference in New Issue
Block a user