robur/ocaml-solo5-elftool
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Switch to cachet

Browse source
This commit is contained in:
Reynir Björnsson 2025-01-30 12:39:39 +01:00
parent 0a04cc0bcc
commit 7bef25f19f
6 changed files with 90 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
bin/dune
View file

@ -1,4 +1,4 @@
(executable (executable
(public_name osolo5-elftool) (public_name osolo5-elftool)
(name main) (name main)
(libraries solo5-elftool owee cstruct cmdliner)) (libraries solo5-elftool owee cachet cmdliner))

27
bin/main.ml
View file

@ -1,19 +1,18 @@
let read_binary file = let map_binary file =
let ic = open_in_bin file in let fd = Unix.openfile file [Unix.O_RDONLY; Unix.O_CLOEXEC] 0 in
let res = Buffer.create 16384 in let stat = Unix.fstat fd in
let buf = Bytes.create 16384 in let map () ~pos len =
let rec loop () = let len = Int.min (stat.Unix.st_size - pos) len in
let len = input ic buf 0 16384 in let pos = Int64.of_int pos in
if len > 0 then let barr =
let () = Buffer.add_subbytes res buf 0 len in Unix.map_file fd ~pos Bigarray.char Bigarray.c_layout false [| len |]
loop () in
Bigarray.array1_of_genarray barr
in in
loop (); Cachet.make ~map ()
close_in_noerr ic;
Buffer.contents res
let query_manifest file = let query_manifest file =
read_binary file map_binary file
|> Solo5_elftool.query_manifest |> Solo5_elftool.query_manifest
|> Result.fold |> Result.fold
~ok:(fun mft -> ~ok:(fun mft ->
@ -22,7 +21,7 @@ let query_manifest file =
Fmt.epr "%s\n" e) Fmt.epr "%s\n" e)
let query_abi file = let query_abi file =
read_binary file map_binary file
|> Solo5_elftool.query_abi |> Solo5_elftool.query_abi
|> Result.fold |> Result.fold
~ok:(fun abi -> Fmt.pr "%a\n" Solo5_elftool.pp_abi abi) ~ok:(fun abi -> Fmt.pr "%a\n" Solo5_elftool.pp_abi abi)

2
lib/dune
View file

@ -1,4 +1,4 @@
(library (library
(public_name solo5-elftool) (public_name solo5-elftool)
(name solo5_elftool) (name solo5_elftool)
(libraries owee cstruct fmt)) (libraries owee cstruct cachet fmt))

148
lib/elf.ml
View file

