Use mmap for the elf parser, reducing memory usage.

The `file->bytevector' new procedure uses a memory mapped bytevector, so parsing the ELF file reads only the sections needed, not the whole file. * guix/scripts/pack.scm (wrapped-package): Use file->bytevector. * guix/build/gremlin.scm (file-dynamic-info): Likewise. (validate-needed-in-runpath): Likewise. (strip-runpath): Likewise, and write to bytevector directly, avoiding a port. (set-file-runpath): Likewise. * tests/gremlin.scm (read-elf): Delete procedure. ("elf-dynamic-info-needed, executable"): Use file-dynamic-info. ("strip-runpath"): Likewise. ("elf-dynamic-info-soname"): Likewise. guix/build/debug-link.scm (set-debuglink-crc): Use file->bytevector. * tests/debug-link.scm (read-elf): Delete procedure. ("elf-debuglink"): Rename to... ("elf-debuglink, no .gnu_debuglink section"): ... this. ("elf-debuglink", "set-debuglink-crc"): Use external store, and adjust to use file->bytevector. * gnu/packages/gnuzilla.scm (icecat-minimal) [#:phases] {build-sandbox-whitelist}: Use `file-runpath'. * gnu/packages/librewolf.scm (librewolf): Likewise. Fixes: <https://issues.guix.gnu.org/59365> Fixes: #1262 Change-Id: I43b77ed0cdc38994ea89d3d401e0d136aa6b187a
author: Maxim Cournoyer <maxim@guixotic.coop> 2025-10-24 16:06:12 +0900
committer: Maxim Cournoyer <maxim@guixotic.coop> 2025-10-30 16:13:03 +0900
commit: 2c1fe0df11ae0f66392b8abb6f62430d79305538 (patch)
tree: 44117a2d06d583f7378ddec5d475baeceddc7564 /tests/debug-link.scm
parent: e1994a021437b3fd73089c08d7e8db876fad698d (diff)
1 files changed, 97 insertions, 90 deletions
diff --git a/tests/debug-link.scm b/tests/debug-link.scm
index a1ae4f141c0..7ccc054a5d9 100644
--- a/tests/debug-link.scm
+++ b/tests/debug-link.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,12 +21,15 @@
  #:use-module (guix elf)
  #:use-module (guix build utils)
  #:use-module (guix build debug-link)
+  #:use-module (guix build io)
  #:use-module (guix gexp)
+  #:use-module (guix modules)
  #:use-module (guix store)
  #:use-module (guix tests)
  #:use-module (guix monads)
  #:use-module (guix derivations)
  #:use-module (gnu packages bootstrap)
