guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 0f39db9c1942969bcbc603b306d8e47f8feb8566
Author: Maxim Cournoyer <[email protected]>
AuthorDate: Thu Oct 30 16:19:50 2025 +0900
Revert "Use mmap for the elf parser, reducing memory usage."
This reverts commit 2c1fe0df11ae0f66392b8abb6f62430d79305538.
---
gnu/packages/gnuzilla.scm | 8 +-
gnu/packages/librewolf.scm | 6 +-
guix/build/debug-link.scm | 17 +++--
guix/build/gremlin.scm | 62 ++++++++-------
guix/scripts/pack.scm | 13 ++--
tests/debug-link.scm | 187 ++++++++++++++++++++++-----------------------
tests/gremlin.scm | 18 +++--
7 files changed, 164 insertions(+), 147 deletions(-)
diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm
index d24797b85a..259f9a6fc6 100644
--- a/gnu/packages/gnuzilla.scm
+++ b/gnu/packages/gnuzilla.scm
@@ -996,10 +996,16 @@ preferences/advanced-scripts.dtd"
(search-input-file inputs "lib/libavcodec.so")))))
(add-after 'fix-ffmpeg-runtime-linker 'build-sandbox-whitelist
(lambda* (#:key inputs #:allow-other-keys)
+ (define (runpath-of lib)
+ (call-with-input-file lib
+ (compose elf-dynamic-info-runpath
+ elf-dynamic-info
+ parse-elf
+ get-bytevector-all)))
(define (runpaths-of-input label)
(let* ((dir (string-append (assoc-ref inputs label) "/lib"))
(libs (find-files dir "\\.so$")))
- (append-map file-runpath libs)))
+ (append-map runpath-of libs)))
;; Populate the sandbox read-path whitelist as needed by ffmpeg.
(let* ((whitelist
(map (cut string-append <> "/")
diff --git a/gnu/packages/librewolf.scm b/gnu/packages/librewolf.scm
index 6c852d7f1c..f8800b1925 100644
--- a/gnu/packages/librewolf.scm
+++ b/gnu/packages/librewolf.scm
@@ -530,11 +530,15 @@
;; The following two functions are from Guix's icecat package in
;; (gnu packages gnuzilla). See commit
;; b7a0935420ee630a29b7e5ac73a32ba1eb24f00b.
+ (define (runpath-of lib)
+ (call-with-input-file lib
+ (compose elf-dynamic-info-runpath elf-dynamic-info
+ parse-elf get-bytevector-all)))
(define (runpaths-of-input label)
(let* ((dir (string-append (assoc-ref inputs label)
"/lib"))
(libs (find-files dir "\\.so$")))
- (append-map file-runpath libs)))
+ (append-map runpath-of libs)))
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib"))
(libs (map
diff --git a/guix/build/debug-link.scm b/guix/build/debug-link.scm
index 7a74e6001b..80941df2fc 100644
--- a/guix/build/debug-link.scm
+++ b/guix/build/debug-link.scm
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2023 Ludovic Courtès <[email protected]>
-;;; Copyright © 2025 Maxim Cournoyer <[email protected]>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,7 +18,6 @@
(define-module (guix build debug-link)
#:use-module (guix elf)
- #:use-module (guix build io)
#:use-module ((guix build utils)
#:select (find-files elf-file? make-file-writable))
#:use-module (rnrs bytevectors)
@@ -149,13 +147,16 @@ Return #f for both if ELF lacks a '.gnu_debuglink'
section."
(define (set-debuglink-crc file debug-file)
"Compute the CRC of DEBUG-FILE and set it as the '.gnu_debuglink' CRC in
FILE."
- (let* ((bv (file->bytevector file #:protection (logior PROT_READ
PROT_WRITE)))
- (elf (parse-elf bv))
+ (let* ((elf (parse-elf (call-with-input-file file get-bytevector-all)))
(offset (elf-debuglink-crc-offset elf)))
- (when offset
- (let ((crc (call-with-input-file debug-file debuglink-crc32)))
- (bytevector-u32-set! bv offset crc (elf-byte-order elf))
- (munmap bv)))))
+ (and offset
+ (let* ((crc (call-with-input-file debug-file debuglink-crc32))
+ (bv (make-bytevector 4)))
+ (bytevector-u32-set! bv 0 crc (elf-byte-order elf))
+ (let ((port (open file O_RDWR)))
+ (set-port-position! port offset)
+ (put-bytevector port bv)
+ (close-port port))))))
;;;
diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index 2392a74a35..2a74d51dd9 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2018, 2020 Ludovic Courtès <[email protected]>
-;;; Copyright © 2025 Maxim Cournoyer <[email protected]>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,7 +18,6 @@
(define-module (guix build gremlin)
#:use-module (guix elf)
- #:use-module (guix build io)
#:use-module ((guix build utils) #:select (store-file-name?))
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -250,7 +248,9 @@ string table if the type is a string."
(define (file-dynamic-info file)
"Return the <elf-dynamic-info> record of FILE, or #f if FILE lacks dynamic
info."
- (elf-dynamic-info (parse-elf (file->bytevector file))))
+ (call-with-input-file file
+ (lambda (port)
+ (elf-dynamic-info (parse-elf (get-bytevector-all port))))))
(define (file-runpath file)
"Return the DT_RUNPATH dynamic entry of FILE as a list of strings, or #f if
@@ -362,7 +362,8 @@ exceeds total size~%"
(elf-segment-type segment))
#f)))
- (let* ((elf (parse-elf (file->bytevector file)))
+ (let* ((elf (call-with-input-file file
+ (compose parse-elf get-bytevector-all)))
(expand (cute expand-origin <> (dirname file)))
(dyninfo (elf-dynamic-info elf)))
(when dyninfo
@@ -401,13 +402,12 @@ according to DT_NEEDED."
needed)))
runpath))
- (define bv (file->bytevector file #:protection
- (logior PROT_READ PROT_WRITE)))
+ (define port
+ (open-file file "r+b"))
- (dynamic-wind
- (const #t)
+ (catch #t
(lambda ()
- (let* ((elf (parse-elf bv))
+ (let* ((elf (parse-elf (get-bytevector-all port)))
(entries (dynamic-entries elf (dynamic-link-segment elf)))
(needed (filter-map (lambda (entry)
(and (= (dynamic-entry-type entry)
@@ -425,14 +425,15 @@ according to DT_NEEDED."
"~a: stripping RUNPATH to ~s (removed ~s)~%"
file new
(lset-difference string=? old new))
- ;; Write to bytevector directly.
- (let ((src (string->utf8 (string-append (string-join new ":")
- "\0"))))
- (bytevector-copy! src 0 bv (dynamic-entry-offset runpath)
- (bytevector-length src))))
+ (seek port (dynamic-entry-offset runpath) SEEK_SET)
+ (put-bytevector port (string->utf8 (string-join new ":")))
+ (put-u8 port 0))
+ (close-port port)
new))
- (lambda ()
- (munmap bv))))
+ (lambda (key . args)
+ (false-if-exception (close-port port))
+ (apply throw key args))))
+
(define-condition-type &missing-runpath-error &elf-error
missing-runpath-error?
@@ -446,18 +447,20 @@ according to DT_NEEDED."
"Set the value of the DT_RUNPATH dynamic entry of FILE, which must name an
ELF file, to PATH, a list of strings. Raise a &missing-runpath-error or
&runpath-too-long-error when appropriate."
- (define bv (file->bytevector file #:protection
- (logior PROT_READ PROT_WRITE)))
- (dynamic-wind
- (const #t)
- (lambda ()
- (let* ((elf (parse-elf bv))
+ (define (call-with-input+output-file file proc)
+ (let ((port (open-file file "r+b")))
+ (guard (c (#t (close-port port) (raise c)))
+ (proc port)
+ (close-port port))))
+
+ (call-with-input+output-file file
+ (lambda (port)
+ (let* ((elf (parse-elf (get-bytevector-all port)))
(entries (dynamic-entries elf (dynamic-link-segment elf)))
(runpath (find (lambda (entry)
(= DT_RUNPATH (dynamic-entry-type entry)))
entries))
- (path (string->utf8 (string-append (string-join path ":")
- "\0"))))
+ (path (string->utf8 (string-join path ":"))))
(unless runpath
(raise (condition (&missing-runpath-error (elf elf)
(file file)))))
@@ -470,7 +473,10 @@ ELF file, to PATH, a list of strings. Raise a
&missing-runpath-error or
(raise (condition (&runpath-too-long-error (elf #f #;elf)
(file file)))))
- (bytevector-copy! path 0 bv (dynamic-entry-offset runpath)
- (bytevector-length path))))
- (lambda ()
- (munmap bv))))
+ (seek port (dynamic-entry-offset runpath) SEEK_SET)
+ (put-bytevector port path)
+ (put-u8 port 0)))))
+
+;;; Local Variables:
+;;; eval: (put 'call-with-input+output-file 'scheme-indent-function 1)
+;;; End:
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 432e846bf4..a6a7babf59 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2018 Chris Marusich <[email protected]>
;;; Copyright © 2018 Efraim Flashner <[email protected]>
;;; Copyright © 2020 Tobias Geerinckx-Rice <[email protected]>
-;;; Copyright © 2020-2023, 2025 Maxim Cournoyer <[email protected]>
+;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <[email protected]>
;;; Copyright © 2020 Eric Bavier <[email protected]>
;;; Copyright © 2022 Alex Griffin <[email protected]>
;;; Copyright © 2023 Graham James Addis <[email protected]>
@@ -1221,14 +1221,12 @@ libfakechroot.so and related ld.so machinery as a
fallback."
(define build
(with-imported-modules (source-module-closure
- '((guix build io)
- (guix build utils)
+ '((guix build utils)
(guix build union)
(guix build gremlin)
(guix elf)))
#~(begin
- (use-modules (guix build io)
- (guix build utils)
+ (use-modules (guix build utils)
((guix build union) #:select (symlink-relative))
(guix elf)
(guix build gremlin)
@@ -1262,7 +1260,7 @@ libfakechroot.so and related ld.so machinery as a
fallback."
(match (find (lambda (segment)
(= (elf-segment-type segment) PT_INTERP))
(elf-segments elf))
- (#f #f) ;maybe a .so
+ (#f #f) ;maybe a .so
(segment
(let ((bv (make-bytevector (- (elf-segment-memsz segment) 1))))
(bytevector-copy! (elf-bytes elf)
@@ -1282,7 +1280,8 @@ libfakechroot.so and related ld.so machinery as a
fallback."
#$(if fakechroot?
;; TODO: Handle scripts by wrapping their interpreter.
#~(if (elf-file? program)
- (let* ((bv (file->bytevector program))
+ (let* ((bv (call-with-input-file program
+ get-bytevector-all))
(elf (parse-elf bv))
(interp (elf-interpreter elf))
(gconv (and interp
diff --git a/tests/debug-link.scm b/tests/debug-link.scm
index 7ccc054a5d..a1ae4f141c 100644
--- a/tests/debug-link.scm
+++ b/tests/debug-link.scm
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <[email protected]>
-;;; Copyright © 2025 Maxim Cournoyer <[email protected]>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,15 +20,12 @@
#: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)
@@ -44,12 +40,15 @@
(_
#f)))
+(define read-elf
+ (compose parse-elf get-bytevector-all))
+
(test-begin "debug-link")
(unless %guile-executable (test-skip 1))
-(test-assert "elf-debuglink, no .gnu_debuglink section"
- (let ((elf (parse-elf (file->bytevector %guile-executable))))
+(test-assert "elf-debuglink"
+ (let ((elf (call-with-input-file %guile-executable read-elf)))
(match (call-with-values (lambda () (elf-debuglink elf)) list)
((#f #f) ;no '.gnu_debuglink' section
(pk 'no-debuglink #t))
@@ -57,101 +56,95 @@
(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. Since
-;; using mmap to load ELF more efficiently, we also need the regular Guile
-;; package, as guile-bootstrap cannot resolve dynamic symbols.
-(with-external-store store
- (unless (and (network-reachable?) store) (test-skip 1))
- (test-assertm "elf-debuglink"
- ;; Check whether we can compute the CRC just like objcopy, and whether we
- ;; can retrieve it.
- (let* ((code (plain-file "test.c" "int main () { return 42; }"))
- (exp (with-imported-modules (source-module-closure
- '((guix build io)
- (guix build utils)
- (guix build debug-link)
- (guix elf)))
- #~(begin
- (use-modules (guix build io)
- (guix build utils)
- (guix build debug-link)
- (guix elf)
- (rnrs io ports))
+;; when networking is unreachable because we'd fail to download it.
+(unless (network-reachable?) (test-skip 1))
+(test-assertm "elf-debuglink"
+ ;; Check whether we can compute the CRC just like objcopy, and whether we
+ ;; can retrieve it.
+ (let* ((code (plain-file "test.c" "int main () { return 42; }"))
+ (exp (with-imported-modules '((guix build utils)
+ (guix build debug-link)
+ (guix elf))
+ #~(begin
+ (use-modules (guix build utils)
+ (guix build debug-link)
+ (guix elf)
+ (rnrs io ports))
- (define read-elf
- (compose parse-elf file->bytevector))
+ (define read-elf
+ (compose parse-elf get-bytevector-all))
- (setenv "PATH" (string-join '(#$%bootstrap-gcc
- #$%bootstrap-binutils)
- "/bin:" 'suffix))
- (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
- (copy-file "exe" "exe.debug")
- (invoke "strip" "--only-keep-debug" "exe.debug")
- (invoke "strip" "--strip-debug" "exe")
- (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
- "exe")
- (call-with-values (lambda ()
- (elf-debuglink (read-elf "exe")))
- (lambda (file crc)
- (call-with-output-file #$output
- (lambda (port)
- (let ((expected (call-with-input-file
"exe.debug"
- debuglink-crc32)))
- (write (list file (= crc expected))
- port))))))))))
- (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
- (x (built-derivations (list drv))))
- (call-with-input-file (derivation->output-path drv)
- (lambda (port)
- (return (match (read port)
- (("exe.debug" #t) #t)
- (x (pk 'fail x #f)))))))))
+ (setenv "PATH" (string-join '(#$%bootstrap-gcc
+ #$%bootstrap-binutils)
+ "/bin:" 'suffix))
+ (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
+ (copy-file "exe" "exe.debug")
+ (invoke "strip" "--only-keep-debug" "exe.debug")
+ (invoke "strip" "--strip-debug" "exe")
+ (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
+ "exe")
+ (call-with-values (lambda ()
+ (elf-debuglink
+ (call-with-input-file "exe"
+ read-elf)))
+ (lambda (file crc)
+ (call-with-output-file #$output
+ (lambda (port)
+ (let ((expected (call-with-input-file "exe.debug"
+ debuglink-crc32)))
+ (write (list file (= crc expected))
+ port))))))))))
+ (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
+ (x (built-derivations (list drv))))
+ (call-with-input-file (derivation->output-path drv)
+ (lambda (port)
+ (return (match (read port)
+ (("exe.debug" #t) #t)
+ (x (pk 'fail x #f)))))))))
- (unless (and (network-reachable?) store) (test-skip 1))
- (test-assertm "set-debuglink-crc"
- ;; Check whether 'set-debuglink-crc' successfully updates the CRC.
- (let* ((code (plain-file "test.c" "int main () { return 42; }"))
- (debug (plain-file "exe.debug" "a"))
- (exp (with-imported-modules (source-module-closure
- '((guix build io)
- (guix build utils)
- (guix build debug-link)
- (guix elf)))
- #~(begin
- (use-modules (guix build io)
- (guix build utils)
- (guix build debug-link)
- (guix elf)
- (rnrs io ports))
+(unless (network-reachable?) (test-skip 1))
+(test-assertm "set-debuglink-crc"
+ ;; Check whether 'set-debuglink-crc' successfully updates the CRC.
+ (let* ((code (plain-file "test.c" "int main () { return 42; }"))
+ (debug (plain-file "exe.debug" "a"))
+ (exp (with-imported-modules '((guix build utils)
+ (guix build debug-link)
+ (guix elf))
+ #~(begin
+ (use-modules (guix build utils)
+ (guix build debug-link)
+ (guix elf)
+ (rnrs io ports))
- (define read-elf
- (compose parse-elf file->bytevector))
+ (define read-elf
+ (compose parse-elf get-bytevector-all))
- (setenv "PATH" (string-join '(#$%bootstrap-gcc
- #$%bootstrap-binutils)
- "/bin:" 'suffix))
- (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
- (copy-file "exe" "exe.debug")
- (invoke "strip" "--only-keep-debug" "exe.debug")
- (invoke "strip" "--strip-debug" "exe")
- (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
- "exe")
- (set-debuglink-crc "exe" #$debug)
- (call-with-values (lambda ()
- (elf-debuglink
- (read-elf "exe")))
- (lambda (file crc)
- (call-with-output-file #$output
- (lambda (port)
- (write (list file crc) port)))))))))
- (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
- (x (built-derivations (list drv))))
- (call-with-input-file (derivation->output-path drv)
- (lambda (port)
- (return (match (read port)
- (("exe.debug" crc)
- (= crc (debuglink-crc32 (open-input-string "a"))))
- (x
- (pk 'fail x #f))))))))))
+ (setenv "PATH" (string-join '(#$%bootstrap-gcc
+ #$%bootstrap-binutils)
+ "/bin:" 'suffix))
+ (invoke "gcc" "-O0" "-g" #$code "-o" "exe")
+ (copy-file "exe" "exe.debug")
+ (invoke "strip" "--only-keep-debug" "exe.debug")
+ (invoke "strip" "--strip-debug" "exe")
+ (invoke "objcopy" "--add-gnu-debuglink=exe.debug"
+ "exe")
+ (set-debuglink-crc "exe" #$debug)
+ (call-with-values (lambda ()
+ (elf-debuglink
+ (call-with-input-file "exe"
+ read-elf)))
+ (lambda (file crc)
+ (call-with-output-file #$output
+ (lambda (port)
+ (write (list file crc) port)))))))))
+ (mlet* %store-monad ((drv (gexp->derivation "debuglink" exp))
+ (x (built-derivations (list drv))))
+ (call-with-input-file (derivation->output-path drv)
+ (lambda (port)
+ (return (match (read port)
+ (("exe.debug" crc)
+ (= crc (debuglink-crc32 (open-input-string "a"))))
+ (x
+ (pk 'fail x #f)))))))))
(test-end "debug-link")
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index 44237e2ad3..280b1d8819 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -23,7 +23,6 @@
#:use-module (guix tests)
#:use-module ((guix utils) #:select (call-with-temporary-directory
target-aarch64?))
- #:use-module (guix build io)
#:use-module (guix build utils)
#:use-module (guix build gremlin)
#:use-module (gnu packages bootstrap)
@@ -45,6 +44,9 @@
(_
#f)))
+(define read-elf
+ (compose parse-elf get-bytevector-all))
+
(define c-compiler
(or (which "gcc") (which "cc") (which "g++")))
@@ -53,7 +55,8 @@
(unless %guile-executable (test-skip 1))
(test-assert "elf-dynamic-info-needed, executable"
- (let ((dyninfo (file-dynamic-info %guile-executable)))
+ (let* ((elf (call-with-input-file %guile-executable read-elf))
+ (dyninfo (elf-dynamic-info elf)))
(or (not dyninfo) ;static executable
(lset<= string=?
(list (string-append "libguile-" (effective-version))
@@ -137,7 +140,9 @@
(display "int main () { puts(\"hello\"); }" port)))
(invoke c-compiler "t.c"
"-Wl,--enable-new-dtags" "-Wl,-rpath=/foo" "-Wl,-rpath=/bar")
- (let* ((dyninfo (file-dynamic-info "a.out"))
+ (let* ((dyninfo (elf-dynamic-info
+ (parse-elf (call-with-input-file "a.out"
+ get-bytevector-all))))
(old (elf-dynamic-info-runpath dyninfo))
(new (strip-runpath "a.out"))
(new* (strip-runpath "a.out")))
@@ -191,7 +196,10 @@
(display "// empty file" port)))
(invoke c-compiler "t.c"
"-shared" "-Wl,-soname,libfoo.so.2")
- (let ((dyninfo (file-dynamic-info "a.out")))
- (elf-dynamic-info-soname dyninfo))))))
+ (let* ((dyninfo (elf-dynamic-info
+ (parse-elf (call-with-input-file "a.out"
+ get-bytevector-all))))
+ (soname (elf-dynamic-info-soname dyninfo)))
+ soname)))))
(test-end "gremlin")
