summaryrefslogtreecommitdiff
path: root/guix/nonguix
diff options
context:
space:
mode:
Diffstat (limited to 'guix/nonguix')
-rw-r--r--guix/nonguix/build-system/binary.scm162
-rw-r--r--guix/nonguix/build/binary-build-system.scm155
-rw-r--r--guix/nonguix/build/utils.scm111
-rw-r--r--guix/nonguix/download.scm62
-rw-r--r--guix/nonguix/licenses.scm41
-rw-r--r--guix/nonguix/modules.scm35
-rw-r--r--guix/nonguix/utils.scm38
7 files changed, 604 insertions, 0 deletions
diff --git a/guix/nonguix/build-system/binary.scm b/guix/nonguix/build-system/binary.scm
new file mode 100644
index 0000000..038bd89
--- /dev/null
+++ b/guix/nonguix/build-system/binary.scm
@@ -0,0 +1,162 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is not part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (nonguix build-system binary)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #: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
+ '(#:source #: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 store name inputs
+ #:key (guile #f)
+ (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))))
+ "Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE
+provides its own binaries."
+ (define builder
+ `(begin
+ (use-modules ,@modules)
+ (binary-build #:source ,(match (assoc-ref inputs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (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)))
+
+ (define guile-for-build
+ (match guile
+ ((? package?)
+ (package-derivation store guile system #:graft? #f))
+ (#f ; the default
+ (let* ((distro (resolve-interface '(gnu packages commencement)))
+ (guile (module-ref distro 'guile-final)))
+ (package-derivation store guile system #:graft? #f)))))
+
+ (build-expression->derivation store name builder
+ #:system system
+ #:inputs inputs
+ #:modules imported-modules
+ #:outputs outputs
+ #:guile-for-build guile-for-build))
+
+(define binary-build-system
+ (build-system
+ (name 'binary)
+ (description "The standard binary build system")
+ (lower lower)))
+
+;;; binary.scm ends here
diff --git a/guix/nonguix/build/binary-build-system.scm b/guix/nonguix/build/binary-build-system.scm
new file mode 100644
index 0000000..6a676ae
--- /dev/null
+++ b/guix/nonguix/build/binary-build-system.scm
@@ -0,0 +1,155 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is not part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(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)
+ (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
+ (lambda (input-or-output)
+ (cond
+ ((assoc-ref outputs input-or-output)
+ (string-append (assoc-ref outputs input-or-output) "/lib"))
+ ((assoc-ref inputs input-or-output)
+ (string-append (assoc-ref inputs input-or-output) "/lib"))
+ (else (error (format #f "`~a' not found among the inputs nor the outputs." input-or-output)))))
+ 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/guix/nonguix/build/utils.scm b/guix/nonguix/build/utils.scm
new file mode 100644
index 0000000..ab437f2
--- /dev/null
+++ b/guix/nonguix/build/utils.scm
@@ -0,0 +1,111 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
+;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
+;;;
+;;; This file is not part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(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-26)
+ #:export (64-bit?
+ make-wrapper
+ concatenate-files))
+
+(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))))
diff --git a/guix/nonguix/download.scm b/guix/nonguix/download.scm
new file mode 100644
index 0000000..11087ff
--- /dev/null
+++ b/guix/nonguix/download.scm
@@ -0,0 +1,62 @@
+;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(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/guix/nonguix/licenses.scm b/guix/nonguix/licenses.scm
new file mode 100644
index 0000000..84d2346
--- /dev/null
+++ b/guix/nonguix/licenses.scm
@@ -0,0 +1,41 @@
+;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(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/guix/nonguix/modules.scm b/guix/nonguix/modules.scm
new file mode 100644
index 0000000..24d4267
--- /dev/null
+++ b/guix/nonguix/modules.scm
@@ -0,0 +1,35 @@
+;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(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/guix/nonguix/utils.scm b/guix/nonguix/utils.scm
new file mode 100644
index 0000000..7611a47
--- /dev/null
+++ b/guix/nonguix/utils.scm
@@ -0,0 +1,38 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
+;;;
+;;; This file is not part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(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)))