blob: fd92a1233d1e821b73aed9d86ce10cae4413d357 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
;;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
(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))))
|