@ -1,3 +1,5 @@
module Bstr = Cachet.Bstr
exception Elf_error exception Elf_error
(* only the bits we care about *) (* only the bits we care about *)
@ -22,60 +24,61 @@ let typ_mft1 = 0x3154464d
let typ_abi1 = 0x31494241 let typ_abi1 = 0x31494241
let get_uint16 = function let get_uint16 = function
| `LE -> String.get_uint16_le | `LE -> Cachet.get_uint16_le
| `BE -> String.get_uint16_be | `BE -> Cachet.get_uint16_be
let get_uint32 en s off = let get_uint32 en s off =
let get = match en with let get = match en with
| `LE -> String.get_int32_le | `LE -> Cachet.get_int32_le
| `BE -> String.get_int32_be | `BE -> Cachet.get_int32_be
in in
Int32.to_int (get s off) land 0xFFFF_FFFF Int32.to_int (get s off) land 0xFFFF_FFFF
let get_uint64 en s off = let get_uint64 en s off =
let get = match en with let get = match en with
| `LE -> String.get_int64_le | `LE -> Cachet.get_int64_le
| `BE -> String.get_int64_be | `BE -> Cachet.get_int64_be
in in
match Int64.unsigned_to_int (get s off) with match Int64.unsigned_to_int (get s off) with
| None -> raise Elf_error | None -> raise Elf_error
| Some n -> n | Some n -> n
let c_string s off maxlen = let c_string seq maxlen =
let rec scan_c_string i = let res = Buffer.create maxlen in
if String.length s < off + i || i = maxlen then let rec scan i = function
raise Elf_error | Seq.Nil -> raise Elf_error
else if s.[i+off] = '\000' then | Seq.Cons (s, seq) ->
i match String.index_opt s '\000' with
else | None ->
scan_c_string (succ i) 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 in
String.sub s off (scan_c_string 0) scan 0 (seq ())
let read_magic s off = let read_magic c =
if String.length s < off + 4 then if not (Cachet.get_uint8 c 0 = 0x7f &&
raise Elf_error; String.equal (Cachet.get_string c ~len:3 1) "ELF")
let valid = then raise Elf_error
String.get_uint8 s off = 0x7f &&
s.[off+1] = 'E' && s.[off+2] = 'L' && s.[off+3] = 'F'
in
if not valid then
raise Elf_error;
off+4
let elfclass64 = 2 let elfclass64 = 2
let read_identification s off = let read_identification c =
if String.length s < off + 12 then let elf_class = Cachet.get_uint8 c 4 in
raise Elf_error; let elf_data = Cachet.get_uint8 c 5 in
let elf_class = String.get_uint8 s off in let _elf_version = Cachet.get_uint8 c 6 in
let elf_data = String.get_uint8 s (off+1) in let _elf_osabi = Cachet.get_uint8 c 7 in
let _elf_version = String.get_uint8 s (off+2) in let _elf_abiversion = Cachet.get_uint8 c 8 in
let _elf_osabi = String.get_uint8 s (off+3) in for i = 9 to 15 do
let _elf_abiversion = String.get_uint8 s (off+4) in if Cachet.get_uint8 c i <> 0 then
(* Check padding *)
for i = off + 5 to off+11 do
if s.[i] <> '\000' then
raise Elf_error raise Elf_error
done; done;
(* we only support ELFCLASS64 *) (* we only support ELFCLASS64 *)
@ -87,39 +90,33 @@ let read_identification s off =
| 2 -> `BE | 2 -> `BE
| _ -> raise Elf_error | _ -> raise Elf_error
in in
endianness, off+12 endianness
let read_header en s = let read_header en c =
if String.length s < 16 + 48 then let e_shoff = get_uint32 en c 0x28 in
raise Elf_error; let e_shentsize = get_uint16 en c 0x3a in
let e_shoff = get_uint32 en s 0x28 in let e_shnum = get_uint16 en c 0x3c in
let e_shentsize = get_uint16 en s 0x3a in let e_shstrndx = get_uint16 en c 0x3e in
let e_shnum = get_uint16 en s 0x3c in
let e_shstrndx = get_uint16 en s 0x3e in
if Sys.int_size <= 32 then if Sys.int_size <= 32 then
raise Elf_error; raise Elf_error;
{ e_shoff; e_shentsize; e_shnum; e_shstrndx } { e_shoff; e_shentsize; e_shnum; e_shstrndx }
let read_section en s hdr i = let read_section en c hdr i =
let off = hdr.e_shoff + i * hdr.e_shentsize in let off = hdr.e_shoff + i * hdr.e_shentsize in
if String.length s < off + 64 then let sh_name_off = get_uint32 en c off in
raise Elf_error; let sh_offset = get_uint64 en c (off + 24) in
let sh_name_off = get_uint32 en s off in let sh_size = get_uint64 en c (off + 32) in
let sh_offset = get_uint64 en s (off + 24) in
let sh_size = get_uint64 en s (off + 32) in
{ sh_name_off; sh_offset; sh_size; sh_name = "" } { sh_name_off; sh_offset; sh_size; sh_name = "" }
let read_section_name shstrndx s section = let read_section_name shstrndx c section =
let off = shstrndx.sh_offset + section.sh_name_off in let off = shstrndx.sh_offset + section.sh_name_off in
if String.length s < off + 1 then c_string (Cachet.get_seq c off) (shstrndx.sh_size - section.sh_name_off)
raise Elf_error;
c_string s off (shstrndx.sh_size - section.sh_name_off)
let read_sections en s hdr = let read_sections en c hdr =
let sections = Array.init hdr.e_shnum (read_section en s hdr) in let sections = Array.init hdr.e_shnum (read_section en c hdr) in
let shstrndx = sections.(hdr.e_shstrndx) in let shstrndx = sections.(hdr.e_shstrndx) in
Array.map Array.map
(fun section -> { section with sh_name = read_section_name shstrndx s section }) (fun section -> { section with sh_name = read_section_name shstrndx c section })
sections sections
let find_section sections name = let find_section sections name =
@ -127,39 +124,32 @@ let find_section sections name =
(fun section -> String.equal section.sh_name name) (fun section -> String.equal section.sh_name name)
sections sections
let section_body s section = let desc en c section ~expected_owner ~expected_type =
if section.sh_offset < 0 || String.length s < section.sh_offset + section.sh_size then let off = section.sh_offset in
raise Elf_error; if section.sh_size < 12 then
String.sub s section.sh_offset section.sh_size
let desc en section_body ~expected_owner ~expected_type =
if String.length section_body < 12 then
raise Elf_error;
let namesz = get_uint32 en section_body 0 in
let descsz = get_uint32 en section_body 4
and typ = get_uint32 en section_body 8 in
if String.length section_body < 12 + namesz + descsz then
raise Elf_error; 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 || if typ <> expected_type ||
String.length expected_owner + 1 <> namesz || String.length expected_owner + 1 <> namesz ||
not (String.equal not (String.equal
(expected_owner ^ "\000") (expected_owner ^ "\000")
(String.sub section_body 12 namesz)) (Cachet.get_string c (off+12) ~len:namesz))
then then
None None
else else
let off = 12 + namesz in let off = off + 12 + namesz in
(* padding *) (* padding *)
let off = off + ((4 - (off land 3)) land 3) in let off = off + ((4 - (off land 3)) land 3) in
Some (String.sub section_body off descsz) Some (Cachet.get_string c off ~len:descsz)
let find s section_name typ = let find c section_name typ =
let off = read_magic s 0 in let () = read_magic c in
let en, _off = read_identification s off in let en = read_identification c in
let hdr = read_header en s in let hdr = read_header en c in
let sections = read_sections en s hdr in let sections = read_sections en c hdr in
match find_section sections section_name with match find_section sections section_name with
| None -> None | None -> None
| Some section -> | Some section ->
let body = section_body s section in desc en c section ~expected_owner:note_name ~expected_type:typ
desc en body ~expected_owner:note_name ~expected_type:typ

