bin/dune

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

bin/main.ml

@@ -1,13 +1,33 @@
+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
+  at_exit (fun () -> Unix.close fd);
+  Cachet.make ~map ()
+
 let query_manifest file =
-  Owee_buf.map_binary file
+  map_binary file
   |> Solo5_elftool.query_manifest
-  |> Result.iter (fun mft ->
+  |> Result.fold
+    ~ok:(fun mft ->
         Fmt.pr "%a\n" Solo5_elftool.pp_mft mft)
+    ~error:(fun (`Msg e) ->
+        Fmt.epr "%s\n" e)
 
 let query_abi file =
-  Owee_buf.map_binary file
+  map_binary file
   |> Solo5_elftool.query_abi
-  |> Result.iter (Fmt.pr "%a\n" Solo5_elftool.pp_abi)
+  |> Result.fold
+    ~ok:(fun abi -> Fmt.pr "%a\n" Solo5_elftool.pp_abi abi)
+    ~error:(fun (`Msg e) ->
+        Fmt.epr "%s\n" e)
 
 let file =
   let doc = "Solo5 executable" in

dune-project

@@ -1,2 +1,3 @@
 (lang dune 2.9)
 (name solo5-elftool)
+(cram enable)

lib/dune

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

lib/elf.ml

@@ -0,0 +1,155 @@
+module Bstr = Cachet.Bstr
+
+exception Elf_error
+
+(* only the bits we care about *)
+type header = {
+  e_shoff : int;
+  e_shentsize : int;
+  e_shnum : int;
+  e_shstrndx : int;
+}
+
+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;
+  (* we only support ELFCLASS64 *)
+  if elf_class <> elfclass64 then
+    raise Elf_error;
+  let endianness =
+    match elf_data with
+    | 1 -> `LE
+    | 2 -> `BE
+    | _ -> raise Elf_error
+  in
+  endianness
+
+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 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
+    (* padding *)
+    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

lib/solo5_elftool.ml

@@ -70,43 +70,41 @@ let guard m b = if not b then Error (`Msg m) else Ok ()
 let sizeof_mft_entry = 104
 let mft_max_entries = 64l
 
-let parse_mft_entry buf =
+let parse_mft_entry s =
   (* invariant: Cstruct.length buf = sizeof_mft_entry *)
-  let name_raw = Cstruct.sub buf 0 68 in
+  let name_raw = String.sub s 0 68 in
-  let typ = Cstruct.LE.get_uint32 buf 68 in
+  let typ = String.get_int32_le s 68 in
-  let u = Cstruct.sub buf 72 16 in
+  let u = String.sub s 72 16 in
-  let b = Cstruct.sub buf 88 8 in
+  let b = String.sub s 88 8 in
-  let attached = Cstruct.get_uint8 buf 96 <> 0 in
+  let attached = String.get_uint8 s 96 <> 0 in
   let* name =
-    Cstruct.cut ~sep:(Cstruct.create 1) name_raw
+    String.index_opt name_raw '\000'
-    |> Option.map (fun (name, _) -> Cstruct.to_string name)
+    |> Option.map (fun idx -> String.sub name_raw 0 idx)
     |> Option.to_result ~none:(`Msg "unterminated device name")
   in
-  let* () = guard "non-zero mft_entry.u" (Cstruct.for_all ((=) '\000') u) in
+  let* () = guard "non-zero mft_entry.u" (String.for_all ((=) '\000') u) in
-  let* () = guard "non-zero mft_entry.b" (Cstruct.for_all ((=) '\000') b) in
+  let* () = guard "non-zero mft_entry.b" (String.for_all ((=) '\000') b) in
   let* () = guard "non-zero mft_entry.attached" (not attached) in
   let* typ = mft_type_of_int typ in
   match typ with
   | Reserved_first ->
-    let* () = guard "non-zero RESERVED_FIRST" (Cstruct.for_all ((=) '\000') name_raw) in
+    let* () = guard "non-zero RESERVED_FIRST" (String.for_all ((=) '\000') name_raw) in
     Ok `Reserved_first
   | Dev_block_basic ->
     Ok (`Dev_block_basic name)
   | Dev_net_basic ->
     Ok (`Dev_net_basic name)
 
-let parse_mft buf =
+let parse_mft s =
-  let buf = Cstruct.of_string buf in
   let* () = guard "manifest too small"
-      (Cstruct.length buf >= 4 + 8 + sizeof_mft_entry)
+      (String.length s >= 4 + 8 + sizeof_mft_entry)
   in
   (* Solo5 defines a struct mft1_note consisting of the ELF note header
    * followed by a struct mft for reading and writing the ELF note. The note
    * header is 20 bytes long, so to get 8-byte alignment the note header is
    * padded with 4 bytes. See {[solo5/mft_abi.h]}. *)
-  let buf = Cstruct.shift buf 4 in
+  let version = String.get_int32_le s 4
-  let version = Cstruct.LE.get_uint32 buf 0
+  and entries = String.get_int32_le s 8
-  and entries = Cstruct.LE.get_uint32 buf 4
   in
   let* () = guard "unsupported manifest version" (version = 1l) in
   let* () = guard "zero manifest entries" (Int32.unsigned_compare entries 0l > 0) in
@@ -118,25 +116,25 @@ let parse_mft buf =
    * mft_max_entries, so this is safely equivalent to:
    *   (Option.get (Int32.unsigned_to_int entries) *)
   let entries = Int32.to_int entries in
-  let buf = Cstruct.shift buf 8 in
+  let off = 12 in
   let* () = guard "unexpected note size"
-      (Cstruct.length buf = entries * sizeof_mft_entry)
+      (String.length s = entries * sizeof_mft_entry + 12)
   in
   let* () =
-    match parse_mft_entry (Cstruct.sub buf 0 sizeof_mft_entry) with
+    match parse_mft_entry (String.sub s off sizeof_mft_entry) with
     | Ok `Reserved_first -> Ok ()
     | _ -> Error (`Msg "expected RESERVED_FIRST")
   in
-  let buf = Cstruct.shift buf sizeof_mft_entry in
+  let off = off + sizeof_mft_entry in
   let entries =
     Array.init (entries - 1)
-      (fun i -> Cstruct.sub buf (i * sizeof_mft_entry) sizeof_mft_entry)
+      (fun i -> String.sub s (off + i * sizeof_mft_entry) sizeof_mft_entry)
   in
   let* entries =
     Array.fold_left
-      (fun r buf ->
+      (fun r s ->
          let* acc = r in
-         let* mft_entry = parse_mft_entry buf in
+         let* mft_entry = parse_mft_entry s in
          match mft_entry with
          | `Dev_block_basic name -> Ok (Dev_block_basic name :: acc)
          | `Dev_net_basic name -> Ok (Dev_net_basic name :: acc)
@@ -147,65 +145,28 @@ let parse_mft buf =
   in
   Ok { version = Int32.to_int version; entries }
 
-let parse_abi buf =
+let parse_abi s =
-  let buf = Cstruct.of_string buf in
+  let* () = guard "abi manifest size mismatch" (String.length s = 4 * 4) in
-  let* () = guard "abi manifest size mismatch" (Cstruct.length buf = 4 * 4) in
+  let target = String.get_int32_le s 0 in
-  let target = Cstruct.LE.get_uint32 buf 0 in
+  let version = String.get_int32_le s 4 in
-  let version = Cstruct.LE.get_uint32 buf 4 in
+  let reserved0 = String.get_int32_le s 8 in
-  let reserved0 = Cstruct.LE.get_uint32 buf 8 in
+  let reserved1 = String.get_int32_le s 12 in
-  let reserved1 = Cstruct.LE.get_uint32 buf 12 in
   let* target = abi_target_of_int target in
   let* () = guard "non-zero reserved0" (reserved0 = 0l) in
   let* () = guard "non-zero reserved1" (reserved1 = 0l) in
   (* XXX: should we check version = 1l ? *)
   Ok { target; version }
 
-let ( let* ) = Result.bind
+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 | exception Cachet.Out_of_bounds _ ->
+    Error (`Msg "error during ELF parsing")
 
-let note_name = "Solo5"
+let query_abi c =
-let typ_mft1 = 0x3154464d
+  match Elf.find c Elf.section_abi Elf.typ_abi1 with
-let typ_abi1 = 0x31494241
+  | None -> Error (`Msg "manifest not found")
-
+  | Some desc -> parse_abi desc
-let query_manifest_exn buf =
+  | exception Elf.Elf_error | exception Cachet.Out_of_bounds _ ->
-  let _header, sections = Owee_elf.read_elf buf in
+    Error (`Msg "error during ELF parsing")
-  let* section =
-    Owee_elf.find_section sections ".note.solo5.manifest"
-    |> Option.to_result ~none:(`Msg "section .note.solo5.manifest not found")
-  in
-  let body = Owee_elf.section_body buf section in
-  let cursor = Owee_buf.cursor body in
-  let descsz =
-    Owee_elf_notes.read_desc_size cursor
-      ~expected_owner:note_name
-      ~expected_type:typ_mft1
-  in
-  let desc = Owee_buf.Read.fixed_string cursor descsz in
-  let* () = guard "extra data" (Owee_buf.at_end cursor) in
-  parse_mft desc
-
-let query_manifest buf =
-  try query_manifest_exn buf with
-  | Out_of_memory -> raise Out_of_memory
-  | e -> Error (`Msg ("query manifest failure: " ^ Printexc.to_string e))
-
-let query_abi_exn buf =
-  let _header, sections = Owee_elf.read_elf buf in
-  let* section =
-    Owee_elf.find_section sections ".note.solo5.abi"
-    |> Option.to_result ~none:(`Msg "section .note.solo5.abi not found")
-  in
-  let body = Owee_elf.section_body buf section in
-  let cursor = Owee_buf.cursor body in
-  let descsz =
-    Owee_elf_notes.read_desc_size cursor
-      ~expected_owner:note_name
-      ~expected_type:typ_abi1
-  in
-  let desc = Owee_buf.Read.fixed_string cursor descsz in
-  let* () = guard "extra data" (Owee_buf.at_end cursor) in
-  parse_abi desc
-
-let query_abi buf =
-  try query_abi_exn buf with
-  | Out_of_memory -> raise Out_of_memory
-  | e -> Error (`Msg ("query abi failure: " ^ Printexc.to_string e))

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 : Owee_buf.t -> (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 : Owee_buf.t -> (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. *)

solo5-elftool.opam

@@ -15,12 +15,12 @@ build: [
 depends: [
   "ocaml" {>= "4.08.0"}
   "dune" {>= "2.9"}
-  "owee" {>= "0.4"}
+  "cachet"
-  "cstruct" {>= "6.0.0"}
   "fmt" {>= "0.8.7"}
   "cmdliner" {>= "1.1.0"}
 ]
 
+available: arch != "arm32" & arch != "x86_32"
 conflicts: [
   "result" {< "1.5"}
 ]

test/dune

@@ -0,0 +1,8 @@
+(cram
+  (deps
+    %{bin:osolo5-elftool}
+    test_hello.hvt
+    test_hello.muen
+    test_hello.spt
+    test_hello.virtio
+    test_hello.xen))

test/osolo5-elftool.t

@@ -0,0 +1,20 @@
+Execute osolo5-elftool on hvt binary
+
+  $ osolo5-elftool query-abi test_hello.hvt
+  { "type": "solo5.abi", "target": "hvt", "version": 2 
+  }
+  $ osolo5-elftool query-manifest test_hello.hvt
+  { "type": "solo5.manifest", "version": 1, "devices": [  ]
+  }
+  $ osolo5-elftool query-abi test_hello.muen
+  { "type": "solo5.abi", "target": "muen", "version": 3 
+  }
+  $ osolo5-elftool query-abi test_hello.spt
+  { "type": "solo5.abi", "target": "spt", "version": 2 
+  }
+  $ osolo5-elftool query-abi test_hello.virtio
+  { "type": "solo5.abi", "target": "virtio", "version": 1 
+  }
+  $ osolo5-elftool query-abi test_hello.xen
+  { "type": "solo5.abi", "target": "xen", "version": 1 
+  }