From 2d6658f17e285d93563c40f73aead3b7e31bd09a Mon Sep 17 00:00:00 2001 From: Alistair Michael Date: Mon, 23 Sep 2024 15:29:19 +1000 Subject: [PATCH 1/6] bump ocaml-protoc-plugin version --- dune-project | 2 +- gtirb_semantics.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dune-project b/dune-project index 3d79f9e..2521aed 100644 --- a/dune-project +++ b/dune-project @@ -19,7 +19,7 @@ (name gtirb_semantics) (synopsis "Add semantic information to the IR of a disassembled ARM64 binary") (description "A longer description") - (depends ocaml dune yojson asli ocaml-protoc-plugin base64) + (depends ocaml dune yojson asli (ocaml-protoc-plugin (>= 6.1.0)) base64) (tags (decompilers instruction-lifters static-analysis))) diff --git a/gtirb_semantics.opam b/gtirb_semantics.opam index 9929fb8..145c19c 100644 --- a/gtirb_semantics.opam +++ b/gtirb_semantics.opam @@ -14,7 +14,7 @@ depends: [ "dune" {>= "3.6"} "yojson" "asli" - "ocaml-protoc-plugin" + "ocaml-protoc-plugin" {>= "6.1.0"} "base64" "odoc" {with-doc} ] From aaaeb1d26d6e6f1d4e1c2bc24ed67b353edbec75 Mon Sep 17 00:00:00 2001 From: Alistair Michael Date: Mon, 23 Sep 2024 11:15:43 +1000 Subject: [PATCH 2/6] fix proto generated filenames --- lib/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/dune b/lib/dune index 58670e7..347b3c0 100644 --- a/lib/dune +++ b/lib/dune @@ -3,7 +3,7 @@ (libraries ocaml-protoc-plugin asli.libASL base64)) (rule - (targets AuxData.ml ByteInterval.ml CFG.ml CodeBlock.ml DataBlock.ml IR.ml Module.ml Offset.ml ProxyBlock.ml Section.ml Symbol.ml SymbolicExpression.ml) + (targets auxData.ml byteInterval.ml cFG.ml codeBlock.ml dataBlock.ml iR.ml module.ml offset.ml proxyBlock.ml section.ml symbol.ml symbolicExpression.ml) (deps (:proto AuxData.proto ByteInterval.proto CFG.proto CodeBlock.proto DataBlock.proto IR.proto Module.proto Offset.proto ProxyBlock.proto Section.proto Symbol.proto SymbolicExpression.proto)) (action From b8502bfa6c77e00e4eed97722b88c3455a83d82b Mon Sep 17 00:00:00 2001 From: Alistair Michael Date: Mon, 23 Sep 2024 15:00:05 +1000 Subject: [PATCH 3/6] emit function on unsupported --- bin/main.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index c3995ab..2cf5d01 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -127,19 +127,21 @@ let do_module (m: Module.t): Module.t = (* TODO: change argument of to_asli to follow this convention. *) let opnum = Int32.to_int Bytes.(get_int32_be opcode_be 0) in let opnum_str = Printf.sprintf "0x%08lx" Int32.(of_int opnum) in + let opnum_dec_str = Printf.sprintf "%lu" Int32.(of_int opnum) in let opcode_list : char list = List.(rev @@ of_seq @@ Bytes.to_seq opcode_be) in let opcode_str = String.concat " " List.(map p_byte opcode_list) in let _opcode : bytes = Bytes.of_seq List.(to_seq opcode_list) in + let unsupported op = let open Asl_ast in Stmt_TCall (FIdent ("unsupported_opcode", 0), [], [Expr_LitInt op], Unknown) in let do_dis () = (match Dis.retrieveDisassembly ?address env (Dis.build_env env) opnum_str with | res -> (List.map p_raw res, List.map p_pretty res) | exception exc -> Printf.eprintf - "error during aslp disassembly (opcode %s, bytes %s):\n\nFatal error: exception %s\n" + "error during aslp disassembly (unsupoprted opcode %s, bytes %s):\n\nException : %s\n" opnum_str opcode_str (Printexc.to_string exc); - Printexc.print_backtrace stderr; - exit 1) + (* Printexc.print_backtrace stderr; *) + ([p_raw @@ unsupported opnum_dec_str], [p_pretty @@ unsupported opnum_dec_str])) in fst @@ do_dis () in let rec asts opcodes addr = From 9ff14e9efdb29e8650807c48b97b2ef5c83b047d Mon Sep 17 00:00:00 2001 From: Alistair Michael Date: Mon, 23 Sep 2024 15:54:02 +1000 Subject: [PATCH 4/6] fix typo Co-authored-by: Kait Lam <39479354+katrinafyi@users.noreply.github.com> --- bin/main.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bin/main.ml b/bin/main.ml index 2cf5d01..c42b96b 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -138,7 +138,7 @@ let do_module (m: Module.t): Module.t = | res -> (List.map p_raw res, List.map p_pretty res) | exception exc -> Printf.eprintf - "error during aslp disassembly (unsupoprted opcode %s, bytes %s):\n\nException : %s\n" + "error during aslp disassembly (unsupported opcode %s, bytes %s):\n\nException : %s\n" opnum_str opcode_str (Printexc.to_string exc); (* Printexc.print_backtrace stderr; *) ([p_raw @@ unsupported opnum_dec_str], [p_pretty @@ unsupported opnum_dec_str])) From 266645fb6a9966cd709d30f6a3407e1b7b6a5e7a Mon Sep 17 00:00:00 2001 From: Alistair Michael Date: Mon, 11 Nov 2024 15:04:07 +1000 Subject: [PATCH 5/6] use separate json structor for error --- bin/main.ml | 38 ++++++++++++++++++++++++++++---------- 1 file changed, 28 insertions(+), 10 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index c42b96b..ca470c2 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -6,6 +6,7 @@ open Gtirb_semantics.Section.Gtirb.Proto open Gtirb_semantics.CodeBlock.Gtirb.Proto open Gtirb_semantics.AuxData.Gtirb.Proto open LibASL +open Either (* TYPES *) @@ -20,10 +21,16 @@ type rectified_block = { size : int; } + +type dis_error = { + opcode: string; + error: string +} + (* ASLi semantic info for a block *) type ast_block = { auuid : bytes; - asts : string list list; + asts : ((string list, dis_error) Either.t) list; } (* Wrapper for polymorphic code/data/not-set block pre-rectification *) @@ -33,6 +40,7 @@ type content_block = { address : int; } + (* CONSTANTS *) let opcode_length = 4 let json_file = ref "" @@ -116,8 +124,9 @@ let do_module (m: Module.t): Module.t = | None -> Printf.eprintf "unable to load bundled asl files. has aslp been installed correctly?"; exit 1 in + (* Evaluate each instruction one by one with a new environment for each *) - let to_asli (opcode_be: bytes) (addr : int) : string list = + let to_asli (opcode_be: bytes) (addr : int) : ((string list, dis_error) Either.t) = let p_raw a = Utils.to_string (Asl_parser_pp.pp_raw_stmt a) |> String.trim in let p_pretty a = Asl_utils.pp_stmt a |> String.trim in let p_byte (b: char) = Printf.sprintf "%02X" (Char.code b) in @@ -127,22 +136,25 @@ let do_module (m: Module.t): Module.t = (* TODO: change argument of to_asli to follow this convention. *) let opnum = Int32.to_int Bytes.(get_int32_be opcode_be 0) in let opnum_str = Printf.sprintf "0x%08lx" Int32.(of_int opnum) in - let opnum_dec_str = Printf.sprintf "%lu" Int32.(of_int opnum) in let opcode_list : char list = List.(rev @@ of_seq @@ Bytes.to_seq opcode_be) in let opcode_str = String.concat " " List.(map p_byte opcode_list) in let _opcode : bytes = Bytes.of_seq List.(to_seq opcode_list) in - let unsupported op = let open Asl_ast in Stmt_TCall (FIdent ("unsupported_opcode", 0), [], [Expr_LitInt op], Unknown) in - let do_dis () = + + let do_dis () : ((string list * string list), dis_error) Either.t = (match Dis.retrieveDisassembly ?address env (Dis.build_env env) opnum_str with - | res -> (List.map p_raw res, List.map p_pretty res) + | res -> Left (List.map p_raw res, List.map p_pretty res) | exception exc -> Printf.eprintf "error during aslp disassembly (unsupported opcode %s, bytes %s):\n\nException : %s\n" opnum_str opcode_str (Printexc.to_string exc); (* Printexc.print_backtrace stderr; *) - ([p_raw @@ unsupported opnum_dec_str], [p_pretty @@ unsupported opnum_dec_str])) - in fst @@ do_dis () + Right { + opcode = opnum_str; + error = (Printexc.to_string exc) + } + ) + in map_left fst (do_dis ()) in let rec asts opcodes addr = match opcodes with @@ -164,8 +176,14 @@ let do_module (m: Module.t): Module.t = let serialisable: string = let to_list x = `List x in let to_string x = `String x in - let jsoned (asts: string list list) : Yojson.Safe.t = - to_list @@ List.map (fun x -> to_list @@ List.map to_string x) asts in + let jsoned (asts: (string list, dis_error) Either.t list) : Yojson.Safe.t = + let toj (x: (string list, dis_error) Either.t) : Yojson.Safe.t = match x with + | Left sl -> to_list @@ List.map to_string sl + | Right err -> `Assoc [ + ("decode_error", `Assoc [("opcode", (`String err.opcode)); ("error", `String err.error)] ) + ] + in + to_list @@ List.map toj asts in let paired: Yojson.Safe.t = `Assoc ( From 996912fb7461f9d5bd31944ab506828d4cfc66ac Mon Sep 17 00:00:00 2001 From: rina Date: Mon, 16 Dec 2024 16:00:54 +1000 Subject: [PATCH 6/6] use Result instead of Either some module renaming because every library we import shadows Result --- bin/main.ml | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index ca470c2..c68cef1 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,3 +1,5 @@ +module OcamlResult = Result + open Ocaml_protoc_plugin open Gtirb_semantics.IR.Gtirb.Proto open Gtirb_semantics.ByteInterval.Gtirb.Proto @@ -6,7 +8,8 @@ open Gtirb_semantics.Section.Gtirb.Proto open Gtirb_semantics.CodeBlock.Gtirb.Proto open Gtirb_semantics.AuxData.Gtirb.Proto open LibASL -open Either + +module Result = OcamlResult (* TYPES *) @@ -30,7 +33,7 @@ type dis_error = { (* ASLi semantic info for a block *) type ast_block = { auuid : bytes; - asts : ((string list, dis_error) Either.t) list; + asts : ((string list, dis_error) result) list; } (* Wrapper for polymorphic code/data/not-set block pre-rectification *) @@ -126,7 +129,7 @@ let do_module (m: Module.t): Module.t = (* Evaluate each instruction one by one with a new environment for each *) - let to_asli (opcode_be: bytes) (addr : int) : ((string list, dis_error) Either.t) = + let to_asli (opcode_be: bytes) (addr : int) : ((string list, dis_error) result) = let p_raw a = Utils.to_string (Asl_parser_pp.pp_raw_stmt a) |> String.trim in let p_pretty a = Asl_utils.pp_stmt a |> String.trim in let p_byte (b: char) = Printf.sprintf "%02X" (Char.code b) in @@ -141,20 +144,20 @@ let do_module (m: Module.t): Module.t = let opcode_str = String.concat " " List.(map p_byte opcode_list) in let _opcode : bytes = Bytes.of_seq List.(to_seq opcode_list) in - let do_dis () : ((string list * string list), dis_error) Either.t = + let do_dis () : ((string list * string list), dis_error) result = (match Dis.retrieveDisassembly ?address env (Dis.build_env env) opnum_str with - | res -> Left (List.map p_raw res, List.map p_pretty res) + | res -> Ok (List.map p_raw res, List.map p_pretty res) | exception exc -> Printf.eprintf "error during aslp disassembly (unsupported opcode %s, bytes %s):\n\nException : %s\n" opnum_str opcode_str (Printexc.to_string exc); (* Printexc.print_backtrace stderr; *) - Right { + Error { opcode = opnum_str; error = (Printexc.to_string exc) } ) - in map_left fst (do_dis ()) + in Result.map fst (do_dis ()) in let rec asts opcodes addr = match opcodes with @@ -176,10 +179,10 @@ let do_module (m: Module.t): Module.t = let serialisable: string = let to_list x = `List x in let to_string x = `String x in - let jsoned (asts: (string list, dis_error) Either.t list) : Yojson.Safe.t = - let toj (x: (string list, dis_error) Either.t) : Yojson.Safe.t = match x with - | Left sl -> to_list @@ List.map to_string sl - | Right err -> `Assoc [ + let jsoned (asts: (string list, dis_error) result list) : Yojson.Safe.t = + let toj (x: (string list, dis_error) result) : Yojson.Safe.t = match x with + | Ok sl -> to_list @@ List.map to_string sl + | Error err -> `Assoc [ ("decode_error", `Assoc [("opcode", (`String err.opcode)); ("error", `String err.error)] ) ] in