1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
module Bstr = Cachet.Bstr
exception Elf_error
type section = {
sh_offset : int;
sh_size : int;
sh_name_off : int;
sh_name : string;
}
let section_manifest = ".note.solo5.manifest"
let section_abi = ".note.solo5.abi"
let note_name = "Solo5"
let typ_mft1 = 0x3154464d
let typ_abi1 = 0x31494241
let get_uint16 = function
| `LE -> Cachet.get_uint16_le
| `BE -> Cachet.get_uint16_be
let get_uint32 en s off =
let get = match en with
| `LE -> Cachet.get_int32_le
| `BE -> Cachet.get_int32_be
in
Int32.to_int (get s off) land 0xFFFF_FFFF
let get_uint64 en s off =
let get = match en with
| `LE -> Cachet.get_int64_le
| `BE -> Cachet.get_int64_be
in
match Int64.unsigned_to_int (get s off) with
| None -> raise Elf_error
| Some n -> n
let c_string seq maxlen =
let res = Buffer.create maxlen in
let rec scan i = function
| Seq.Nil -> raise Elf_error
| Seq.Cons (s, seq) ->
match String.index_opt s '\000' with
| None ->
let i = i + String.length s in
if i >= maxlen then
raise Elf_error;
Buffer.add_string res s;
scan i (seq ())
| Some l ->
let i = i + l in
if i >= maxlen then
raise Elf_error;
Buffer.add_substring res s 0 l;
Buffer.contents res
in
scan 0 (seq ())
let read_magic c =
if not (Cachet.get_uint8 c 0 = 0x7f &&
String.equal (Cachet.get_string c ~len:3 1) "ELF")
then raise Elf_error
let elfclass64 = 2
let read_identification c =
let elf_class = Cachet.get_uint8 c 4 in
let elf_data = Cachet.get_uint8 c 5 in
let _elf_version = Cachet.get_uint8 c 6 in
let _elf_osabi = Cachet.get_uint8 c 7 in
let _elf_abiversion = Cachet.get_uint8 c 8 in
for i = 9 to 15 do
if Cachet.get_uint8 c i <> 0 then
raise Elf_error
done;
if elf_class <> elfclass64 then
raise Elf_error;
let endianness =
match elf_data with
| 1 -> `LE
| 2 -> `BE
| _ -> raise Elf_error
in
endianness
let en c =
let e_shoff = get_uint32 en c 0x28 in
let e_shentsize = get_uint16 en c 0x3a in
let e_shnum = get_uint16 en c 0x3c in
let e_shstrndx = get_uint16 en c 0x3e in
if Sys.int_size <= 32 then
raise Elf_error;
{ e_shoff; e_shentsize; e_shnum; e_shstrndx }
let read_section en c hdr i =
let off = hdr.e_shoff + i * hdr.e_shentsize in
let sh_name_off = get_uint32 en c off in
let sh_offset = get_uint64 en c (off + 24) in
let sh_size = get_uint64 en c (off + 32) in
{ sh_name_off; sh_offset; sh_size; sh_name = "" }
let read_section_name shstrndx c section =
let off = shstrndx.sh_offset + section.sh_name_off in
c_string (Cachet.get_seq c off) (shstrndx.sh_size - section.sh_name_off)
let read_sections en c hdr =
let sections = Array.init hdr.e_shnum (read_section en c hdr) in
let shstrndx = sections.(hdr.e_shstrndx) in
Array.map
(fun section -> { section with sh_name = read_section_name shstrndx c section })
sections
let find_section sections name =
Array.find_opt
(fun section -> String.equal section.sh_name name)
sections
let desc en c section ~expected_owner ~expected_type =
let off = section.sh_offset in
if section.sh_size < 12 then
raise Elf_error;
let namesz = get_uint32 en c off
and descsz = get_uint32 en c (off + 4)
and typ = get_uint32 en c (off + 8) in
if typ <> expected_type ||
String.length expected_owner + 1 <> namesz ||
not (String.equal
(expected_owner ^ "\000")
(Cachet.get_string c (off+12) ~len:namesz))
then
None
else
let off = off + 12 + namesz in
let off = off + ((4 - (off land 3)) land 3) in
Some (Cachet.get_string c off ~len:descsz)
let find c section_name typ =
let () = read_magic c in
let en = read_identification c in
let hdr = read_header en c in
let sections = read_sections en c hdr in
match find_section sections section_name with
| None -> None
| Some section ->
desc en c section ~expected_owner:note_name ~expected_type:typ