8
lib/solo5_elftool.ml
View file

@ -160,14 +160,14 @@ let parse_abi buf =
(* XXX: should we check version = 1l ? *) (* XXX: should we check version = 1l ? *)
Ok { target; version } Ok { target; version }
let query_manifest buf = let query_manifest c =
match Elf.find buf Elf.section_manifest Elf.typ_mft1 with match Elf.find c Elf.section_manifest Elf.typ_mft1 with
| None -> Error (`Msg "manifest not found") | None -> Error (`Msg "manifest not found")
| Some desc -> parse_mft desc | Some desc -> parse_mft desc
(*| exception Elf.Elf_error -> Error (`Msg "error during ELF parsing")*) (*| exception Elf.Elf_error -> Error (`Msg "error during ELF parsing")*)
let query_abi buf = let query_abi c =
match Elf.find buf Elf.section_abi Elf.typ_abi1 with match Elf.find c Elf.section_abi Elf.typ_abi1 with
| None -> Error (`Msg "manifest not found") | None -> Error (`Msg "manifest not found")
| Some desc -> parse_abi desc | Some desc -> parse_abi desc
(*| exception Elf.Elf_error -> Error (`Msg "error during ELF parsing")*) (*| exception Elf.Elf_error -> Error (`Msg "error during ELF parsing")*)

4
lib/solo5_elftool.mli
View file

@ -36,8 +36,8 @@ val pp_abi : Format.formatter -> abi -> unit
(** Pretty-prints the manifest as JSON in a similar style as the Solo5 command (** Pretty-prints the manifest as JSON in a similar style as the Solo5 command
* line tool {[solo5-elftool query-abi]}. *) * line tool {[solo5-elftool query-abi]}. *)
val query_manifest : string -> (mft, [> `Msg of string ]) result val query_manifest : 'fd Cachet.t -> (mft, [> `Msg of string ]) result
(** [query_manifest buf] is the solo5 manifest of [buf], or an error message. *) (** [query_manifest buf] is the solo5 manifest of [buf], or an error message. *)
val query_abi : string -> (abi, [> `Msg of string ]) result val query_abi : 'fd Cachet.t -> (abi, [> `Msg of string ]) result
(** [query_abi buf] is the solo5 abi of [buf], or an error message. *) (** [query_abi buf] is the solo5 abi of [buf], or an error message. *)