+  #:use-module ((gnu packages guile) #:select (guile-3.0))
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
@@ -40,15 +44,12 @@
    (_
     #f)))
-(define read-elf
-  (compose parse-elf get-bytevector-all))
 (test-begin "debug-link")
 (unless %guile-executable (test-skip 1))
-(test-assert "elf-debuglink"
+(test-assert "elf-debuglink, no .gnu_debuglink section"
-  (let ((elf (call-with-input-file %guile-executable read-elf)))
+  (let ((elf (parse-elf (file->bytevector %guile-executable))))
    (match (call-with-values (lambda () (elf-debuglink elf)) list)
      ((#f #f)                                    ;no '.gnu_debuglink' section
       (pk 'no-debuglink #t))
@@ -56,95 +57,101 @@
       (string-suffix? ".debug" file)))))
 ;; Since we need %BOOTSTRAP-GCC and co., we have to skip the following tests
-;; when networking is unreachable because we'd fail to download it.
+;; when networking is unreachable because we'd fail to download it.  Since
-(unless (network-reachable?) (test-skip 1))
+;; using mmap to load ELF more efficiently, we also need the regular Guile
-(test-assertm "elf-debuglink"
+;; package, as guile-bootstrap cannot resolve dynamic symbols.
-  ;; Check whether we can compute the CRC just like objcopy, and whether we
+(with-external-store store
-  ;; can retrieve it.
+  (unless (and (network-reachable?) store) (test-skip 1))
-  (let* ((code (plain-file "test.c" "int main () { return 42; }"))
+  (test-assertm "elf-debuglink"
-         (exp  (with-imported-modules '((guix build utils)
+      ;; Check whether we can compute the CRC just like objcopy, and whether we
-                                        (guix build debug-link)
+      ;; can retrieve it.
-                                        (guix elf))
+      (let* ((code (plain-file "test.c" "int main () { return 42; }"))
-                 #~(begin
+             (exp  (with-imported-modules (source-module-closure
-                     (use-modules (guix build utils)
+                                           '((guix build io)
-                                  (guix build debug-link)
+                                             (guix build utils)
-                                  (guix elf)
+                                             (guix build debug-link)
-                                  (rnrs io ports))
+                                             (guix elf)))
+                     #~(begin
+                         (use-modules (guix build io)
+                                      (guix build utils)
+                                      (guix build debug-link)
+                                      (guix elf)
+                                      (rnrs io ports))
-                     (define read-elf
+                         (define read-elf
-                       (compose parse-elf get-bytevector-all))
+                           (compose parse-elf file->bytevector))
-                     (setenv "PATH" (string-join '(#$%bootstrap-gcc
+                         (setenv "PATH" (string-join '(#$%bootstrap-gcc
-                                                   #$%bootstrap-binutils)
+                                                       #$%bootstrap-binutils)
-                                                 "/bin:" 'suffix))
+                                                     "/bin:" 'suffix))
-                     (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
+                         (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
-                     (copy-file "exe" "exe.debug")
+                         (copy-file "exe" "exe.debug")
-                     (invoke "strip" "--only-keep-debug" "exe.debug")
+                         (invoke "strip" "--only-keep-debug" "exe.debug")
-                     (invoke "strip" "--strip-debug" "exe")
+                         (invoke "strip" "--strip-debug" "exe")
-                     (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
+                         (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
-                             "exe")
+                                 "exe")
-                     (call-with-values (lambda ()
+                         (call-with-values (lambda ()
-                                         (elf-debuglink
+                                             (elf-debuglink (read-elf "exe")))
-                                          (call-with-input-file "exe"
+                           (lambda (file crc)
-                                            read-elf)))
+                             (call-with-output-file #$output
-                       (lambda (file crc)
+                               (lambda (port)
-                         (call-with-output-file #$output
+                                 (let ((expected (call-with-input-file "exe.debug"
-                           (lambda (port)
+                                                   debuglink-crc32)))
-                             (let ((expected (call-with-input-file "exe.debug"
+                                   (write (list file (= crc expected))
-                                               debuglink-crc32)))
+                                          port))))))))))
-                               (write (list file (= crc expected))
+        (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
-                                      port))))))))))
+                             (x   (built-derivations (list drv))))
-    (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
+          (call-with-input-file (derivation->output-path drv)
-                         (x   (built-derivations (list drv))))
+            (lambda (port)
-      (call-with-input-file (derivation->output-path drv)
+              (return (match (read port)
-        (lambda (port)
+                        (("exe.debug" #t) #t)
-          (return (match (read port)
+                        (x                (pk 'fail x #f)))))))))
-                    (("exe.debug" #t) #t)
-                    (x                (pk 'fail x #f)))))))))
-(unless (network-reachable?) (test-skip 1))
+  (unless (and (network-reachable?) store) (test-skip 1))
-(test-assertm "set-debuglink-crc"
+  (test-assertm "set-debuglink-crc"
-  ;; Check whether 'set-debuglink-crc' successfully updates the CRC.
+      ;; Check whether 'set-debuglink-crc' successfully updates the CRC.
-  (let* ((code  (plain-file "test.c" "int main () { return 42; }"))
+      (let* ((code  (plain-file "test.c" "int main () { return 42; }"))
-         (debug (plain-file "exe.debug" "a"))
+             (debug (plain-file "exe.debug" "a"))
-         (exp   (with-imported-modules '((guix build utils)
+             (exp   (with-imported-modules (source-module-closure
-                                         (guix build debug-link)
+                                            '((guix build io)
-                                         (guix elf))
+                                              (guix build utils)
-                  #~(begin
+                                              (guix build debug-link)
-                      (use-modules (guix build utils)
+                                              (guix elf)))
-                                   (guix build debug-link)
+                      #~(begin
-                                   (guix elf)
+                          (use-modules (guix build io)
-                                   (rnrs io ports))
+                                       (guix build utils)
+                                       (guix build debug-link)
+                                       (guix elf)
+                                       (rnrs io ports))
-                      (define read-elf
+                          (define read-elf
-                        (compose parse-elf get-bytevector-all))
+                            (compose parse-elf file->bytevector))
-                      (setenv "PATH" (string-join '(#$%bootstrap-gcc
+                          (setenv "PATH" (string-join '(#$%bootstrap-gcc
-                                                    #$%bootstrap-binutils)
+                                                        #$%bootstrap-binutils)
-                                                  "/bin:" 'suffix))
+                                                      "/bin:" 'suffix))
-                      (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
+                          (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
-                      (copy-file "exe" "exe.debug")
+                          (copy-file "exe" "exe.debug")
-                      (invoke "strip" "--only-keep-debug" "exe.debug")
+                          (invoke "strip" "--only-keep-debug" "exe.debug")
-                      (invoke "strip" "--strip-debug" "exe")
+                          (invoke "strip" "--strip-debug" "exe")
-                      (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
+                          (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
-                              "exe")
+                                  "exe")
-                      (set-debuglink-crc "exe" #$debug)
+                          (set-debuglink-crc "exe" #$debug)
-                      (call-with-values (lambda ()
+                          (call-with-values (lambda ()
-                                          (elf-debuglink
+                                              (elf-debuglink
-                                           (call-with-input-file "exe"
+                                               (read-elf "exe")))
-                                             read-elf)))
+                            (lambda (file crc)
-                        (lambda (file crc)
+                              (call-with-output-file #$output
-                          (call-with-output-file #$output
+                                (lambda (port)
-                            (lambda (port)
+                                  (write (list file crc) port)))))))))
-                              (write (list file crc) port)))))))))
+        (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
-    (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
+                             (x   (built-derivations (list drv))))
-                         (x   (built-derivations (list drv))))
+          (call-with-input-file (derivation->output-path drv)
-      (call-with-input-file (derivation->output-path drv)
+            (lambda (port)
-        (lambda (port)
+              (return (match (read port)
-          (return (match (read port)
+                        (("exe.debug" crc)
-                    (("exe.debug" crc)
+                         (= crc (debuglink-crc32 (open-input-string "a"))))
-                     (= crc (debuglink-crc32 (open-input-string "a"))))
+                        (x
-                    (x
+                         (pk 'fail x #f))))))))))
-                     (pk 'fail x #f)))))))))
 (test-end "debug-link")
author	Maxim Cournoyer <maxim@guixotic.coop>	2025-10-24 16:06:12 +0900
committer	Maxim Cournoyer <maxim@guixotic.coop>	2025-10-30 16:13:03 +0900
commit	2c1fe0df11ae0f66392b8abb6f62430d79305538 (patch)
tree	44117a2d06d583f7378ddec5d475baeceddc7564 /tests/debug-link.scm
parent	e1994a021437b3fd73089c08d7e8db876fad698d (diff)

diff --git a/tests/debug-link.scm b/tests/debug-link.scm index a1ae4f141c0..7ccc054a5d9 100644 --- a/tests/debug-link.scm +++ b/tests/debug-link.scm
@@ -1,5 +1,6 @@
1	;;; GNU Guix --- Functional package management for GNU	1	;;; GNU Guix --- Functional package management for GNU
2	;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>	2	;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
		3	;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
3	;;;	4	;;;
4	;;; This file is part of GNU Guix.	5	;;; This file is part of GNU Guix.
5	;;;	6	;;;
@@ -20,12 +21,15 @@
20	#:use-module (guix elf)	21	#:use-module (guix elf)
21	#:use-module (guix build utils)	22	#:use-module (guix build utils)
22	#:use-module (guix build debug-link)	23	#:use-module (guix build debug-link)
		24	#:use-module (guix build io)
23	#:use-module (guix gexp)	25	#:use-module (guix gexp)
		26	#:use-module (guix modules)
24	#:use-module (guix store)	27	#:use-module (guix store)
25	#:use-module (guix tests)	28	#:use-module (guix tests)
26	#:use-module (guix monads)	29	#:use-module (guix monads)
27	#:use-module (guix derivations)	30	#:use-module (guix derivations)
28	#:use-module (gnu packages bootstrap)	31	#:use-module (gnu packages bootstrap)
		32	#:use-module ((gnu packages guile) #:select (guile-3.0))
29	#:use-module (srfi srfi-1)	33	#:use-module (srfi srfi-1)
30	#:use-module (srfi srfi-26)	34	#:use-module (srfi srfi-26)
31	#:use-module (srfi srfi-64)	35	#:use-module (srfi srfi-64)
@@ -40,15 +44,12 @@
40	(_	44	(_
41	#f)))	45	#f)))
42		46
43	(define read-elf
44	(compose parse-elf get-bytevector-all))
45
46		47
47	(test-begin "debug-link")	48	(test-begin "debug-link")
48		49
49	(unless %guile-executable (test-skip 1))	50	(unless %guile-executable (test-skip 1))
50	(test-assert "elf-debuglink"	51	(test-assert "elf-debuglink, no .gnu_debuglink section"
51	(let ((elf (call-with-input-file %guile-executable read-elf)))	52	(let ((elf (parse-elf (file->bytevector %guile-executable))))
52	(match (call-with-values (lambda () (elf-debuglink elf)) list)	53	(match (call-with-values (lambda () (elf-debuglink elf)) list)
53	((#f #f) ;no '.gnu_debuglink' section	54	((#f #f) ;no '.gnu_debuglink' section
54	(pk 'no-debuglink #t))	55	(pk 'no-debuglink #t))
@@ -56,95 +57,101 @@
56	(string-suffix? ".debug" file)))))	57	(string-suffix? ".debug" file)))))
57		58
58	;; Since we need %BOOTSTRAP-GCC and co., we have to skip the following tests	59	;; Since we need %BOOTSTRAP-GCC and co., we have to skip the following tests
59	;; when networking is unreachable because we'd fail to download it.	60	;; when networking is unreachable because we'd fail to download it. Since
60	(unless (network-reachable?) (test-skip 1))	61	;; using mmap to load ELF more efficiently, we also need the regular Guile
61	(test-assertm "elf-debuglink"	62	;; package, as guile-bootstrap cannot resolve dynamic symbols.
62	;; Check whether we can compute the CRC just like objcopy, and whether we	63	(with-external-store store
63	;; can retrieve it.	64	(unless (and (network-reachable?) store) (test-skip 1))
64	(let* ((code (plain-file "test.c" "int main () { return 42; }"))	65	(test-assertm "elf-debuglink"
65	(exp (with-imported-modules '((guix build utils)	66	;; Check whether we can compute the CRC just like objcopy, and whether we
66	(guix build debug-link)	67	;; can retrieve it.
67	(guix elf))	68	(let* ((code (plain-file "test.c" "int main () { return 42; }"))
68	#~(begin	69	(exp (with-imported-modules (source-module-closure
69	(use-modules (guix build utils)	70	'((guix build io)
70	(guix build debug-link)	71	(guix build utils)
71	(guix elf)	72	(guix build debug-link)
72	(rnrs io ports))	73	(guix elf)))
		74	#~(begin
		75	(use-modules (guix build io)
		76	(guix build utils)
		77	(guix build debug-link)
		78	(guix elf)
		79	(rnrs io ports))
73		80
74	(define read-elf	81	(define read-elf
75	(compose parse-elf get-bytevector-all))	82	(compose parse-elf file->bytevector))
76		83
77	(setenv "PATH" (string-join '(#$%bootstrap-gcc	84	(setenv "PATH" (string-join '(#$%bootstrap-gcc
78	#$%bootstrap-binutils)	85	#$%bootstrap-binutils)
79	"/bin:" 'suffix))	86	"/bin:" 'suffix))
80	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")	87	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")
81	(copy-file "exe" "exe.debug")	88	(copy-file "exe" "exe.debug")
82	(invoke "strip" "--only-keep-debug" "exe.debug")	89	(invoke "strip" "--only-keep-debug" "exe.debug")
83	(invoke "strip" "--strip-debug" "exe")	90	(invoke "strip" "--strip-debug" "exe")
84	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"	91	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"
85	"exe")	92	"exe")
86	(call-with-values (lambda ()	93	(call-with-values (lambda ()
87	(elf-debuglink	94	(elf-debuglink (read-elf "exe")))
88	(call-with-input-file "exe"	95	(lambda (file crc)
89	read-elf)))	96	(call-with-output-file #$output
90	(lambda (file crc)	97	(lambda (port)
91	(call-with-output-file #$output	98	(let ((expected (call-with-input-file "exe.debug"
92	(lambda (port)	99	debuglink-crc32)))
93	(let ((expected (call-with-input-file "exe.debug"	100	(write (list file (= crc expected))
94	debuglink-crc32)))	101	port))))))))))
95	(write (list file (= crc expected))	102	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
96	port))))))))))	103	(x (built-derivations (list drv))))
97	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))	104	(call-with-input-file (derivation->output-path drv)
98	(x (built-derivations (list drv))))	105	(lambda (port)
99	(call-with-input-file (derivation->output-path drv)	106	(return (match (read port)
100	(lambda (port)	107	(("exe.debug" #t) #t)
101	(return (match (read port)	108	(x (pk 'fail x #f)))))))))
102	(("exe.debug" #t) #t)
103	(x (pk 'fail x #f)))))))))
104		109
105	(unless (network-reachable?) (test-skip 1))	110	(unless (and (network-reachable?) store) (test-skip 1))
106	(test-assertm "set-debuglink-crc"	111	(test-assertm "set-debuglink-crc"
107	;; Check whether 'set-debuglink-crc' successfully updates the CRC.	112	;; Check whether 'set-debuglink-crc' successfully updates the CRC.
108	(let* ((code (plain-file "test.c" "int main () { return 42; }"))	113	(let* ((code (plain-file "test.c" "int main () { return 42; }"))
109	(debug (plain-file "exe.debug" "a"))	114	(debug (plain-file "exe.debug" "a"))
110	(exp (with-imported-modules '((guix build utils)	115	(exp (with-imported-modules (source-module-closure
111	(guix build debug-link)	116	'((guix build io)
112	(guix elf))	117	(guix build utils)
113	#~(begin	118	(guix build debug-link)
114	(use-modules (guix build utils)	119	(guix elf)))
115	(guix build debug-link)	120	#~(begin
116	(guix elf)	121	(use-modules (guix build io)
117	(rnrs io ports))	122	(guix build utils)
		123	(guix build debug-link)
		124	(guix elf)
		125	(rnrs io ports))
118		126
119	(define read-elf	127	(define read-elf
120	(compose parse-elf get-bytevector-all))	128	(compose parse-elf file->bytevector))
121		129
122	(setenv "PATH" (string-join '(#$%bootstrap-gcc	130	(setenv "PATH" (string-join '(#$%bootstrap-gcc
123	#$%bootstrap-binutils)	131	#$%bootstrap-binutils)
124	"/bin:" 'suffix))	132	"/bin:" 'suffix))
125	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")	133	(invoke "gcc" "-O0" "-g" #$code "-o" "exe")
126	(copy-file "exe" "exe.debug")	134	(copy-file "exe" "exe.debug")
127	(invoke "strip" "--only-keep-debug" "exe.debug")	135	(invoke "strip" "--only-keep-debug" "exe.debug")
128	(invoke "strip" "--strip-debug" "exe")	136	(invoke "strip" "--strip-debug" "exe")
129	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"	137	(invoke "objcopy" "--add-gnu-debuglink=exe.debug"
130	"exe")	138	"exe")
131	(set-debuglink-crc "exe" #$debug)	139	(set-debuglink-crc "exe" #$debug)
132	(call-with-values (lambda ()	140	(call-with-values (lambda ()
133	(elf-debuglink	141	(elf-debuglink
134	(call-with-input-file "exe"	142	(read-elf "exe")))
135	read-elf)))	143	(lambda (file crc)
136	(lambda (file crc)	144	(call-with-output-file #$output
137	(call-with-output-file #$output	145	(lambda (port)
138	(lambda (port)	146	(write (list file crc) port)))))))))
139	(write (list file crc) port)))))))))	147	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
140	(mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))	148	(x (built-derivations (list drv))))
141	(x (built-derivations (list drv))))	149	(call-with-input-file (derivation->output-path drv)
142	(call-with-input-file (derivation->output-path drv)	150	(lambda (port)
143	(lambda (port)	151	(return (match (read port)
144	(return (match (read port)	152	(("exe.debug" crc)
145	(("exe.debug" crc)	153	(= crc (debuglink-crc32 (open-input-string "a"))))
146	(= crc (debuglink-crc32 (open-input-string "a"))))	154	(x
147	(x	155	(pk 'fail x #f))))))))))
148	(pk 'fail x #f)))))))))
149		156
150	(test-end "debug-link")	157	(test-end "debug-link")