summaryrefslogtreecommitdiff
path: root/nonguix/build/binary-build-system.scm
diff options
context:
space:
mode:
Diffstat (limited to 'nonguix/build/binary-build-system.scm')
-rw-r--r--nonguix/build/binary-build-system.scm77
1 files changed, 52 insertions, 25 deletions
diff --git a/nonguix/build/binary-build-system.scm b/nonguix/build/binary-build-system.scm
index 6a676ae..e5bbc48 100644
--- a/nonguix/build/binary-build-system.scm
+++ b/nonguix/build/binary-build-system.scm
@@ -1,20 +1,7 @@
-;;; GNU Guix --- Functional package management for GNU
+;;; SPDX-License-Identifier: GPL-3.0-or-later
;;; 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/>.
+;;; Copyright © 2022 Attila Lendvai <attila@lendvai.name>
+;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
(define-module (nonguix build binary-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
@@ -97,6 +84,19 @@ The PATCHELF-PLAN elements are lists of:
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.
@@ -104,13 +104,11 @@ The inputs are optional when the file is an executable."
(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)))))
+ (match-lambda
+ ((name extra-path)
+ (make-rpath name extra-path))
+ (name
+ (make-rpath name)))
runpath)
":")))
(invoke "patchelf" "--set-rpath" rpath binary)))
@@ -136,10 +134,39 @@ The inputs are optional when the file is an executable."
patchelf-plan)))
#t)
+(define (deb-file? binary-file)
+ (string-suffix? ".deb" binary-file))
+
+(define (unpack-deb deb-file)
+ (invoke "ar" "x" deb-file)
+ (invoke "tar" "xvf" "data.tar.xz")
+ (invoke "rm" "-rfv" "control.tar.gz"
+ "data.tar.xz"
+ deb-file
+ "debian-binary"))
+
+(define* (binary-unpack #:key source #:allow-other-keys)
+ (let* ((files (filter (lambda (f)
+ (not (string=? (basename f) "environment-variables")))
+ (find-files (getcwd))))
+ (binary-file (car files)))
+ (when (= 1 (length files))
+ (mkdir "binary")
+ (chdir "binary")
+ (match binary-file
+ ((? deb-file?) (unpack-deb binary-file))
+ (_
+ (begin
+ (format #t "Unknown file type: ~a~%" (basename binary-file))
+ ;; Cleanup after ourselves
+ (chdir "..")
+ (rmdir "binary")))))))
+
(define %standard-phases
- ;; Everything is as with the GNU Build System except for the `configure'
- ;; , `build', `check' and `install' phases.
+ ;; Everything is as with the GNU Build System except for the `binary-unpack',
+ ;; `configure', `build', `check' and `install' phases.
(modify-phases gnu:%standard-phases
+ (add-after 'unpack 'binary-unpack binary-unpack)
(delete 'bootstrap)
(delete 'configure)
(delete 'build)