summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CODEOWNERS1
-rw-r--r--Makefile.am1
-rwxr-xr-xetc/teams.scm1
-rw-r--r--gnu/build/linux-modules.scm2
-rw-r--r--gnu/packages/gnuzilla.scm2
-rw-r--r--gnu/packages/librewolf.scm2
-rw-r--r--gnu/packages/sequoia.scm2
-rw-r--r--gnu/packages/tor-browsers.scm2
-rw-r--r--gnu/packages/version-control.scm2
-rw-r--r--guix/build-system/gnu.scm3
-rw-r--r--guix/build/debug-link.scm2
-rw-r--r--guix/build/gnu-build-system.scm2
-rw-r--r--guix/build/gremlin.scm2
-rw-r--r--guix/build/meson-build-system.scm2
-rw-r--r--guix/elf.scm1046
-rw-r--r--guix/grafts.scm6
-rw-r--r--guix/scripts/pack.scm7
-rw-r--r--tests/debug-link.scm12
-rw-r--r--tests/gremlin.scm2
19 files changed, 1076 insertions, 23 deletions
diff --git a/CODEOWNERS b/CODEOWNERS
index f167cf84929..b2e2ea61c4d 100644
--- a/CODEOWNERS
+++ b/CODEOWNERS
@@ -45,6 +45,7 @@ guix/diagnostics\.scm @guix/core
45guix/discovery\.scm @guix/core 45guix/discovery\.scm @guix/core
46guix/docker\.scm @guix/core 46guix/docker\.scm @guix/core
47guix/download\.scm @guix/core 47guix/download\.scm @guix/core
48guix/elf\.scm @guix/core
48guix/ftp-client\.scm @guix/core 49guix/ftp-client\.scm @guix/core
49guix/gexp\.scm @guix/core 50guix/gexp\.scm @guix/core
50guix/git-authenticate\.scm @guix/core 51guix/git-authenticate\.scm @guix/core
diff --git a/Makefile.am b/Makefile.am
index 54479f5ae7a..a6c2e73388f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -201,6 +201,7 @@ MODULES = \
201 guix/ftp-client.scm \ 201 guix/ftp-client.scm \
202 guix/http-client.scm \ 202 guix/http-client.scm \
203 guix/gnupg.scm \ 203 guix/gnupg.scm \
204 guix/elf.scm \
204 guix/profiling.scm \ 205 guix/profiling.scm \
205 guix/store.scm \ 206 guix/store.scm \
206 guix/cvs-download.scm \ 207 guix/cvs-download.scm \
diff --git a/etc/teams.scm b/etc/teams.scm
index 57fa61ec23b..b47f0dfdd9e 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -510,6 +510,7 @@ already exists. Lookup team IDs among CURRENT-TEAMS."
510 "guix/discovery.scm" 510 "guix/discovery.scm"
511 "guix/docker.scm" 511 "guix/docker.scm"
512 "guix/download.scm" 512 "guix/download.scm"
513 "guix/elf.scm"
513 "guix/ftp-client.scm" 514 "guix/ftp-client.scm"
514 "guix/gexp.scm" 515 "guix/gexp.scm"
515 "guix/git-authenticate.scm" 516 "guix/git-authenticate.scm"
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 5ff5198e8ab..6bf71100e49 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -21,6 +21,7 @@
21;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 21;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22 22
23(define-module (gnu build linux-modules) 23(define-module (gnu build linux-modules)
24 #:use-module (guix elf)
24 #:use-module (guix glob) 25 #:use-module (guix glob)
25 #:use-module (guix build syscalls) 26 #:use-module (guix build syscalls)
26 #:use-module ((guix build utils) #:select (find-files invoke)) 27 #:use-module ((guix build utils) #:select (find-files invoke))
@@ -38,7 +39,6 @@
38 #:use-module (ice-9 match) 39 #:use-module (ice-9 match)
39 #:use-module (ice-9 rdelim) 40 #:use-module (ice-9 rdelim)
40 #:autoload (ice-9 pretty-print) (pretty-print) 41 #:autoload (ice-9 pretty-print) (pretty-print)
41 #:use-module (system vm elf)
42 #:export (dot-ko 42 #:export (dot-ko
43 ensure-dot-ko 43 ensure-dot-ko
44 module-formal-name 44 module-formal-name
diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm
index 7e883ce291a..d24797b85a0 100644
--- a/gnu/packages/gnuzilla.scm
+++ b/gnu/packages/gnuzilla.scm
@@ -927,7 +927,7 @@ preferences/advanced-scripts.dtd"
927 (srfi srfi-26) 927 (srfi srfi-26)
928 (rnrs bytevectors) 928 (rnrs bytevectors)
929 (rnrs io ports) 929 (rnrs io ports)
930 (system vm elf) 930 (guix elf)
931 (guix build gremlin) 931 (guix build gremlin)
932 ,@%default-gnu-modules) 932 ,@%default-gnu-modules)
933 #:phases 933 #:phases
diff --git a/gnu/packages/librewolf.scm b/gnu/packages/librewolf.scm
index 586e29a9621..6c852d7f1c2 100644
--- a/gnu/packages/librewolf.scm
+++ b/gnu/packages/librewolf.scm
@@ -282,7 +282,7 @@
282 (srfi srfi-26) 282 (srfi srfi-26)
283 (rnrs bytevectors) 283 (rnrs bytevectors)
284 (rnrs io ports) 284 (rnrs io ports)
285 (system vm elf) 285 (guix elf)
286 (guix build gremlin) 286 (guix build gremlin)
287 ,@%default-gnu-imported-modules) 287 ,@%default-gnu-imported-modules)
288 #:phases 288 #:phases
diff --git a/gnu/packages/sequoia.scm b/gnu/packages/sequoia.scm
index 1eb047e84ef..4dfa48bca30 100644
--- a/gnu/packages/sequoia.scm
+++ b/gnu/packages/sequoia.scm
@@ -318,7 +318,7 @@ This Guix package is built to use the nettle cryptographic library.")
318 (guix build union) 318 (guix build union)
319 (guix build gnu-build-system) 319 (guix build gnu-build-system)
320 (guix build gremlin) 320 (guix build gremlin)
321 (system vm elf)) 321 (guix elf))
322 #:builder 322 #:builder
323 #~(begin 323 #~(begin
324 (use-modules (guix build utils) 324 (use-modules (guix build utils)
diff --git a/gnu/packages/tor-browsers.scm b/gnu/packages/tor-browsers.scm
index ef2d7432d42..2a5645272e1 100644
--- a/gnu/packages/tor-browsers.scm
+++ b/gnu/packages/tor-browsers.scm
@@ -362,7 +362,7 @@ Browser.")
362 (srfi srfi-26) 362 (srfi srfi-26)
363 (rnrs bytevectors) 363 (rnrs bytevectors)
364 (rnrs io ports) 364 (rnrs io ports)
365 (system vm elf) 365 (guix elf)
366 (guix build gremlin) 366 (guix build gremlin)
367 ,@%default-gnu-imported-modules) 367 ,@%default-gnu-imported-modules)
368 #:phases 368 #:phases
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index fc272afbb10..918ef967861 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -2948,7 +2948,7 @@ history. It implements the changeset evolution concept for Mercurial.")
2948 (guix build utils) 2948 (guix build utils)
2949 (guix build gremlin) 2949 (guix build gremlin)
2950 (ice-9 ftw) 2950 (ice-9 ftw)
2951 (system vm elf)) 2951 (guix elf))
2952 #:phases 2952 #:phases
2953 (modify-phases %standard-phases 2953 (modify-phases %standard-phases
2954 (add-after 'unpack 'patch-paths 2954 (add-after 'unpack 'patch-paths
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 437e80811d4..8f0883956e3 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -55,7 +55,8 @@
55 ;; Build-side modules imported and used by default. 55 ;; Build-side modules imported and used by default.
56 '((guix build gnu-build-system) 56 '((guix build gnu-build-system)
57 (guix build utils) 57 (guix build utils)
58 (guix build gremlin))) 58 (guix build gremlin)
59 (guix elf)))
59 60
60(define-deprecated/public-alias %gnu-build-system-modules 61(define-deprecated/public-alias %gnu-build-system-modules
61 %default-gnu-imported-modules) 62 %default-gnu-imported-modules)
diff --git a/guix/build/debug-link.scm b/guix/build/debug-link.scm
index a147c254d7c..7a74e6001b7 100644
--- a/guix/build/debug-link.scm
+++ b/guix/build/debug-link.scm
@@ -18,6 +18,7 @@
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 19
20(define-module (guix build debug-link) 20(define-module (guix build debug-link)
21 #:use-module (guix elf)
21 #:use-module (guix build io) 22 #:use-module (guix build io)
22 #:use-module ((guix build utils) 23 #:use-module ((guix build utils)
23 #:select (find-files elf-file? make-file-writable)) 24 #:select (find-files elf-file? make-file-writable))
@@ -25,7 +26,6 @@
25 #:use-module (rnrs io ports) 26 #:use-module (rnrs io ports)
26 #:use-module (srfi srfi-1) 27 #:use-module (srfi srfi-1)
27 #:use-module (system foreign) 28 #:use-module (system foreign)
28 #:use-module (system vm elf)
29 #:use-module (ice-9 match) 29 #:use-module (ice-9 match)
30 #:export (debuglink-crc32 30 #:export (debuglink-crc32
31 elf-debuglink 31 elf-debuglink
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 15cb17cabcf..8183762ce1d 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -22,6 +22,7 @@
22(define-module (guix build gnu-build-system) 22(define-module (guix build gnu-build-system)
23 #:use-module (guix build utils) 23 #:use-module (guix build utils)
24 #:use-module (guix build gremlin) 24 #:use-module (guix build gremlin)
25 #:use-module (guix elf)
25 #:use-module (ice-9 ftw) 26 #:use-module (ice-9 ftw)
26 #:use-module (ice-9 match) 27 #:use-module (ice-9 match)
27 #:use-module (ice-9 regex) 28 #:use-module (ice-9 regex)
@@ -34,7 +35,6 @@
34 #:use-module (srfi srfi-34) 35 #:use-module (srfi srfi-34)
35 #:use-module (srfi srfi-35) 36 #:use-module (srfi srfi-35)
36 #:use-module (srfi srfi-26) 37 #:use-module (srfi srfi-26)
37 #:use-module (system vm elf)
38 #:use-module (rnrs io ports) 38 #:use-module (rnrs io ports)
39 #:export (%standard-phases 39 #:export (%standard-phases
40 %license-file-regexp 40 %license-file-regexp
diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index eb4e0af2e70..2392a74a359 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -18,6 +18,7 @@
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 19
20(define-module (guix build gremlin) 20(define-module (guix build gremlin)
21 #:use-module (guix elf)
21 #:use-module (guix build io) 22 #:use-module (guix build io)
22 #:use-module ((guix build utils) #:select (store-file-name?)) 23 #:use-module ((guix build utils) #:select (store-file-name?))
23 #:use-module (ice-9 match) 24 #:use-module (ice-9 match)
@@ -27,7 +28,6 @@
27 #:use-module (srfi srfi-34) 28 #:use-module (srfi srfi-34)
28 #:use-module (srfi srfi-35) 29 #:use-module (srfi srfi-35)
29 #:use-module (system foreign) 30 #:use-module (system foreign)
30 #:use-module (system vm elf)
31 #:use-module (rnrs bytevectors) 31 #:use-module (rnrs bytevectors)
32 #:use-module (rnrs io ports) 32 #:use-module (rnrs io ports)
33 #:export (elf-error? 33 #:export (elf-error?
diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm
index 7a85772759c..d8be1f3faa2 100644
--- a/guix/build/meson-build-system.scm
+++ b/guix/build/meson-build-system.scm
@@ -24,10 +24,10 @@
24 #:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:) 24 #:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
25 #:use-module (guix build utils) 25 #:use-module (guix build utils)
26 #:use-module (guix build gremlin) 26 #:use-module (guix build gremlin)
27 #:use-module (guix elf)
27 #:use-module (ice-9 match) 28 #:use-module (ice-9 match)
28 #:use-module (rnrs io ports) 29 #:use-module (rnrs io ports)
29 #:use-module (srfi srfi-1) 30 #:use-module (srfi srfi-1)
30 #:use-module (system vm elf)
31 #:export (%standard-phases 31 #:export (%standard-phases
32 meson-build)) 32 meson-build))
33 33
diff --git a/guix/elf.scm b/guix/elf.scm
new file mode 100644
index 00000000000..4283dbd2e49
--- /dev/null
+++ b/guix/elf.scm
@@ -0,0 +1,1046 @@
1;;; Guile ELF reader and writer
2
3;; Copyright (C) 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
4
5;;;; This library is free software; you can redistribute it and/or
6;;;; modify it under the terms of the GNU Lesser General Public
7;;;; License as published by the Free Software Foundation; either
8;;;; version 3 of the License, or (at your option) any later version.
9;;;;
10;;;; This library is distributed in the hope that it will be useful,
11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13;;;; Lesser General Public License for more details.
14;;;;
15;;;; You should have received a copy of the GNU Lesser General Public
16;;;; License along with this library; if not, write to the Free Software
17;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18
19;;; Commentary:
20;;;
21;;; This file was taken from the Guile 2.1 branch, where it is known as
22;;; (system vm elf), and renamed to (guix elf). It will be unneeded when Guix
23;;; switches to Guile 2.1/2.2.
24;;;
25;;; A module to read and write Executable and Linking Format (ELF)
26;;; files.
27;;;
28;;; This module exports a number of record types that represent the
29;;; various parts that make up ELF files. Fundamentally this is the
30;;; main header, the segment headers (program headers), and the section
31;;; headers. It also exports bindings for symbolic constants and
32;;; utilities to parse and write special kinds of ELF sections.
33;;;
34;;; See elf(5) for more information on ELF.
35;;;
36;;; Code:
37
38(define-module (guix elf)
39 #:use-module (rnrs bytevectors)
40 #:use-module (system foreign)
41 #:use-module (system base target)
42 #:use-module (srfi srfi-9)
43 #:use-module (ice-9 receive)
44 #:use-module (ice-9 vlist)
45 #:export (has-elf-header?
46
47 (make-elf* . make-elf)
48 elf?
49 elf-bytes elf-word-size elf-byte-order
50 elf-abi elf-type elf-machine-type
51 elf-entry elf-phoff elf-shoff elf-flags elf-ehsize
52 elf-phentsize elf-phnum elf-shentsize elf-shnum elf-shstrndx
53
54 ELFOSABI_NONE ELFOSABI_HPUX ELFOSABI_NETBSD ELFOSABI_GNU
55 ELFOSABI_SOLARIS ELFOSABI_AIX ELFOSABI_IRIX ELFOSABI_FREEBSD
56 ELFOSABI_TRU64 ELFOSABI_MODESTO ELFOSABI_OPENBSD
57 ELFOSABI_ARM_AEABI ELFOSABI_ARM ELFOSABI_STANDALONE
58
59 ET_NONE ET_REL ET_EXEC ET_DYN ET_CORE
60
61 EM_NONE EM_SPARC EM_386 EM_MIPS EM_PPC EM_PPC64 EM_ARM EM_SH
62 EM_SPARCV9 EM_IA_64 EM_X86_64
63
64 elf-header-len elf-header-shoff-offset
65 write-elf-header
66
67 (make-elf-segment* . make-elf-segment)
68 elf-segment?
69 elf-segment-index
70 elf-segment-type elf-segment-offset elf-segment-vaddr
71 elf-segment-paddr elf-segment-filesz elf-segment-memsz
72 elf-segment-flags elf-segment-align
73
74 elf-program-header-len write-elf-program-header
75
76 PT_NULL PT_LOAD PT_DYNAMIC PT_INTERP PT_NOTE PT_SHLIB
77 PT_PHDR PT_TLS PT_NUM PT_LOOS PT_GNU_EH_FRAME PT_GNU_STACK
78 PT_GNU_RELRO
79
80 PF_R PF_W PF_X
81
82 (make-elf-section* . make-elf-section)
83 elf-section?
84 elf-section-index
85 elf-section-name elf-section-type elf-section-flags
86 elf-section-addr elf-section-offset elf-section-size
87 elf-section-link elf-section-info elf-section-addralign
88 elf-section-entsize
89
90 elf-section-header-len elf-section-header-addr-offset
91 elf-section-header-offset-offset
92 write-elf-section-header
93
94 (make-elf-symbol* . make-elf-symbol)
95 elf-symbol?
96 elf-symbol-name elf-symbol-value elf-symbol-size
97 elf-symbol-info elf-symbol-other elf-symbol-shndx
98 elf-symbol-binding elf-symbol-type elf-symbol-visibility
99
100 elf-symbol-len elf-symbol-value-offset write-elf-symbol
101
102 SHN_UNDEF
103
104 SHT_NULL SHT_PROGBITS SHT_SYMTAB SHT_STRTAB SHT_RELA
105 SHT_HASH SHT_DYNAMIC SHT_NOTE SHT_NOBITS SHT_REL SHT_SHLIB
106 SHT_DYNSYM SHT_INIT_ARRAY SHT_FINI_ARRAY SHT_PREINIT_ARRAY
107 SHT_GROUP SHT_SYMTAB_SHNDX SHT_NUM SHT_LOOS SHT_HIOS
108 SHT_LOPROC SHT_HIPROC SHT_LOUSER SHT_HIUSER
109
110 SHF_WRITE SHF_ALLOC SHF_EXECINSTR SHF_MERGE SHF_STRINGS
111 SHF_INFO_LINK SHF_LINK_ORDER SHF_OS_NONCONFORMING SHF_GROUP
112 SHF_TLS
113
114 DT_NULL DT_NEEDED DT_PLTRELSZ DT_PLTGOT DT_HASH DT_STRTAB
115 DT_SYMTAB DT_RELA DT_RELASZ DT_RELAENT DT_STRSZ DT_SYMENT
116 DT_INIT DT_FINI DT_SONAME DT_RPATH DT_SYMBOLIC DT_REL
117 DT_RELSZ DT_RELENT DT_PLTREL DT_DEBUG DT_TEXTREL DT_JMPREL
118 DT_BIND_NOW DT_INIT_ARRAY DT_FINI_ARRAY DT_INIT_ARRAYSZ
119 DT_FINI_ARRAYSZ DT_RUNPATH DT_FLAGS DT_ENCODING
120 DT_PREINIT_ARRAY DT_PREINIT_ARRAYSZ DT_NUM DT_LOGUILE
121 DT_GUILE_GC_ROOT DT_GUILE_GC_ROOT_SZ DT_GUILE_ENTRY
122 DT_GUILE_VM_VERSION DT_GUILE_FRAME_MAPS DT_HIGUILE
123 DT_LOOS DT_HIOS DT_LOPROC DT_HIPROC
124
125 string-table-ref
126
127 STB_LOCAL STB_GLOBAL STB_WEAK STB_NUM STB_LOOS STB_GNU
128 STB_HIOS STB_LOPROC STB_HIPROC
129
130 STT_NOTYPE STT_OBJECT STT_FUNC STT_SECTION STT_FILE
131 STT_COMMON STT_TLS STT_NUM STT_LOOS STT_GNU STT_HIOS
132 STT_LOPROC STT_HIPROC
133
134 STV_DEFAULT STV_INTERNAL STV_HIDDEN STV_PROTECTED
135
136 NT_GNU_ABI_TAG NT_GNU_HWCAP NT_GNU_BUILD_ID NT_GNU_GOLD_VERSION
137
138 parse-elf
139 elf-segment elf-segments
140 elf-section elf-sections elf-section-by-name elf-sections-by-name
141 elf-symbol-table-len elf-symbol-table-ref
142
143 parse-elf-note
144 elf-note-name elf-note-desc elf-note-type))
145
146;; #define EI_NIDENT 16
147
148;; typedef struct {
149;; unsigned char e_ident[EI_NIDENT];
150;; uint16_t e_type;
151;; uint16_t e_machine;
152;; uint32_t e_version;
153;; ElfN_Addr e_entry;
154;; ElfN_Off e_phoff;
155;; ElfN_Off e_shoff;
156;; uint32_t e_flags;
157;; uint16_t e_ehsize;
158;; uint16_t e_phentsize;
159;; uint16_t e_phnum;
160;; uint16_t e_shentsize;
161;; uint16_t e_shnum;
162;; uint16_t e_shstrndx;
163;; } ElfN_Ehdr;
164
165(define elf32-header-len 52)
166(define elf64-header-len 64)
167(define (elf-header-len word-size)
168 (case word-size
169 ((4) elf32-header-len)
170 ((8) elf64-header-len)
171 (else (error "invalid word size" word-size))))
172(define (elf-header-shoff-offset word-size)
173 (case word-size
174 ((4) 32)
175 ((8) 40)
176 (else (error "bad word size" word-size))))
177
178(define ELFCLASS32 1) ; 32-bit objects
179(define ELFCLASS64 2) ; 64-bit objects
180
181(define ELFDATA2LSB 1) ; 2's complement, little endian
182(define ELFDATA2MSB 2) ; 2's complement, big endian
183
184(define EV_CURRENT 1) ; Current version
185
186(define ELFOSABI_NONE 0) ; UNIX System V ABI */
187(define ELFOSABI_HPUX 1) ; HP-UX
188(define ELFOSABI_NETBSD 2) ; NetBSD.
189(define ELFOSABI_GNU 3) ; Object uses GNU ELF extensions.
190(define ELFOSABI_SOLARIS 6) ; Sun Solaris.
191(define ELFOSABI_AIX 7) ; IBM AIX.
192(define ELFOSABI_IRIX 8) ; SGI Irix.
193(define ELFOSABI_FREEBSD 9) ; FreeBSD.
194(define ELFOSABI_TRU64 10) ; Compaq TRU64 UNIX.
195(define ELFOSABI_MODESTO 11) ; Novell Modesto.
196(define ELFOSABI_OPENBSD 12) ; OpenBSD.
197(define ELFOSABI_ARM_AEABI 64) ; ARM EABI
198(define ELFOSABI_ARM 97) ; ARM
199(define ELFOSABI_STANDALONE 255) ; Standalone (embedded) application
200
201(define ET_NONE 0) ; No file type
202(define ET_REL 1) ; Relocatable file
203(define ET_EXEC 2) ; Executable file
204(define ET_DYN 3) ; Shared object file
205(define ET_CORE 4) ; Core file
206
207;;
208;; Machine types
209;;
210;; Just a sampling of these values. We could include more, but the
211;; important thing is to recognize architectures for which we have a
212;; native compiler. Recognizing more common machine types is icing on
213;; the cake.
214;;
215(define EM_NONE 0) ; No machine
216(define EM_SPARC 2) ; SUN SPARC
217(define EM_386 3) ; Intel 80386
218(define EM_MIPS 8) ; MIPS R3000 big-endian
219(define EM_PPC 20) ; PowerPC
220(define EM_PPC64 21) ; PowerPC 64-bit
221(define EM_ARM 40) ; ARM
222(define EM_SH 42) ; Hitachi SH
223(define EM_SPARCV9 43) ; SPARC v9 64-bit
224(define EM_IA_64 50) ; Intel Merced
225(define EM_X86_64 62) ; AMD x86-64 architecture
226
227(define cpu-mapping (make-hash-table))
228(for-each (lambda (pair)
229 (hashq-set! cpu-mapping (car pair) (cdr pair)))
230 `((none . ,EM_NONE)
231 (sparc . ,EM_SPARC) ; FIXME: map 64-bit to SPARCV9 ?
232 (i386 . ,EM_386)
233 (mips . ,EM_MIPS)
234 (ppc . ,EM_PPC)
235 (ppc64 . ,EM_PPC64)
236 (arm . ,EM_ARM) ; FIXME: there are more arm cpu variants
237 (sh . ,EM_SH) ; FIXME: there are more sh cpu variants
238 (ia64 . ,EM_IA_64)
239 (x86_64 . ,EM_X86_64)))
240
241(define SHN_UNDEF 0)
242
243(define host-machine-type
244 (hashq-ref cpu-mapping
245 (string->symbol (car (string-split %host-type #\-)))
246 EM_NONE))
247
248(define host-word-size
249 (sizeof '*))
250
251(define host-byte-order
252 (native-endianness))
253
254(define (has-elf-header? bv)
255 (and
256 ;; e_ident
257 (>= (bytevector-length bv) 16)
258 (= (bytevector-u8-ref bv 0) #x7f)
259 (= (bytevector-u8-ref bv 1) (char->integer #\E))
260 (= (bytevector-u8-ref bv 2) (char->integer #\L))
261 (= (bytevector-u8-ref bv 3) (char->integer #\F))
262 (cond
263 ((= (bytevector-u8-ref bv 4) ELFCLASS32)
264 (>= (bytevector-length bv) elf32-header-len))
265 ((= (bytevector-u8-ref bv 4) ELFCLASS64)
266 (>= (bytevector-length bv) elf64-header-len))
267 (else #f))
268 (or (= (bytevector-u8-ref bv 5) ELFDATA2LSB)
269 (= (bytevector-u8-ref bv 5) ELFDATA2MSB))
270 (= (bytevector-u8-ref bv 6) EV_CURRENT)
271 ;; Look at ABI later.
272 (= (bytevector-u8-ref bv 8) 0) ; ABI version
273 ;; The rest of the e_ident is padding.
274
275 ;; e_version
276 (let ((byte-order (if (= (bytevector-u8-ref bv 5) ELFDATA2LSB)
277 (endianness little)
278 (endianness big))))
279 (= (bytevector-u32-ref bv 20 byte-order) EV_CURRENT))))
280
281(define-record-type <elf>
282 (make-elf bytes word-size byte-order abi type machine-type
283 entry phoff shoff flags ehsize
284 phentsize phnum shentsize shnum shstrndx)
285 elf?
286 (bytes elf-bytes)
287 (word-size elf-word-size)
288 (byte-order elf-byte-order)
289 (abi elf-abi)
290 (type elf-type)
291 (machine-type elf-machine-type)
292 (entry elf-entry)
293 (phoff elf-phoff)
294 (shoff elf-shoff)
295 (flags elf-flags)
296 (ehsize elf-ehsize)
297 (phentsize elf-phentsize)
298 (phnum elf-phnum)
299 (shentsize elf-shentsize)
300 (shnum elf-shnum)
301 (shstrndx elf-shstrndx))
302
303(define* (make-elf* #:key (bytes #f)
304 (byte-order (target-endianness))
305 (word-size (target-word-size))
306 (abi ELFOSABI_STANDALONE)
307 (type ET_DYN)
308 (machine-type EM_NONE)
309 (entry 0)
310 (phoff (elf-header-len word-size))
311 (shoff -1)
312 (flags 0)
313 (ehsize (elf-header-len word-size))
314 (phentsize (elf-program-header-len word-size))
315 (phnum 0)
316 (shentsize (elf-section-header-len word-size))
317 (shnum 0)
318 (shstrndx SHN_UNDEF))
319 (make-elf bytes word-size byte-order abi type machine-type
320 entry phoff shoff flags ehsize
321 phentsize phnum shentsize shnum shstrndx))
322
323(define (parse-elf32 bv byte-order)
324 (make-elf bv 4 byte-order
325 (bytevector-u8-ref bv 7)
326 (bytevector-u16-ref bv 16 byte-order)
327 (bytevector-u16-ref bv 18 byte-order)
328 (bytevector-u32-ref bv 24 byte-order)
329 (bytevector-u32-ref bv 28 byte-order)
330 (bytevector-u32-ref bv 32 byte-order)
331 (bytevector-u32-ref bv 36 byte-order)
332 (bytevector-u16-ref bv 40 byte-order)
333 (bytevector-u16-ref bv 42 byte-order)
334 (bytevector-u16-ref bv 44 byte-order)
335 (bytevector-u16-ref bv 46 byte-order)
336 (bytevector-u16-ref bv 48 byte-order)
337 (bytevector-u16-ref bv 50 byte-order)))
338
339(define (write-elf-ident bv class data abi)
340 (bytevector-u8-set! bv 0 #x7f)
341 (bytevector-u8-set! bv 1 (char->integer #\E))
342 (bytevector-u8-set! bv 2 (char->integer #\L))
343 (bytevector-u8-set! bv 3 (char->integer #\F))
344 (bytevector-u8-set! bv 4 class)
345 (bytevector-u8-set! bv 5 data)
346 (bytevector-u8-set! bv 6 EV_CURRENT)
347 (bytevector-u8-set! bv 7 abi)
348 (bytevector-u8-set! bv 8 0) ; ABI version
349 (bytevector-u8-set! bv 9 0) ; Pad to 16 bytes.
350 (bytevector-u8-set! bv 10 0)
351 (bytevector-u8-set! bv 11 0)
352 (bytevector-u8-set! bv 12 0)
353 (bytevector-u8-set! bv 13 0)
354 (bytevector-u8-set! bv 14 0)
355 (bytevector-u8-set! bv 15 0))
356
357(define (write-elf32-header bv elf)
358 (let ((byte-order (elf-byte-order elf)))
359 (write-elf-ident bv ELFCLASS32
360 (case byte-order
361 ((little) ELFDATA2LSB)
362 ((big) ELFDATA2MSB)
363 (else (error "unknown endianness" byte-order)))
364 (elf-abi elf))
365 (bytevector-u16-set! bv 16 (elf-type elf) byte-order)
366 (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order)
367 (bytevector-u32-set! bv 20 EV_CURRENT byte-order)
368 (bytevector-u32-set! bv 24 (elf-entry elf) byte-order)
369 (bytevector-u32-set! bv 28 (elf-phoff elf) byte-order)
370 (bytevector-u32-set! bv 32 (elf-shoff elf) byte-order)
371 (bytevector-u32-set! bv 36 (elf-flags elf) byte-order)
372 (bytevector-u16-set! bv 40 (elf-ehsize elf) byte-order)
373 (bytevector-u16-set! bv 42 (elf-phentsize elf) byte-order)
374 (bytevector-u16-set! bv 44 (elf-phnum elf) byte-order)
375 (bytevector-u16-set! bv 46 (elf-shentsize elf) byte-order)
376 (bytevector-u16-set! bv 48 (elf-shnum elf) byte-order)
377 (bytevector-u16-set! bv 50 (elf-shstrndx elf) byte-order)))
378
379(define (parse-elf64 bv byte-order)
380 (make-elf bv 8 byte-order
381 (bytevector-u8-ref bv 7)
382 (bytevector-u16-ref bv 16 byte-order)
383 (bytevector-u16-ref bv 18 byte-order)
384 (bytevector-u64-ref bv 24 byte-order)
385 (bytevector-u64-ref bv 32 byte-order)
386 (bytevector-u64-ref bv 40 byte-order)
387 (bytevector-u32-ref bv 48 byte-order)
388 (bytevector-u16-ref bv 52 byte-order)
389 (bytevector-u16-ref bv 54 byte-order)
390 (bytevector-u16-ref bv 56 byte-order)
391 (bytevector-u16-ref bv 58 byte-order)
392 (bytevector-u16-ref bv 60 byte-order)
393 (bytevector-u16-ref bv 62 byte-order)))
394
395(define (write-elf64-header bv elf)
396 (let ((byte-order (elf-byte-order elf)))
397 (write-elf-ident bv ELFCLASS64
398 (case byte-order
399 ((little) ELFDATA2LSB)
400 ((big) ELFDATA2MSB)
401 (else (error "unknown endianness" byte-order)))
402 (elf-abi elf))
403 (bytevector-u16-set! bv 16 (elf-type elf) byte-order)
404 (bytevector-u16-set! bv 18 (elf-machine-type elf) byte-order)
405 (bytevector-u32-set! bv 20 EV_CURRENT byte-order)
406 (bytevector-u64-set! bv 24 (elf-entry elf) byte-order)
407 (bytevector-u64-set! bv 32 (elf-phoff elf) byte-order)
408 (bytevector-u64-set! bv 40 (elf-shoff elf) byte-order)
409 (bytevector-u32-set! bv 48 (elf-flags elf) byte-order)
410 (bytevector-u16-set! bv 52 (elf-ehsize elf) byte-order)
411 (bytevector-u16-set! bv 54 (elf-phentsize elf) byte-order)
412 (bytevector-u16-set! bv 56 (elf-phnum elf) byte-order)
413 (bytevector-u16-set! bv 58 (elf-shentsize elf) byte-order)
414 (bytevector-u16-set! bv 60 (elf-shnum elf) byte-order)
415 (bytevector-u16-set! bv 62 (elf-shstrndx elf) byte-order)))
416
417(define (parse-elf bv)
418 (cond
419 ((has-elf-header? bv)
420 (let ((class (bytevector-u8-ref bv 4))
421 (byte-order (let ((data (bytevector-u8-ref bv 5)))
422 (cond
423 ((= data ELFDATA2LSB) (endianness little))
424 ((= data ELFDATA2MSB) (endianness big))
425 (else (error "unhandled byte order" data))))))
426 (cond
427 ((= class ELFCLASS32) (parse-elf32 bv byte-order))
428 ((= class ELFCLASS64) (parse-elf64 bv byte-order))
429 (else (error "unhandled class" class)))))
430 (else
431 (error "Invalid ELF" bv))))
432
433(define* (write-elf-header bv elf)
434 ((case (elf-word-size elf)
435 ((4) write-elf32-header)
436 ((8) write-elf64-header)
437 (else (error "unknown word size" (elf-word-size elf))))
438 bv elf))
439
440;;
441;; Segment types
442;;
443(define PT_NULL 0) ; Program header table entry unused
444(define PT_LOAD 1) ; Loadable program segment
445(define PT_DYNAMIC 2) ; Dynamic linking information
446(define PT_INTERP 3) ; Program interpreter
447(define PT_NOTE 4) ; Auxiliary information
448(define PT_SHLIB 5) ; Reserved
449(define PT_PHDR 6) ; Entry for header table itself
450(define PT_TLS 7) ; Thread-local storage segment
451(define PT_NUM 8) ; Number of defined types
452(define PT_LOOS #x60000000) ; Start of OS-specific
453(define PT_GNU_EH_FRAME #x6474e550) ; GCC .eh_frame_hdr segment
454(define PT_GNU_STACK #x6474e551) ; Indicates stack executability
455(define PT_GNU_RELRO #x6474e552) ; Read-only after relocation
456
457;;
458;; Segment flags
459;;
460(define PF_X (ash 1 0)) ; Segment is executable
461(define PF_W (ash 1 1)) ; Segment is writable
462(define PF_R (ash 1 2)) ; Segment is readable
463
464(define-record-type <elf-segment>
465 (make-elf-segment index type offset vaddr paddr filesz memsz flags align)
466 elf-segment?
467 (index elf-segment-index)
468 (type elf-segment-type)
469 (offset elf-segment-offset)
470 (vaddr elf-segment-vaddr)
471 (paddr elf-segment-paddr)
472 (filesz elf-segment-filesz)
473 (memsz elf-segment-memsz)
474 (flags elf-segment-flags)
475 (align elf-segment-align))
476
477(define* (make-elf-segment* #:key (index -1) (type PT_LOAD) (offset 0) (vaddr 0)
478 (paddr 0) (filesz 0) (memsz filesz)
479 (flags (logior PF_W PF_R))
480 (align 8))
481 (make-elf-segment index type offset vaddr paddr filesz memsz flags align))
482
483;; typedef struct {
484;; uint32_t p_type;
485;; Elf32_Off p_offset;
486;; Elf32_Addr p_vaddr;
487;; Elf32_Addr p_paddr;
488;; uint32_t p_filesz;
489;; uint32_t p_memsz;
490;; uint32_t p_flags;
491;; uint32_t p_align;
492;; } Elf32_Phdr;
493
494(define (parse-elf32-program-header index bv offset byte-order)
495 (if (<= (+ offset 32) (bytevector-length bv))
496 (make-elf-segment index
497 (bytevector-u32-ref bv offset byte-order)
498 (bytevector-u32-ref bv (+ offset 4) byte-order)
499 (bytevector-u32-ref bv (+ offset 8) byte-order)
500 (bytevector-u32-ref bv (+ offset 12) byte-order)
501 (bytevector-u32-ref bv (+ offset 16) byte-order)
502 (bytevector-u32-ref bv (+ offset 20) byte-order)
503 (bytevector-u32-ref bv (+ offset 24) byte-order)
504 (bytevector-u32-ref bv (+ offset 28) byte-order))
505 (error "corrupt ELF (offset out of range)" offset)))
506
507(define (write-elf32-program-header bv offset byte-order seg)
508 (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order)
509 (bytevector-u32-set! bv (+ offset 4) (elf-segment-offset seg) byte-order)
510 (bytevector-u32-set! bv (+ offset 8) (elf-segment-vaddr seg) byte-order)
511 (bytevector-u32-set! bv (+ offset 12) (elf-segment-paddr seg) byte-order)
512 (bytevector-u32-set! bv (+ offset 16) (elf-segment-filesz seg) byte-order)
513 (bytevector-u32-set! bv (+ offset 20) (elf-segment-memsz seg) byte-order)
514 (bytevector-u32-set! bv (+ offset 24) (elf-segment-flags seg) byte-order)
515 (bytevector-u32-set! bv (+ offset 28) (elf-segment-align seg) byte-order))
516
517
518;; typedef struct {
519;; uint32_t p_type;
520;; uint32_t p_flags;
521;; Elf64_Off p_offset;
522;; Elf64_Addr p_vaddr;
523;; Elf64_Addr p_paddr;
524;; uint64_t p_filesz;
525;; uint64_t p_memsz;
526;; uint64_t p_align;
527;; } Elf64_Phdr;
528
529;; NB: position of `flags' is different!
530
531(define (parse-elf64-program-header index bv offset byte-order)
532 (if (<= (+ offset 56) (bytevector-length bv))
533 (make-elf-segment index
534 (bytevector-u32-ref bv offset byte-order)
535 (bytevector-u64-ref bv (+ offset 8) byte-order)
536 (bytevector-u64-ref bv (+ offset 16) byte-order)
537 (bytevector-u64-ref bv (+ offset 24) byte-order)
538 (bytevector-u64-ref bv (+ offset 32) byte-order)
539 (bytevector-u64-ref bv (+ offset 40) byte-order)
540 (bytevector-u32-ref bv (+ offset 4) byte-order)
541 (bytevector-u64-ref bv (+ offset 48) byte-order))
542 (error "corrupt ELF (offset out of range)" offset)))
543
544(define (write-elf64-program-header bv offset byte-order seg)
545 (bytevector-u32-set! bv offset (elf-segment-type seg) byte-order)
546 (bytevector-u64-set! bv (+ offset 8) (elf-segment-offset seg) byte-order)
547 (bytevector-u64-set! bv (+ offset 16) (elf-segment-vaddr seg) byte-order)
548 (bytevector-u64-set! bv (+ offset 24) (elf-segment-paddr seg) byte-order)
549 (bytevector-u64-set! bv (+ offset 32) (elf-segment-filesz seg) byte-order)
550 (bytevector-u64-set! bv (+ offset 40) (elf-segment-memsz seg) byte-order)
551 (bytevector-u32-set! bv (+ offset 4) (elf-segment-flags seg) byte-order)
552 (bytevector-u64-set! bv (+ offset 48) (elf-segment-align seg) byte-order))
553
554(define (write-elf-program-header bv offset byte-order word-size seg)
555 ((case word-size
556 ((4) write-elf32-program-header)
557 ((8) write-elf64-program-header)
558 (else (error "invalid word size" word-size)))
559 bv offset byte-order seg))
560
561(define (elf-program-header-len word-size)
562 (case word-size
563 ((4) 32)
564 ((8) 56)
565 (else (error "bad word size" word-size))))
566
567(define (elf-segment elf n)
568 (if (not (< -1 n (elf-phnum elf)))
569 (error "bad segment number" n))
570 ((case (elf-word-size elf)
571 ((4) parse-elf32-program-header)
572 ((8) parse-elf64-program-header)
573 (else (error "unhandled pointer size")))
574 n
575 (elf-bytes elf)
576 (+ (elf-phoff elf) (* n (elf-phentsize elf)))
577 (elf-byte-order elf)))
578
579(define (elf-segments elf)
580 (let lp ((n (elf-phnum elf)) (out '()))
581 (if (zero? n)
582 out
583 (lp (1- n) (cons (elf-segment elf (1- n)) out)))))
584
585(define-record-type <elf-section>
586 (make-elf-section index name type flags
587 addr offset size link info addralign entsize)
588 elf-section?
589 (index elf-section-index)
590 (name elf-section-name)
591 (type elf-section-type)
592 (flags elf-section-flags)
593 (addr elf-section-addr)
594 (offset elf-section-offset)
595 (size elf-section-size)
596 (link elf-section-link)
597 (info elf-section-info)
598 (addralign elf-section-addralign)
599 (entsize elf-section-entsize))
600
601(define* (make-elf-section* #:key (index SHN_UNDEF) (name 0) (type SHT_PROGBITS)
602 (flags SHF_ALLOC) (addr 0) (offset 0) (size 0)
603 (link 0) (info 0) (addralign 8) (entsize 0))
604 (make-elf-section index name type flags addr offset size link info addralign
605 entsize))
606
607;; typedef struct {
608;; uint32_t sh_name;
609;; uint32_t sh_type;
610;; uint32_t sh_flags;
611;; Elf32_Addr sh_addr;
612;; Elf32_Off sh_offset;
613;; uint32_t sh_size;
614;; uint32_t sh_link;
615;; uint32_t sh_info;
616;; uint32_t sh_addralign;
617;; uint32_t sh_entsize;
618;; } Elf32_Shdr;
619
620(define (parse-elf32-section-header index bv offset byte-order)
621 (if (<= (+ offset 40) (bytevector-length bv))
622 (make-elf-section index
623 (bytevector-u32-ref bv offset byte-order)
624 (bytevector-u32-ref bv (+ offset 4) byte-order)
625 (bytevector-u32-ref bv (+ offset 8) byte-order)
626 (bytevector-u32-ref bv (+ offset 12) byte-order)
627 (bytevector-u32-ref bv (+ offset 16) byte-order)
628 (bytevector-u32-ref bv (+ offset 20) byte-order)
629 (bytevector-u32-ref bv (+ offset 24) byte-order)
630 (bytevector-u32-ref bv (+ offset 28) byte-order)
631 (bytevector-u32-ref bv (+ offset 32) byte-order)
632 (bytevector-u32-ref bv (+ offset 36) byte-order))
633 (error "corrupt ELF (offset out of range)" offset)))
634
635(define (write-elf32-section-header bv offset byte-order sec)
636 (bytevector-u32-set! bv offset (elf-section-name sec) byte-order)
637 (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order)
638 (bytevector-u32-set! bv (+ offset 8) (elf-section-flags sec) byte-order)
639 (bytevector-u32-set! bv (+ offset 12) (elf-section-addr sec) byte-order)
640 (bytevector-u32-set! bv (+ offset 16) (elf-section-offset sec) byte-order)
641 (bytevector-u32-set! bv (+ offset 20) (elf-section-size sec) byte-order)
642 (bytevector-u32-set! bv (+ offset 24) (elf-section-link sec) byte-order)
643 (bytevector-u32-set! bv (+ offset 28) (elf-section-info sec) byte-order)
644 (bytevector-u32-set! bv (+ offset 32) (elf-section-addralign sec) byte-order)
645 (bytevector-u32-set! bv (+ offset 36) (elf-section-entsize sec) byte-order))
646
647
648;; typedef struct {
649;; uint32_t sh_name;
650;; uint32_t sh_type;
651;; uint64_t sh_flags;
652;; Elf64_Addr sh_addr;
653;; Elf64_Off sh_offset;
654;; uint64_t sh_size;
655;; uint32_t sh_link;
656;; uint32_t sh_info;
657;; uint64_t sh_addralign;
658;; uint64_t sh_entsize;
659;; } Elf64_Shdr;
660
661(define (elf-section-header-len word-size)
662 (case word-size
663 ((4) 40)
664 ((8) 64)
665 (else (error "bad word size" word-size))))
666
667(define (elf-section-header-addr-offset word-size)
668 (case word-size
669 ((4) 12)
670 ((8) 16)
671 (else (error "bad word size" word-size))))
672
673(define (elf-section-header-offset-offset word-size)
674 (case word-size
675 ((4) 16)
676 ((8) 24)
677 (else (error "bad word size" word-size))))
678
679(define (parse-elf64-section-header index bv offset byte-order)
680 (if (<= (+ offset 64) (bytevector-length bv))
681 (make-elf-section index
682 (bytevector-u32-ref bv offset byte-order)
683 (bytevector-u32-ref bv (+ offset 4) byte-order)
684 (bytevector-u64-ref bv (+ offset 8) byte-order)
685 (bytevector-u64-ref bv (+ offset 16) byte-order)
686 (bytevector-u64-ref bv (+ offset 24) byte-order)
687 (bytevector-u64-ref bv (+ offset 32) byte-order)
688 (bytevector-u32-ref bv (+ offset 40) byte-order)
689 (bytevector-u32-ref bv (+ offset 44) byte-order)
690 (bytevector-u64-ref bv (+ offset 48) byte-order)
691 (bytevector-u64-ref bv (+ offset 56) byte-order))
692 (error "corrupt ELF (offset out of range)" offset)))
693
694(define (write-elf64-section-header bv offset byte-order sec)
695 (bytevector-u32-set! bv offset (elf-section-name sec) byte-order)
696 (bytevector-u32-set! bv (+ offset 4) (elf-section-type sec) byte-order)
697 (bytevector-u64-set! bv (+ offset 8) (elf-section-flags sec) byte-order)
698 (bytevector-u64-set! bv (+ offset 16) (elf-section-addr sec) byte-order)
699 (bytevector-u64-set! bv (+ offset 24) (elf-section-offset sec) byte-order)
700 (bytevector-u64-set! bv (+ offset 32) (elf-section-size sec) byte-order)
701 (bytevector-u32-set! bv (+ offset 40) (elf-section-link sec) byte-order)
702 (bytevector-u32-set! bv (+ offset 44) (elf-section-info sec) byte-order)
703 (bytevector-u64-set! bv (+ offset 48) (elf-section-addralign sec) byte-order)
704 (bytevector-u64-set! bv (+ offset 56) (elf-section-entsize sec) byte-order))
705
706(define (elf-section elf n)
707 (if (not (< -1 n (elf-shnum elf)))
708 (error "bad section number" n))
709 ((case (elf-word-size elf)
710 ((4) parse-elf32-section-header)
711 ((8) parse-elf64-section-header)
712 (else (error "unhandled pointer size")))
713 n
714 (elf-bytes elf)
715 (+ (elf-shoff elf) (* n (elf-shentsize elf)))
716 (elf-byte-order elf)))
717
718(define (write-elf-section-header bv offset byte-order word-size sec)
719 ((case word-size
720 ((4) write-elf32-section-header)
721 ((8) write-elf64-section-header)
722 (else (error "invalid word size" word-size)))
723 bv offset byte-order sec))
724
725(define (elf-sections elf)
726 (let lp ((n (elf-shnum elf)) (out '()))
727 (if (zero? n)
728 out
729 (lp (1- n) (cons (elf-section elf (1- n)) out)))))
730
731;;
732;; Section Types
733;;
734(define SHT_NULL 0) ; Section header table entry unused
735(define SHT_PROGBITS 1) ; Program data
736(define SHT_SYMTAB 2) ; Symbol table
737(define SHT_STRTAB 3) ; String table
738(define SHT_RELA 4) ; Relocation entries with addends
739(define SHT_HASH 5) ; Symbol hash table
740(define SHT_DYNAMIC 6) ; Dynamic linking information
741(define SHT_NOTE 7) ; Notes
742(define SHT_NOBITS 8) ; Program space with no data (bss)
743(define SHT_REL 9) ; Relocation entries, no addends
744(define SHT_SHLIB 10) ; Reserved
745(define SHT_DYNSYM 11) ; Dynamic linker symbol table
746(define SHT_INIT_ARRAY 14) ; Array of constructors
747(define SHT_FINI_ARRAY 15) ; Array of destructors
748(define SHT_PREINIT_ARRAY 16) ; Array of pre-constructors
749(define SHT_GROUP 17) ; Section group
750(define SHT_SYMTAB_SHNDX 18) ; Extended section indeces
751(define SHT_NUM 19) ; Number of defined types.
752(define SHT_LOOS #x60000000) ; Start OS-specific.
753(define SHT_HIOS #x6fffffff) ; End OS-specific type
754(define SHT_LOPROC #x70000000) ; Start of processor-specific
755(define SHT_HIPROC #x7fffffff) ; End of processor-specific
756(define SHT_LOUSER #x80000000) ; Start of application-specific
757(define SHT_HIUSER #x8fffffff) ; End of application-specific
758
759;;
760;; Section Flags
761;;
762(define SHF_WRITE (ash 1 0)) ; Writable
763(define SHF_ALLOC (ash 1 1)) ; Occupies memory during execution
764(define SHF_EXECINSTR (ash 1 2)) ; Executable
765(define SHF_MERGE (ash 1 4)) ; Might be merged
766(define SHF_STRINGS (ash 1 5)) ; Contains nul-terminated strings
767(define SHF_INFO_LINK (ash 1 6)) ; `sh_info' contains SHT index
768(define SHF_LINK_ORDER (ash 1 7)) ; Preserve order after combining
769(define SHF_OS_NONCONFORMING (ash 1 8)) ; Non-standard OS specific handling required
770(define SHF_GROUP (ash 1 9)) ; Section is member of a group.
771(define SHF_TLS (ash 1 10)) ; Section hold thread-local data.
772
773;;
774;; Dynamic entry types. The DT_GUILE types are non-standard.
775;;
776(define DT_NULL 0) ; Marks end of dynamic section
777(define DT_NEEDED 1) ; Name of needed library
778(define DT_PLTRELSZ 2) ; Size in bytes of PLT relocs
779(define DT_PLTGOT 3) ; Processor defined value
780(define DT_HASH 4) ; Address of symbol hash table
781(define DT_STRTAB 5) ; Address of string table
782(define DT_SYMTAB 6) ; Address of symbol table
783(define DT_RELA 7) ; Address of Rela relocs
784(define DT_RELASZ 8) ; Total size of Rela relocs
785(define DT_RELAENT 9) ; Size of one Rela reloc
786(define DT_STRSZ 10) ; Size of string table
787(define DT_SYMENT 11) ; Size of one symbol table entry
788(define DT_INIT 12) ; Address of init function
789(define DT_FINI 13) ; Address of termination function
790(define DT_SONAME 14) ; Name of shared object
791(define DT_RPATH 15) ; Library search path (deprecated)
792(define DT_SYMBOLIC 16) ; Start symbol search here
793(define DT_REL 17) ; Address of Rel relocs
794(define DT_RELSZ 18) ; Total size of Rel relocs
795(define DT_RELENT 19) ; Size of one Rel reloc
796(define DT_PLTREL 20) ; Type of reloc in PLT
797(define DT_DEBUG 21) ; For debugging ; unspecified
798(define DT_TEXTREL 22) ; Reloc might modify .text
799(define DT_JMPREL 23) ; Address of PLT relocs
800(define DT_BIND_NOW 24) ; Process relocations of object
801(define DT_INIT_ARRAY 25) ; Array with addresses of init fct
802(define DT_FINI_ARRAY 26) ; Array with addresses of fini fct
803(define DT_INIT_ARRAYSZ 27) ; Size in bytes of DT_INIT_ARRAY
804(define DT_FINI_ARRAYSZ 28) ; Size in bytes of DT_FINI_ARRAY
805(define DT_RUNPATH 29) ; Library search path
806(define DT_FLAGS 30) ; Flags for the object being loaded
807(define DT_ENCODING 32) ; Start of encoded range
808(define DT_PREINIT_ARRAY 32) ; Array with addresses of preinit fc
809(define DT_PREINIT_ARRAYSZ 33) ; size in bytes of DT_PREINIT_ARRAY
810(define DT_NUM 34) ; Number used
811(define DT_LOGUILE #x37146000) ; Start of Guile-specific
812(define DT_GUILE_GC_ROOT #x37146000) ; Offset of GC roots
813(define DT_GUILE_GC_ROOT_SZ #x37146001) ; Size in machine words of GC roots
814(define DT_GUILE_ENTRY #x37146002) ; Address of entry thunk
815(define DT_GUILE_VM_VERSION #x37146003) ; Bytecode version
816(define DT_GUILE_FRAME_MAPS #x37146004) ; Offset of .guile.frame-maps
817(define DT_HIGUILE #x37146fff) ; End of Guile-specific
818(define DT_LOOS #x6000000d) ; Start of OS-specific
819(define DT_HIOS #x6ffff000) ; End of OS-specific
820(define DT_LOPROC #x70000000) ; Start of processor-specific
821(define DT_HIPROC #x7fffffff) ; End of processor-specific
822
823
824(define (string-table-ref bv offset)
825 (let lp ((end offset))
826 (if (zero? (bytevector-u8-ref bv end))
827 (let ((out (make-bytevector (- end offset))))
828 (bytevector-copy! bv offset out 0 (- end offset))
829 (utf8->string out))
830 (lp (1+ end)))))
831
832(define (elf-section-by-name elf name)
833 (let ((off (elf-section-offset (elf-section elf (elf-shstrndx elf)))))
834 (let lp ((n (elf-shnum elf)))
835 (and (> n 0)
836 (let ((section (elf-section elf (1- n))))
837 (if (equal? (string-table-ref (elf-bytes elf)
838 (+ off (elf-section-name section)))
839 name)
840 section
841 (lp (1- n))))))))
842
843(define (elf-sections-by-name elf)
844 (let* ((sections (elf-sections elf))
845 (off (elf-section-offset (list-ref sections (elf-shstrndx elf)))))
846 (map (lambda (section)
847 (cons (string-table-ref (elf-bytes elf)
848 (+ off (elf-section-name section)))
849 section))
850 sections)))
851
852(define-record-type <elf-symbol>
853 (make-elf-symbol name value size info other shndx)
854 elf-symbol?
855 (name elf-symbol-name)
856 (value elf-symbol-value)
857 (size elf-symbol-size)
858 (info elf-symbol-info)
859 (other elf-symbol-other)
860 (shndx elf-symbol-shndx))
861
862(define* (make-elf-symbol* #:key (name 0) (value 0) (size 0)
863 (binding STB_LOCAL) (type STT_NOTYPE)
864 (info (logior (ash binding 4) type))
865 (visibility STV_DEFAULT) (other visibility)
866 (shndx SHN_UNDEF))
867 (make-elf-symbol name value size info other shndx))
868
869;; typedef struct {
870;; uint32_t st_name;
871;; Elf32_Addr st_value;
872;; uint32_t st_size;
873;; unsigned char st_info;
874;; unsigned char st_other;
875;; uint16_t st_shndx;
876;; } Elf32_Sym;
877
878(define (elf-symbol-len word-size)
879 (case word-size
880 ((4) 16)
881 ((8) 24)
882 (else (error "bad word size" word-size))))
883
884(define (elf-symbol-value-offset word-size)
885 (case word-size
886 ((4) 4)
887 ((8) 8)
888 (else (error "bad word size" word-size))))
889
890(define (parse-elf32-symbol bv offset stroff byte-order)
891 (if (<= (+ offset 16) (bytevector-length bv))
892 (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order)))
893 (if stroff
894 (string-table-ref bv (+ stroff name))
895 name))
896 (bytevector-u32-ref bv (+ offset 4) byte-order)
897 (bytevector-u32-ref bv (+ offset 8) byte-order)
898 (bytevector-u8-ref bv (+ offset 12))
899 (bytevector-u8-ref bv (+ offset 13))
900 (bytevector-u16-ref bv (+ offset 14) byte-order))
901 (error "corrupt ELF (offset out of range)" offset)))
902
903(define (write-elf32-symbol bv offset byte-order sym)
904 (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order)
905 (bytevector-u32-set! bv (+ offset 4) (elf-symbol-value sym) byte-order)
906 (bytevector-u32-set! bv (+ offset 8) (elf-symbol-size sym) byte-order)
907 (bytevector-u8-set! bv (+ offset 12) (elf-symbol-info sym))
908 (bytevector-u8-set! bv (+ offset 13) (elf-symbol-other sym))
909 (bytevector-u16-set! bv (+ offset 14) (elf-symbol-shndx sym) byte-order))
910
911;; typedef struct {
912;; uint32_t st_name;
913;; unsigned char st_info;
914;; unsigned char st_other;
915;; uint16_t st_shndx;
916;; Elf64_Addr st_value;
917;; uint64_t st_size;
918;; } Elf64_Sym;
919
920(define (parse-elf64-symbol bv offset stroff byte-order)
921 (if (<= (+ offset 24) (bytevector-length bv))
922 (make-elf-symbol (let ((name (bytevector-u32-ref bv offset byte-order)))
923 (if stroff
924 (string-table-ref bv (+ stroff name))
925 name))
926 (bytevector-u64-ref bv (+ offset 8) byte-order)
927 (bytevector-u64-ref bv (+ offset 16) byte-order)
928 (bytevector-u8-ref bv (+ offset 4))
929 (bytevector-u8-ref bv (+ offset 5))
930 (bytevector-u16-ref bv (+ offset 6) byte-order))
931 (error "corrupt ELF (offset out of range)" offset)))
932
933(define (write-elf64-symbol bv offset byte-order sym)
934 (bytevector-u32-set! bv offset (elf-symbol-name sym) byte-order)
935 (bytevector-u8-set! bv (+ offset 4) (elf-symbol-info sym))
936 (bytevector-u8-set! bv (+ offset 5) (elf-symbol-other sym))
937 (bytevector-u16-set! bv (+ offset 6) (elf-symbol-shndx sym) byte-order)
938 (bytevector-u64-set! bv (+ offset 8) (elf-symbol-value sym) byte-order)
939 (bytevector-u64-set! bv (+ offset 16) (elf-symbol-size sym) byte-order))
940
941(define (write-elf-symbol bv offset byte-order word-size sym)
942 ((case word-size
943 ((4) write-elf32-symbol)
944 ((8) write-elf64-symbol)
945 (else (error "invalid word size" word-size)))
946 bv offset byte-order sym))
947
948(define (elf-symbol-table-len section)
949 (let ((len (elf-section-size section))
950 (entsize (elf-section-entsize section)))
951 (unless (and (not (zero? entsize)) (zero? (modulo len entsize)))
952 (error "bad symbol table" section))
953 (/ len entsize)))
954
955(define* (elf-symbol-table-ref elf section n #:optional strtab)
956 (let ((bv (elf-bytes elf))
957 (byte-order (elf-byte-order elf))
958 (stroff (and strtab (elf-section-offset strtab)))
959 (base (elf-section-offset section))
960 (len (elf-section-size section))
961 (entsize (elf-section-entsize section)))
962 (unless (<= (* (1+ n) entsize) len)
963 (error "out of range symbol table access" section n))
964 (case (elf-word-size elf)
965 ((4)
966 (unless (<= 16 entsize)
967 (error "bad entsize for symbol table" section))
968 (parse-elf32-symbol bv (+ base (* n entsize)) stroff byte-order))
969 ((8)
970 (unless (<= 24 entsize)
971 (error "bad entsize for symbol table" section))
972 (parse-elf64-symbol bv (+ base (* n entsize)) stroff byte-order))
973 (else (error "bad word size" elf)))))
974
975;; Legal values for ST_BIND subfield of st_info (symbol binding).
976
977(define STB_LOCAL 0) ; Local symbol
978(define STB_GLOBAL 1) ; Global symbol
979(define STB_WEAK 2) ; Weak symbol
980(define STB_NUM 3) ; Number of defined types.
981(define STB_LOOS 10) ; Start of OS-specific
982(define STB_GNU_UNIQUE 10) ; Unique symbol.
983(define STB_HIOS 12) ; End of OS-specific
984(define STB_LOPROC 13) ; Start of processor-specific
985(define STB_HIPROC 15) ; End of processor-specific
986
987;; Legal values for ST_TYPE subfield of st_info (symbol type).
988
989(define STT_NOTYPE 0) ; Symbol type is unspecified
990(define STT_OBJECT 1) ; Symbol is a data object
991(define STT_FUNC 2) ; Symbol is a code object
992(define STT_SECTION 3) ; Symbol associated with a section
993(define STT_FILE 4) ; Symbol's name is file name
994(define STT_COMMON 5) ; Symbol is a common data object
995(define STT_TLS 6) ; Symbol is thread-local data objec
996(define STT_NUM 7) ; Number of defined types.
997(define STT_LOOS 10) ; Start of OS-specific
998(define STT_GNU_IFUNC 10) ; Symbol is indirect code object
999(define STT_HIOS 12) ; End of OS-specific
1000(define STT_LOPROC 13) ; Start of processor-specific
1001(define STT_HIPROC 15) ; End of processor-specific
1002
1003;; Symbol visibility specification encoded in the st_other field.
1004
1005(define STV_DEFAULT 0) ; Default symbol visibility rules
1006(define STV_INTERNAL 1) ; Processor specific hidden class
1007(define STV_HIDDEN 2) ; Sym unavailable in other modules
1008(define STV_PROTECTED 3) ; Not preemptible, not exported
1009
1010(define (elf-symbol-binding sym)
1011 (ash (elf-symbol-info sym) -4))
1012
1013(define (elf-symbol-type sym)
1014 (logand (elf-symbol-info sym) #xf))
1015
1016(define (elf-symbol-visibility sym)
1017 (logand (elf-symbol-other sym) #x3))
1018
1019(define NT_GNU_ABI_TAG 1)
1020(define NT_GNU_HWCAP 2)
1021(define NT_GNU_BUILD_ID 3)
1022(define NT_GNU_GOLD_VERSION 4)
1023
1024(define-record-type <elf-note>
1025 (make-elf-note name desc type)
1026 elf-note?
1027 (name elf-note-name)
1028 (desc elf-note-desc)
1029 (type elf-note-type))
1030
1031(define (parse-elf-note elf section)
1032 (let ((bv (elf-bytes elf))
1033 (byte-order (elf-byte-order elf))
1034 (offset (elf-section-offset section)))
1035 (unless (<= (+ offset 12) (bytevector-length bv))
1036 (error "corrupt ELF (offset out of range)" offset))
1037 (let ((namesz (bytevector-u32-ref bv offset byte-order))
1038 (descsz (bytevector-u32-ref bv (+ offset 4) byte-order))
1039 (type (bytevector-u32-ref bv (+ offset 8) byte-order)))
1040 (unless (<= (+ offset 12 namesz descsz) (bytevector-length bv))
1041 (error "corrupt ELF (offset out of range)" offset))
1042 (let ((name (make-bytevector (1- namesz)))
1043 (desc (make-bytevector descsz)))
1044 (bytevector-copy! bv (+ offset 12) name 0 (1- namesz))
1045 (bytevector-copy! bv (+ offset 12 namesz) desc 0 descsz)
1046 (make-elf-note (utf8->string name) desc type)))))
diff --git a/guix/grafts.scm b/guix/grafts.scm
index b3abbca25fc..77297fe07e4 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -118,12 +118,12 @@ are not recursively applied to dependencies of DRV."
118 (define build 118 (define build
119 (with-imported-modules '((guix build graft) 119 (with-imported-modules '((guix build graft)
120 (guix build utils) 120 (guix build utils)
121 (guix build debug-link)) 121 (guix build debug-link)
122 (guix elf))
122 #~(begin 123 #~(begin
123 (use-modules (guix build graft) 124 (use-modules (guix build graft)
124 (guix build utils) 125 (guix build utils)
125 (ice-9 match) 126 (ice-9 match))
126 (system vm elf))
127 127
128 (define %outputs 128 (define %outputs
129 (ungexp (outputs->gexp outputs))) 129 (ungexp (outputs->gexp outputs)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index f738be2ddd2..432e846bf4f 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1224,19 +1224,20 @@ libfakechroot.so and related ld.so machinery as a fallback."
1224 '((guix build io) 1224 '((guix build io)
1225 (guix build utils) 1225 (guix build utils)
1226 (guix build union) 1226 (guix build union)
1227 (guix build gremlin))) 1227 (guix build gremlin)
1228 (guix elf)))
1228 #~(begin 1229 #~(begin
1229 (use-modules (guix build io) 1230 (use-modules (guix build io)
1230 (guix build utils) 1231 (guix build utils)
1231 ((guix build union) #:select (symlink-relative)) 1232 ((guix build union) #:select (symlink-relative))
1233 (guix elf)
1232 (guix build gremlin) 1234 (guix build gremlin)
1233 (ice-9 binary-ports) 1235 (ice-9 binary-ports)
1234 (ice-9 ftw) 1236 (ice-9 ftw)
1235 (ice-9 match) 1237 (ice-9 match)
1236 (ice-9 receive) 1238 (ice-9 receive)
1237 (srfi srfi-1) 1239 (srfi srfi-1)
1238 (rnrs bytevectors) 1240 (rnrs bytevectors))
1239 (system vm elf))
1240 1241
1241 (define input 1242 (define input
1242 ;; The OUTPUT* output of PACKAGE. 1243 ;; The OUTPUT* output of PACKAGE.
diff --git a/tests/debug-link.scm b/tests/debug-link.scm
index 1ba40cdd4fc..7ccc054a5d9 100644
--- a/tests/debug-link.scm
+++ b/tests/debug-link.scm
@@ -18,6 +18,7 @@
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 19
20(define-module (test-debug-link) 20(define-module (test-debug-link)
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)
23 #:use-module (guix build io) 24 #:use-module (guix build io)
@@ -32,7 +33,6 @@
32 #:use-module (srfi srfi-1) 33 #:use-module (srfi srfi-1)
33 #:use-module (srfi srfi-26) 34 #:use-module (srfi srfi-26)
34 #:use-module (srfi srfi-64) 35 #:use-module (srfi srfi-64)
35 #:use-module (system vm elf)
36 #:use-module (rnrs io ports) 36 #:use-module (rnrs io ports)
37 #:use-module (ice-9 match)) 37 #:use-module (ice-9 match))
38 38
@@ -69,12 +69,13 @@
69 (exp (with-imported-modules (source-module-closure 69 (exp (with-imported-modules (source-module-closure
70 '((guix build io) 70 '((guix build io)
71 (guix build utils) 71 (guix build utils)
72 (guix build debug-link))) 72 (guix build debug-link)
73 (guix elf)))
73 #~(begin 74 #~(begin
74 (use-modules (guix build io) 75 (use-modules (guix build io)
75 (guix build utils) 76 (guix build utils)
76 (guix build debug-link) 77 (guix build debug-link)
77 (system vm elf) 78 (guix elf)
78 (rnrs io ports)) 79 (rnrs io ports))
79 80
80 (define read-elf 81 (define read-elf
@@ -114,12 +115,13 @@
114 (exp (with-imported-modules (source-module-closure 115 (exp (with-imported-modules (source-module-closure
115 '((guix build io) 116 '((guix build io)
116 (guix build utils) 117 (guix build utils)
117 (guix build debug-link))) 118 (guix build debug-link)
119 (guix elf)))
118 #~(begin 120 #~(begin
119 (use-modules (guix build io) 121 (use-modules (guix build io)
120 (guix build utils) 122 (guix build utils)
121 (guix build debug-link) 123 (guix build debug-link)
122 (system vm elf) 124 (guix elf)
123 (rnrs io ports)) 125 (rnrs io ports))
124 126
125 (define read-elf 127 (define read-elf
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index 34cab5e5675..44237e2ad37 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -19,6 +19,7 @@
19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 20
21(define-module (test-gremlin) 21(define-module (test-gremlin)
22 #:use-module (guix elf)
22 #:use-module (guix tests) 23 #:use-module (guix tests)
23 #:use-module ((guix utils) #:select (call-with-temporary-directory 24 #:use-module ((guix utils) #:select (call-with-temporary-directory
24 target-aarch64?)) 25 target-aarch64?))
@@ -30,7 +31,6 @@
30 #:use-module (srfi srfi-26) 31 #:use-module (srfi srfi-26)
31 #:use-module (srfi srfi-34) 32 #:use-module (srfi srfi-34)
32 #:use-module (srfi srfi-64) 33 #:use-module (srfi srfi-64)
33 #:use-module (system vm elf)
34 #:use-module (rnrs io ports) 34 #:use-module (rnrs io ports)
35 #:use-module (ice-9 popen) 35 #:use-module (ice-9 popen)
36 #:use-module (ice-9 rdelim) 36 #:use-module (ice-9 rdelim)
generated by cgit v1.2.3 (git 2.25.1) at 2026-09-03 09:27:20 +0000