adds the specification command (#1197)

The command will print the ogre specification of the file.  Also adds
the `Image.find_loader` function that enables direct access to the
image loaders.

Author: ivg

lib/bap/bap.mli

@@ -5492,6 +5492,14 @@ module Std : sig
     (** [register_loader ~name backend] registers new loader. *)
     val register_loader : name:string -> (module Loader) -> unit
 
+    (** [find_loader name] lookups the loader registered under the
+        given [name].
+
+        @since 2.2.0
+    *)
+    val find_loader : string -> (module Loader) option
+
+
     (** lists all registered backends  *)
     val available_backends : unit -> string list
 

lib/bap_image/bap_image.ml

@@ -182,8 +182,9 @@ let map_region data {locn={addr}; info={off; len; endian}} =
 
 let static_view segments = function {addr} as locn ->
 match Table.find_addr segments addr with
-| None -> Result.failf "region is not mapped to memory" ()
 | Some (segmem,_) -> mem_of_locn segmem locn
+| None -> Result.failf "region %a is not mapped to memory"
+            Sexp.pp_hum (sexp_of_location locn) ()
 
 let add_sym segments memory (symtab : symtab)
     ({name; locn=entry; info={extra_locns=locns}} as sym) =
@@ -327,6 +328,8 @@ let segment_of_symbol {segment_of_symbol = lazy f} = f
 let register_loader ~name backend =
   Hashtbl.add_exn backends ~key:name ~data:backend
 
+let find_loader = Hashtbl.find backends
+
 module Scheme = struct
   open Ogre.Type
   type addr = int64

lib/bap_image/bap_image.mli

@@ -72,7 +72,7 @@ module type Loader = sig
 end
 
 val register_loader : name:string -> (module Loader) -> unit
-
+val find_loader : string -> (module Loader) option
 val available_backends : unit -> string list
 
 

oasis/specification

@@ -0,0 +1,13 @@
+Flag specification
+  Description: Enable the specification command
+  Default: false
+
+Library specification_plugin
+  Build$: flag(everything) || flag(specification)
+  XMETADescription: implements the specification command
+  Path: plugins/specification
+  FindlibName: bap-plugin-specification
+  CompiledObject: best
+  BuildDepends: bap, core_kernel, bap-main, ogre
+  InternalModules: Specification_main
+  XMETAExtraLines: tags="command, specification"

plugins/specification/specification_main.ml

@@ -0,0 +1,52 @@
+let doc = "
+# DESCRIPTION
+
+Displays information about the binary. The information is printed in
+the OGRE format.
+"
+
+open Core_kernel
+open Bap_main
+open Bap.Std
+
+type problem =
+  | Unknown_loader of string
+  | Loader_error of Error.t
+
+type Extension.Error.t += Fail of problem
+
+
+let input = Extension.Command.argument
+    ~doc:"The input file" Extension.Type.("FILE" %: string =? "a.out" )
+
+let loader =
+  Extension.Command.parameter
+    ~doc:"Use the specified loader.
+          Use the loader `raw' to load unstructured files"
+    Extension.Type.(string =? "llvm")
+    "loader"
+
+let problem is = Error (Fail is)
+
+let () = Extension.Command.(begin
+    declare "specification" (args $input $loader)
+      ~doc
+      ~requires:["loader"]
+  end) @@ fun input loader _ctxt ->
+  match Image.find_loader loader with
+  | None -> problem (Unknown_loader loader)
+  | Some (module Load) -> match Load.from_file input with
+    | Ok (Some spec) -> Format.printf "%a@\n%!" Ogre.Doc.pp spec; Ok ()
+    | Ok None -> Ok ()
+    | Error err -> problem (Loader_error err)
+
+let string_of_problem = function
+  | Unknown_loader name ->
+    sprintf "The loader `%s' is not registers, known loaders are: %s."
+      name (Image.available_backends () |> String.concat ~sep:", ")
+  | Loader_error err ->
+    sprintf "Failed to load the binary: %s"  (Error.to_string_hum err)
+
+let () = Extension.Error.register_printer @@ function
+  | Fail p -> Some (string_of_problem p)
+  | _ -> None