bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

Revert "Use mmap for the elf parser, reducing memory usage."

Browse source 
This reverts commit 2c1fe0df11.
This commit is contained in:
Maxim Cournoyer 2025-10-30 16:19:50 +09:00
parent 9d60fdf6a2
commit 0f39db9c19
No known key found for this signature in database
GPG key ID: 1260E46482E63562
7 changed files with 164 additions and 147 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gnu/packages/gnuzilla.scm
View file

@ -996,10 +996,16 @@ preferences/advanced-scripts.dtd"
(search-input-file inputs "lib/libavcodec.so"))))) (search-input-file inputs "lib/libavcodec.so")))))
(add-after 'fix-ffmpeg-runtime-linker 'build-sandbox-whitelist (add-after 'fix-ffmpeg-runtime-linker 'build-sandbox-whitelist
(lambda* (#:key inputs #:allow-other-keys) (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) (define (runpaths-of-input label)
(let* ((dir (string-append (assoc-ref inputs label) "/lib")) (let* ((dir (string-append (assoc-ref inputs label) "/lib"))
(libs (find-files dir "\\.so$"))) (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. ;; Populate the sandbox read-path whitelist as needed by ffmpeg.
(let* ((whitelist (let* ((whitelist
(map (cut string-append <> "/") (map (cut string-append <> "/")

6
gnu/packages/librewolf.scm
View file

@ -530,11 +530,15 @@
;; The following two functions are from Guix's icecat package in ;; The following two functions are from Guix's icecat package in
;; (gnu packages gnuzilla). See commit ;; (gnu packages gnuzilla). See commit
;; b7a0935420ee630a29b7e5ac73a32ba1eb24f00b. ;; 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) (define (runpaths-of-input label)
(let* ((dir (string-append (assoc-ref inputs label) (let* ((dir (string-append (assoc-ref inputs label)
"/lib")) "/lib"))
(libs (find-files dir "\\.so$"))) (libs (find-files dir "\\.so$")))
(append-map file-runpath libs))) (append-map runpath-of libs)))
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib")) (lib (string-append out "/lib"))
(libs (map (libs (map

17
guix/build/debug-link.scm
View file

@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,7 +18,6 @@
(define-module (guix build debug-link) (define-module (guix build debug-link)
#:use-module (guix elf) #:use-module (guix elf)
#:use-module (guix build io)
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (find-files elf-file? make-file-writable)) #:select (find-files elf-file? make-file-writable))
#:use-module (rnrs bytevectors) #: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) (define (set-debuglink-crc file debug-file)
"Compute the CRC of DEBUG-FILE and set it as the '.gnu_debuglink' CRC in "Compute the CRC of DEBUG-FILE and set it as the '.gnu_debuglink' CRC in
FILE." FILE."
(let* ((bv (file->bytevector file #:protection (logior PROT_READ PROT_WRITE))) (let* ((elf (parse-elf (call-with-input-file file get-bytevector-all)))
(elf (parse-elf bv))
(offset (elf-debuglink-crc-offset elf))) (offset (elf-debuglink-crc-offset elf)))
(when offset (and offset
(let ((crc (call-with-input-file debug-file debuglink-crc32))) (let* ((crc (call-with-input-file debug-file debuglink-crc32))
(bytevector-u32-set! bv offset crc (elf-byte-order elf)) (bv (make-bytevector 4)))
(munmap bv))))) (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))))))
;;; ;;;

62
guix/build/gremlin.scm
View file

@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,7 +18,6 @@
(define-module (guix build gremlin) (define-module (guix build gremlin)
#:use-module (guix elf) #:use-module (guix elf)
#:use-module (guix build io)
#:use-module ((guix build utils) #:select (store-file-name?)) #:use-module ((guix build utils) #:select (store-file-name?))
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -250,7 +248,9 @@ string table if the type is a string."
(define (file-dynamic-info file) (define (file-dynamic-info file)
"Return the <elf-dynamic-info> record of FILE, or #f if FILE lacks dynamic "Return the <elf-dynamic-info> record of FILE, or #f if FILE lacks dynamic
info." 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) (define (file-runpath file)
"Return the DT_RUNPATH dynamic entry of FILE as a list of strings, or #f if "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)) (elf-segment-type segment))
#f))) #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))) (expand (cute expand-origin <> (dirname file)))
(dyninfo (elf-dynamic-info elf))) (dyninfo (elf-dynamic-info elf)))
(when dyninfo (when dyninfo
@ -401,13 +402,12 @@ according to DT_NEEDED."
needed))) needed)))
runpath)) runpath))
(define bv (file->bytevector file #:protection (define port
(logior PROT_READ PROT_WRITE))) (open-file file "r+b"))
(dynamic-wind (catch #t
(const #t)
(lambda () (lambda ()
(let* ((elf (parse-elf bv)) (let* ((elf (parse-elf (get-bytevector-all port)))
(entries (dynamic-entries elf (dynamic-link-segment elf))) (entries (dynamic-entries elf (dynamic-link-segment elf)))
(needed (filter-map (lambda (entry) (needed (filter-map (lambda (entry)
(and (= (dynamic-entry-type entry) (and (= (dynamic-entry-type entry)
@ -425,14 +425,15 @@ according to DT_NEEDED."
"~a: stripping RUNPATH to ~s (removed ~s)~%" "~a: stripping RUNPATH to ~s (removed ~s)~%"
file new file new
(lset-difference string=? old new)) (lset-difference string=? old new))
;; Write to bytevector directly. (seek port (dynamic-entry-offset runpath) SEEK_SET)
(let ((src (string->utf8 (string-append (string-join new ":") (put-bytevector port (string->utf8 (string-join new ":")))
"\0")))) (put-u8 port 0))
(bytevector-copy! src 0 bv (dynamic-entry-offset runpath) (close-port port)
(bytevector-length src))))
new)) new))
(lambda () (lambda (key . args)
(munmap bv)))) (false-if-exception (close-port port))
(apply throw key args))))
(define-condition-type &missing-runpath-error &elf-error (define-condition-type &missing-runpath-error &elf-error
missing-runpath-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 "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 ELF file, to PATH, a list of strings. Raise a &missing-runpath-error or
&runpath-too-long-error when appropriate." &runpath-too-long-error when appropriate."
(define bv (file->bytevector file #:protection (define (call-with-input+output-file file proc)
(logior PROT_READ PROT_WRITE))) (let ((port (open-file file "r+b")))
(dynamic-wind (guard (c (#t (close-port port) (raise c)))
(const #t) (proc port)
(lambda () (close-port port))))
(let* ((elf (parse-elf bv))
(call-with-input+output-file file
(lambda (port)
(let* ((elf (parse-elf (get-bytevector-all port)))
(entries (dynamic-entries elf (dynamic-link-segment elf))) (entries (dynamic-entries elf (dynamic-link-segment elf)))
(runpath (find (lambda (entry) (runpath (find (lambda (entry)
(= DT_RUNPATH (dynamic-entry-type entry))) (= DT_RUNPATH (dynamic-entry-type entry)))
entries)) entries))
(path (string->utf8 (string-append (string-join path ":") (path (string->utf8 (string-join path ":"))))
"\0"))))
(unless runpath (unless runpath
(raise (condition (&missing-runpath-error (elf elf) (raise (condition (&missing-runpath-error (elf elf)
(file file))))) (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) (raise (condition (&runpath-too-long-error (elf #f #;elf)
(file file))))) (file file)))))
(bytevector-copy! path 0 bv (dynamic-entry-offset runpath) (seek port (dynamic-entry-offset runpath) SEEK_SET)
(bytevector-length path)))) (put-bytevector port path)
(lambda () (put-u8 port 0)))))
(munmap bv))))
;;; Local Variables:
;;; eval: (put 'call-with-input+output-file 'scheme-indent-function 1)
;;; End:

11
guix/scripts/pack.scm
View file

@ -5,7 +5,7 @@
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020-2023, 2025 Maxim Cournoyer <maxim@guixotic.coop> ;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim@guixotic.coop>
;;; Copyright © 2020 Eric Bavier <bavier@posteo.net> ;;; Copyright © 2020 Eric Bavier <bavier@posteo.net>
;;; Copyright © 2022 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2023 Graham James Addis <graham@addis.org.uk> ;;; Copyright © 2023 Graham James Addis <graham@addis.org.uk>
@ -1221,14 +1221,12 @@ libfakechroot.so and related ld.so machinery as a fallback."
(define build (define build
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((guix build io) '((guix build utils)
(guix build utils)
(guix build union) (guix build union)
(guix build gremlin) (guix build gremlin)
(guix elf))) (guix elf)))
#~(begin #~(begin
(use-modules (guix build io) (use-modules (guix build utils)
(guix build utils)
((guix build union) #:select (symlink-relative)) ((guix build union) #:select (symlink-relative))
(guix elf) (guix elf)
(guix build gremlin) (guix build gremlin)
@ -1282,7 +1280,8 @@ libfakechroot.so and related ld.so machinery as a fallback."
#$(if fakechroot? #$(if fakechroot?
;; TODO: Handle scripts by wrapping their interpreter. ;; TODO: Handle scripts by wrapping their interpreter.
#~(if (elf-file? program) #~(if (elf-file? program)
(let* ((bv (file->bytevector program)) (let* ((bv (call-with-input-file program
get-bytevector-all))
(elf (parse-elf bv)) (elf (parse-elf bv))
(interp (elf-interpreter elf)) (interp (elf-interpreter elf))
(gconv (and interp (gconv (and interp

55
tests/debug-link.scm
View file

@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,15 +20,12 @@
#:use-module (guix elf) #:use-module (guix elf)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix build debug-link) #:use-module (guix build debug-link)
#:use-module (guix build io)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module ((gnu packages guile) #:select (guile-3.0))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
@ -44,12 +40,15 @@
(_ (_
#f))) #f)))
(define read-elf
(compose parse-elf get-bytevector-all))
(test-begin "debug-link") (test-begin "debug-link")
(unless %guile-executable (test-skip 1)) (unless %guile-executable (test-skip 1))
(test-assert "elf-debuglink, no .gnu_debuglink section" (test-assert "elf-debuglink"
(let ((elf (parse-elf (file->bytevector %guile-executable)))) (let ((elf (call-with-input-file %guile-executable read-elf)))
(match (call-with-values (lambda () (elf-debuglink elf)) list) (match (call-with-values (lambda () (elf-debuglink elf)) list)
((#f #f) ;no '.gnu_debuglink' section ((#f #f) ;no '.gnu_debuglink' section
(pk 'no-debuglink #t)) (pk 'no-debuglink #t))
@ -57,29 +56,23 @@
(string-suffix? ".debug" file))))) (string-suffix? ".debug" file)))))
;; Since we need %BOOTSTRAP-GCC and co., we have to skip the following tests ;; 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 ;; when networking is unreachable because we'd fail to download it.
;; using mmap to load ELF more efficiently, we also need the regular Guile (unless (network-reachable?) (test-skip 1))
;; package, as guile-bootstrap cannot resolve dynamic symbols. (test-assertm "elf-debuglink"
(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 ;; Check whether we can compute the CRC just like objcopy, and whether we
;; can retrieve it. ;; can retrieve it.
(let* ((code (plain-file "test.c" "int main () { return 42; }")) (let* ((code (plain-file "test.c" "int main () { return 42; }"))
(exp (with-imported-modules (source-module-closure (exp (with-imported-modules '((guix build utils)
'((guix build io)
(guix build utils)
(guix build debug-link) (guix build debug-link)
(guix elf))) (guix elf))
#~(begin #~(begin
(use-modules (guix build io) (use-modules (guix build utils)
(guix build utils)
(guix build debug-link) (guix build debug-link)
(guix elf) (guix elf)
(rnrs io ports)) (rnrs io ports))
(define read-elf (define read-elf
(compose parse-elf file->bytevector)) (compose parse-elf get-bytevector-all))
(setenv "PATH" (string-join '(#$%bootstrap-gcc (setenv "PATH" (string-join '(#$%bootstrap-gcc
#$%bootstrap-binutils) #$%bootstrap-binutils)
@ -91,7 +84,9 @@
(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 (read-elf "exe"))) (elf-debuglink
(call-with-input-file "exe"
read-elf)))
(lambda (file crc) (lambda (file crc)
(call-with-output-file #$output (call-with-output-file #$output
(lambda (port) (lambda (port)
@ -107,25 +102,22 @@
(("exe.debug" #t) #t) (("exe.debug" #t) #t)
(x (pk 'fail x #f))))))))) (x (pk 'fail x #f)))))))))
(unless (and (network-reachable?) store) (test-skip 1)) (unless (network-reachable?) (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 (source-module-closure (exp (with-imported-modules '((guix build utils)
'((guix build io)
(guix build utils)
(guix build debug-link) (guix build debug-link)
(guix elf))) (guix elf))
#~(begin #~(begin
(use-modules (guix build io) (use-modules (guix build utils)
(guix build utils)
(guix build debug-link) (guix build debug-link)
(guix elf) (guix elf)
(rnrs io ports)) (rnrs io ports))
(define read-elf (define read-elf
(compose parse-elf file->bytevector)) (compose parse-elf get-bytevector-all))
(setenv "PATH" (string-join '(#$%bootstrap-gcc (setenv "PATH" (string-join '(#$%bootstrap-gcc
#$%bootstrap-binutils) #$%bootstrap-binutils)
@ -139,7 +131,8 @@
(set-debuglink-crc "exe" #$debug) (set-debuglink-crc "exe" #$debug)
(call-with-values (lambda () (call-with-values (lambda ()
(elf-debuglink (elf-debuglink
(read-elf "exe"))) (call-with-input-file "exe"
read-elf)))
(lambda (file crc) (lambda (file crc)
(call-with-output-file #$output (call-with-output-file #$output
(lambda (port) (lambda (port)
@ -152,6 +145,6 @@
(("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") (test-end "debug-link")

18
tests/gremlin.scm
View file

@ -23,7 +23,6 @@
#:use-module (guix tests) #:use-module (guix tests)
#:use-module ((guix utils) #:select (call-with-temporary-directory #:use-module ((guix utils) #:select (call-with-temporary-directory
target-aarch64?)) target-aarch64?))
#:use-module (guix build io)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix build gremlin) #:use-module (guix build gremlin)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
@ -45,6 +44,9 @@
(_ (_
#f))) #f)))
(define read-elf
(compose parse-elf get-bytevector-all))
(define c-compiler (define c-compiler
(or (which "gcc") (which "cc") (which "g++"))) (or (which "gcc") (which "cc") (which "g++")))
@ -53,7 +55,8 @@
(unless %guile-executable (test-skip 1)) (unless %guile-executable (test-skip 1))
(test-assert "elf-dynamic-info-needed, executable" (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 (or (not dyninfo) ;static executable
(lset<= string=? (lset<= string=?
(list (string-append "libguile-" (effective-version)) (list (string-append "libguile-" (effective-version))
@ -137,7 +140,9 @@
(display "int main () { puts(\"hello\"); }" port))) (display "int main () { puts(\"hello\"); }" port)))
(invoke c-compiler "t.c" (invoke c-compiler "t.c"
"-Wl,--enable-new-dtags" "-Wl,-rpath=/foo" "-Wl,-rpath=/bar") "-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)) (old (elf-dynamic-info-runpath dyninfo))
(new (strip-runpath "a.out")) (new (strip-runpath "a.out"))
(new* (strip-runpath "a.out"))) (new* (strip-runpath "a.out")))
@ -191,7 +196,10 @@
(display "// empty file" port))) (display "// empty file" port)))
(invoke c-compiler "t.c" (invoke c-compiler "t.c"
"-shared" "-Wl,-soname,libfoo.so.2") "-shared" "-Wl,-soname,libfoo.so.2")
(let ((dyninfo (file-dynamic-info "a.out"))) (let* ((dyninfo (elf-dynamic-info
(elf-dynamic-info-soname dyninfo)))))) (parse-elf (call-with-input-file "a.out"
get-bytevector-all))))
(soname (elf-dynamic-info-soname dyninfo)))
soname)))))
(test-end "gremlin") (test-end "gremlin")