diff --git a/bin/dune b/bin/dune index 462cfa5..e7420d7 100644 --- a/bin/dune +++ b/bin/dune @@ -1,4 +1,4 @@ (executable (public_name osolo5-elftool) (name main) - (libraries solo5-elftool owee cstruct cmdliner)) + (libraries solo5-elftool owee cachet cmdliner)) diff --git a/bin/main.ml b/bin/main.ml index 49adfaa..b63dfe2 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,19 +1,18 @@ -let read_binary file = - let ic = open_in_bin file in - let res = Buffer.create 16384 in - let buf = Bytes.create 16384 in - let rec loop () = - let len = input ic buf 0 16384 in - if len > 0 then - let () = Buffer.add_subbytes res buf 0 len in - loop () +let map_binary file = + let fd = Unix.openfile file [Unix.O_RDONLY; Unix.O_CLOEXEC] 0 in + let stat = Unix.fstat fd in + let map () ~pos len = + let len = Int.min (stat.Unix.st_size - pos) len in + let pos = Int64.of_int pos in + let barr = + Unix.map_file fd ~pos Bigarray.char Bigarray.c_layout false [| len |] + in + Bigarray.array1_of_genarray barr in - loop (); - close_in_noerr ic; - Buffer.contents res + Cachet.make ~map () let query_manifest file = - read_binary file + map_binary file |> Solo5_elftool.query_manifest |> Result.fold ~ok:(fun mft -> @@ -22,7 +21,7 @@ let query_manifest file = Fmt.epr "%s\n" e) let query_abi file = - read_binary file + map_binary file |> Solo5_elftool.query_abi |> Result.fold ~ok:(fun abi -> Fmt.pr "%a\n" Solo5_elftool.pp_abi abi) diff --git a/lib/dune b/lib/dune index e0a60de..46c94c2 100644 --- a/lib/dune +++ b/lib/dune @@ -1,4 +1,4 @@ (library (public_name solo5-elftool) (name solo5_elftool) - (libraries owee cstruct fmt)) + (libraries owee cstruct cachet fmt)) diff --git a/lib/elf.ml b/lib/elf.ml index ee89d16..4826ad2 100644 --- a/lib/elf.ml +++ b/lib/elf.ml @@ -1,3 +1,5 @@ +module Bstr = Cachet.Bstr + exception Elf_error (* only the bits we care about *) @@ -22,60 +24,61 @@ let typ_mft1 = 0x3154464d let typ_abi1 = 0x31494241 let get_uint16 = function - | `LE -> String.get_uint16_le - | `BE -> String.get_uint16_be + | `LE -> Cachet.get_uint16_le + | `BE -> Cachet.get_uint16_be let get_uint32 en s off = let get = match en with - | `LE -> String.get_int32_le - | `BE -> String.get_int32_be + | `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 -> String.get_int64_le - | `BE -> String.get_int64_be + | `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 s off maxlen = - let rec scan_c_string i = - if String.length s < off + i || i = maxlen then - raise Elf_error - else if s.[i+off] = '\000' then - i - else - scan_c_string (succ i) +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 - String.sub s off (scan_c_string 0) + scan 0 (seq ()) -let read_magic s off = - if String.length s < off + 4 then - raise Elf_error; - let valid = - 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 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 s off = - if String.length s < off + 12 then - raise Elf_error; - let elf_class = String.get_uint8 s off in - let elf_data = String.get_uint8 s (off+1) in - let _elf_version = String.get_uint8 s (off+2) in - let _elf_osabi = String.get_uint8 s (off+3) in - let _elf_abiversion = String.get_uint8 s (off+4) in - (* Check padding *) - for i = off + 5 to off+11 do - if s.[i] <> '\000' then +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; (* we only support ELFCLASS64 *) @@ -87,39 +90,33 @@ let read_identification s off = | 2 -> `BE | _ -> raise Elf_error in - endianness, off+12 + endianness -let read_header en s = - if String.length s < 16 + 48 then - raise Elf_error; - let e_shoff = get_uint32 en s 0x28 in - let e_shentsize = get_uint16 en s 0x3a in - let e_shnum = get_uint16 en s 0x3c in - let e_shstrndx = get_uint16 en s 0x3e in +let read_header 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 s hdr i = +let read_section en c hdr i = let off = hdr.e_shoff + i * hdr.e_shentsize in - if String.length s < off + 64 then - raise Elf_error; - let sh_name_off = get_uint32 en s off in - let sh_offset = get_uint64 en s (off + 24) in - let sh_size = get_uint64 en s (off + 32) 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 s section = +let read_section_name shstrndx c section = let off = shstrndx.sh_offset + section.sh_name_off in - if String.length s < off + 1 then - raise Elf_error; - c_string s off (shstrndx.sh_size - section.sh_name_off) + c_string (Cachet.get_seq c off) (shstrndx.sh_size - section.sh_name_off) -let read_sections en s hdr = - let sections = Array.init hdr.e_shnum (read_section en s hdr) in +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 s section }) + (fun section -> { section with sh_name = read_section_name shstrndx c section }) sections let find_section sections name = @@ -127,39 +124,32 @@ let find_section sections name = (fun section -> String.equal section.sh_name name) sections -let section_body s section = - if section.sh_offset < 0 || String.length s < section.sh_offset + section.sh_size then - raise Elf_error; - 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 +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") - (String.sub section_body 12 namesz)) + (Cachet.get_string c (off+12) ~len:namesz)) then None else - let off = 12 + namesz in + let off = off + 12 + namesz in (* padding *) 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 off = read_magic s 0 in - let en, _off = read_identification s off in - let hdr = read_header en s in - let sections = read_sections en s hdr in +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 -> - let body = section_body s section in - desc en body ~expected_owner:note_name ~expected_type:typ + desc en c section ~expected_owner:note_name ~expected_type:typ diff --git a/lib/solo5_elftool.ml b/lib/solo5_elftool.ml index 8bf26e7..ed957f4 100644 --- a/lib/solo5_elftool.ml +++ b/lib/solo5_elftool.ml @@ -160,14 +160,14 @@ let parse_abi buf = (* XXX: should we check version = 1l ? *) Ok { target; version } -let query_manifest buf = - match Elf.find buf Elf.section_manifest Elf.typ_mft1 with +let query_manifest c = + match Elf.find c Elf.section_manifest Elf.typ_mft1 with | None -> Error (`Msg "manifest not found") | Some desc -> parse_mft desc (*| exception Elf.Elf_error -> Error (`Msg "error during ELF parsing")*) -let query_abi buf = - match Elf.find buf Elf.section_abi Elf.typ_abi1 with +let query_abi c = + match Elf.find c Elf.section_abi Elf.typ_abi1 with | None -> Error (`Msg "manifest not found") | Some desc -> parse_abi desc (*| exception Elf.Elf_error -> Error (`Msg "error during ELF parsing")*) diff --git a/lib/solo5_elftool.mli b/lib/solo5_elftool.mli index f66c60a..7246244 100644 --- a/lib/solo5_elftool.mli +++ b/lib/solo5_elftool.mli @@ -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 * 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. *) -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. *)