Compare commits
2 commits
737a2b51a8
...
c54547dad9
Author | SHA1 | Date | |
---|---|---|---|
Théophile Bastian | c54547dad9 | ||
Théophile Bastian | 24383471fd |
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -20,3 +20,4 @@ _build/
|
||||||
setup.data
|
setup.data
|
||||||
setup.log
|
setup.log
|
||||||
|
|
||||||
|
.merlin
|
||||||
|
|
2
dune-project
Normal file
2
dune-project
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
(lang dune 1.9)
|
||||||
|
(using menhir 2.0)
|
131
src/asm_acquire.ml
Normal file
131
src/asm_acquire.ml
Normal file
|
@ -0,0 +1,131 @@
|
||||||
|
(** Module to acquire the ASM of a given ELF object by its path
|
||||||
|
|
||||||
|
Uses `objdump -d` internally, and parses the output
|
||||||
|
*)
|
||||||
|
|
||||||
|
module StrMap = Map.Make(String)
|
||||||
|
|
||||||
|
(** A memory address *)
|
||||||
|
type addr_t = int
|
||||||
|
|
||||||
|
(** A single asm instruction *)
|
||||||
|
type asm_instr_t = {
|
||||||
|
instr_addr: addr_t; (** Memory location of this instruction *)
|
||||||
|
instr_bytes: Bytes.t; (** Binary representation of the instruction *)
|
||||||
|
instr_asm: string; (** Asm for the instruction (eg `movq …`) *)
|
||||||
|
}
|
||||||
|
type asm_t = asm_instr_t list
|
||||||
|
type asm_sub_t = {
|
||||||
|
sub_section: string;
|
||||||
|
sub_name: string;
|
||||||
|
sub_addr: addr_t;
|
||||||
|
sub_asm: asm_t;
|
||||||
|
}
|
||||||
|
type asm_info_t = asm_sub_t StrMap.t
|
||||||
|
|
||||||
|
exception ParseError of string
|
||||||
|
|
||||||
|
(** Pretty printers *)
|
||||||
|
let pp_hex_bytes ppx bytes_array =
|
||||||
|
Bytes.iter (fun byte -> Format.fprintf ppx "%02x" (int_of_char byte))
|
||||||
|
bytes_array
|
||||||
|
|
||||||
|
let pp_asm_instr ppx asm_instr =
|
||||||
|
Format.fprintf ppx "%04x:\t%a\t%s@."
|
||||||
|
asm_instr.instr_addr
|
||||||
|
pp_hex_bytes asm_instr.instr_bytes
|
||||||
|
asm_instr.instr_asm
|
||||||
|
|
||||||
|
let pp_asm ppx asm_instrs = List.iter (pp_asm_instr ppx) asm_instrs
|
||||||
|
|
||||||
|
let pp_asm_sub ppx asm_sub =
|
||||||
|
Format.fprintf ppx "%016x <%s> {%s}:@.@[%a@]@."
|
||||||
|
asm_sub.sub_addr
|
||||||
|
asm_sub.sub_name
|
||||||
|
asm_sub.sub_section
|
||||||
|
pp_asm asm_sub.sub_asm
|
||||||
|
|
||||||
|
let pp_asm_info ppx asm_info =
|
||||||
|
StrMap.iter (fun _ asm_sub -> Format.fprintf ppx "%a" pp_asm_sub asm_sub)
|
||||||
|
asm_info
|
||||||
|
|
||||||
|
(** Reads the whole content of a Unix file descriptor, returning it as a Bytes
|
||||||
|
sequence *)
|
||||||
|
let read_all_fd fd =
|
||||||
|
Unix.set_nonblock fd ;
|
||||||
|
|
||||||
|
let rec do_read accu cur_size =
|
||||||
|
let n_accu = Bytes.extend accu 0 256 in
|
||||||
|
let bytes_read = (
|
||||||
|
try
|
||||||
|
Unix.read fd n_accu cur_size 256
|
||||||
|
with
|
||||||
|
| Unix.Unix_error(Unix.EAGAIN, _, _)
|
||||||
|
| Unix.Unix_error(Unix.EWOULDBLOCK, _, _) ->
|
||||||
|
0
|
||||||
|
) in
|
||||||
|
|
||||||
|
if bytes_read = 256 then
|
||||||
|
do_read n_accu (cur_size + 256)
|
||||||
|
else (
|
||||||
|
Bytes.extend n_accu 0 (bytes_read - 256)
|
||||||
|
)
|
||||||
|
in
|
||||||
|
do_read (Bytes.create 0) 0
|
||||||
|
|
||||||
|
|
||||||
|
(** Raised when the call to objdump failed. An exception
|
||||||
|
[ObjdumpFailed (status_code, stderr)] will contain the status code of the
|
||||||
|
objdump process, and its stderr contents as a string. *)
|
||||||
|
exception ObjdumpFailed of int * string
|
||||||
|
|
||||||
|
|
||||||
|
(** Runs `objdump -d prog_path` and returns its stdout as a string *)
|
||||||
|
let get_objdump prog_path =
|
||||||
|
(* Setup process *)
|
||||||
|
let stdin_read, stdin = Unix.pipe () in
|
||||||
|
let stdout, stdout_write = Unix.pipe () in
|
||||||
|
let stderr, stderr_write = Unix.pipe () in
|
||||||
|
|
||||||
|
(* Run the process *)
|
||||||
|
Format.eprintf "Running objdump...@." ;
|
||||||
|
let objdump_pid = Unix.create_process
|
||||||
|
"objdump"
|
||||||
|
[| "objdump" ; "-d" ; prog_path |]
|
||||||
|
stdin_read stdout_write stderr_write
|
||||||
|
in
|
||||||
|
(* Close stdin already: we won't send anything and make it clear *)
|
||||||
|
Unix.close stdin ;
|
||||||
|
Format.eprintf "\tPID = %d@." objdump_pid;
|
||||||
|
|
||||||
|
let pid, status = Unix.waitpid [] objdump_pid in
|
||||||
|
if pid <> objdump_pid then
|
||||||
|
raise (Failure ("Could not properly wait on objdump")) ;
|
||||||
|
|
||||||
|
Format.eprintf "Run objdump: done. Status: %a@." (fun ppx sc -> match sc with
|
||||||
|
| Unix.WEXITED ex_code -> Format.fprintf ppx "%d" ex_code
|
||||||
|
| _ -> Format.fprintf ppx "Not exited") status ;
|
||||||
|
|
||||||
|
(* Extract stdout, stderr data *)
|
||||||
|
let stdout_content = read_all_fd stdout in
|
||||||
|
let stderr_content = read_all_fd stderr in
|
||||||
|
|
||||||
|
(* Properly close pipes *)
|
||||||
|
Unix.close stdout ;
|
||||||
|
Unix.close stderr ;
|
||||||
|
|
||||||
|
(* Check status code *)
|
||||||
|
match status with
|
||||||
|
| Unix.WEXITED 0 ->
|
||||||
|
Bytes.to_string stdout_content
|
||||||
|
| Unix.WEXITED err_code ->
|
||||||
|
raise (ObjdumpFailed (err_code, (Bytes.to_string stderr_content)))
|
||||||
|
| _ ->
|
||||||
|
raise (ObjdumpFailed (-1, (Bytes.to_string stderr_content)))
|
||||||
|
|
||||||
|
(** Interprets `objdump -d` output and yield a list of functions, alongside
|
||||||
|
with their addresses, symbol names, asm, … *)
|
||||||
|
let interpret_objdump objdump_out : asm_info_t =
|
||||||
|
(* TODO *)
|
||||||
|
ignore objdump_out;
|
||||||
|
assert false
|
55
src/elf_arrows.ml
Normal file
55
src/elf_arrows.ml
Normal file
|
@ -0,0 +1,55 @@
|
||||||
|
(** Entry point file for elf_arrows *)
|
||||||
|
|
||||||
|
exception NotElf;;
|
||||||
|
exception NoDwarf;;
|
||||||
|
exception NoDwarfStatic;;
|
||||||
|
|
||||||
|
let (>>=) = Error.bind
|
||||||
|
|
||||||
|
let make_pp linksem_pp =
|
||||||
|
(fun fmt arg ->
|
||||||
|
linksem_pp arg
|
||||||
|
|> Format.fprintf fmt "%s")
|
||||||
|
|
||||||
|
type elf_path = string
|
||||||
|
type elf_handle = ElfHandle of elf_path * Elf_file.elf_file * Dwarf.dwarf_static
|
||||||
|
|
||||||
|
(** Open an ELF file and loads its dwarf_static infos. *)
|
||||||
|
let open_elf elf_path =
|
||||||
|
|
||||||
|
(Byte_sequence.acquire elf_path >>= fun elf_bs -> (
|
||||||
|
match Elf_file.read_elf64_file elf_bs with
|
||||||
|
| Error.Success elf64 -> Error.Success (Elf_file.ELF_File_64 elf64)
|
||||||
|
| Error.Fail _ -> (match Elf_file.read_elf32_file elf_bs with
|
||||||
|
| Error.Success elf32 -> Error.Success (Elf_file.ELF_File_32 elf32)
|
||||||
|
| Error.Fail _ -> raise NotElf)
|
||||||
|
))
|
||||||
|
>>= fun elf_file -> (
|
||||||
|
let static_info = (match Dwarf.extract_dwarf_static elf_file with
|
||||||
|
| Some static_info -> static_info
|
||||||
|
| None -> raise NoDwarfStatic) in
|
||||||
|
Error.Success (ElfHandle (elf_path, elf_file, static_info)))
|
||||||
|
|
||||||
|
|
||||||
|
let elf_files = ref []
|
||||||
|
let speclist = []
|
||||||
|
let parse_anon_arg arg =
|
||||||
|
elf_files := arg :: (!elf_files)
|
||||||
|
|
||||||
|
let _ =
|
||||||
|
Arg.parse speclist parse_anon_arg "./test ELF_FILE" ;
|
||||||
|
let elf_handles = List.rev @@
|
||||||
|
List.map (fun path -> match open_elf path with
|
||||||
|
| Error.Success handle -> handle
|
||||||
|
| Error.Fail msg ->
|
||||||
|
raise (Failure ("Could not open " ^ path ^ ": " ^ msg)))
|
||||||
|
!elf_files
|
||||||
|
in
|
||||||
|
|
||||||
|
List.iter (fun (ElfHandle(path, _, static_info)) ->
|
||||||
|
let line_info = static_info.ds_evaluated_line_info in
|
||||||
|
Format.eprintf "Line infos <%s>:@. %a@."
|
||||||
|
path
|
||||||
|
(make_pp Dwarf.pp_evaluated_line_info)
|
||||||
|
line_info ;
|
||||||
|
) elf_handles
|
Loading…
Reference in a new issue