v0.9.3

Introduction
------------

This release is based on a feedback from our users
(including myself). The main goal of this release is to
increase the usability of BAP.

Major changes
-------------

1. `Bitvector` (aka `Word`, aka `Addr`) now provides all `Integer`
interface without any monads right at the toplevel of the module.
In other words, now you can write: `Word.(x + y)`.

2. `Bitvector.Int` is renamed to `Bitvector.Int_exn` so that it don't
clobber the real `Int` module

3. All BIL is now consolidated in one module named `Bil`. This module
contains everything, including constructors for statements, expressions
casts, binary and unary operations. It also includes functional
constructors, that are now written by hand and, thus, don't suffer from
syntactic clashes with keywords. There're also a plenty of other
functions and new operators, available from the new `Bap_helpers`
module, see later. Old modules, like `Expr`, `Stmt`, etc are still
available, they implement `Regular` interface for corresponding types.

4. New feature: visitor classes to traverse and transform the AST.
Writing a pattern matching code every time you need to traverse or map
the BIL AST is error prone and time-consuming. This visitors, do all the
traversing for you, allowing you to override default behavior. Some
handy algorithms, that use visitors are provided in an internal
`Bap_helpers` module, that is included into resulting `Bil`
module. Several optimizations were added to `bap-objdump` utility, like
constant propogation, inlining, pruning unused variables and resolving
addresses to symbols.

5. Insn interface now provides predicates to query insn classes, this
predicates use BIL if available.

6. Disam interface now provides `linear_sweep` function.

Minor Changes
-------------

There're some bug fixes, the most important is fixing `bitsub`.
Now it is renamed to `extract`, as it can output words of greater
size, and it also handles signed extraction correctly.

The drastic `disassemble_file` function now checks for errors.

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        bap
-Version:     0.9.1
+Version:     0.9.3
 Synopsis:    BAP Core Library
 Authors:     BAP Team
 Maintainers: Ivan Gotovchits <[email protected]>
@@ -118,6 +118,7 @@ Library types
                    Bap_bitvector,
                    Bap_common,
                    Bap_exp,
+                   Bap_helpers,
                    Bap_int_conversions,
                    Bap_integer,
                    Bap_integer_intf,
@@ -126,7 +127,8 @@ Library types
                    Bap_size,
                    Bap_stmt,
                    Bap_type,
-                   Bap_var
+                   Bap_var,
+                   Bap_visitor
 
 Library conceval
   Path: lib/bap_types

lib/bap_disasm/bap_disasm.ml

@@ -7,6 +7,7 @@ open Bap_disasm_types
 open Image_internal_std
 
 module Rec = Bap_disasm_rec
+module Dis = Bap_disasm_basic
 module Block = Bap_disasm_block
 module Insn = Bap_disasm_insn
 module Image = Bap_image
@@ -34,8 +35,6 @@ type disasm = {
   mems_of_insn : (insn -> mem seq) Lazy.t;
 }
 
-type t = disasm
-
 let insns_of_blocks bs =
   Seq.(Table.elements bs >>| Block.insns |> join)
 
@@ -64,7 +63,6 @@ let fail error mem = {
   memmap = Table.singleton mem (Failed error);
 }
 
-
 let mem_of_rec_error = function
   | `Failed_to_disasm mem -> mem
   | `Failed_to_lift (mem,insn,err) -> mem
@@ -112,6 +110,26 @@ let lifter_of_arch = function
   | #Arch.arm -> Some Bap_disasm_arm_lifter.insn
   | _ -> None
 
+let linear_sweep arch mem : (mem * insn option) list Or_error.t =
+  Dis.create ~backend:"llvm" (Arch.to_string arch) >>| fun dis ->
+  let dis = Dis.store_asm dis in
+  let dis = Dis.store_kinds dis in
+  Dis.run dis mem
+    ~init:[] ~return:ident ~stopped:(fun s _ ->
+        Dis.stop s (Dis.insns s)) |>
+  List.map ~f:(function
+      | mem, None -> mem,None
+      | mem, Some insn -> match lifter_of_arch arch with
+        | None -> mem, Some (Insn.of_basic insn)
+        | Some lift -> match lift mem insn with
+          | Ok bil -> mem, Some (Insn.of_basic ~bil insn)
+          | _ -> mem, Some (Insn.of_basic insn))
+
+
+let linear_sweep_exn arch mem = ok_exn (linear_sweep arch mem)
+
+
+
 let disassemble ?roots arch mem =
   let lifter = lifter_of_arch arch in
   match Rec.run ?lifter ?roots arch mem with
@@ -140,12 +158,23 @@ let disassemble_image ?roots image =
       else dis)
 
 let disassemble_file ?roots filename =
-  match Image.create filename with
-  | Error err -> empty
-  | Ok (image,_warns) ->          (* todo: add warnings *)
-    disassemble_image ?roots image
+  Image.create filename >>= fun (img,errs) ->
+  let dis = disassemble_image ?roots img in
+  let memmap =
+    List.fold ~init:dis.memmap errs ~f:(fun memmap e ->
+        let e = `Failed e in
+        Table.map memmap ~f:(function
+            | Failed e' -> Failed (`Errors (e,e'))
+            | Decoded (insn,None) -> Decoded (insn,Some e)
+            | Decoded (insn,Some e') ->
+              Decoded (insn, Some (`Errors(e,e'))))) in
+  return {dis with memmap}
+
+let disassemble_file_exn ?roots filename =
+  disassemble_file ?roots filename |> ok_exn
 
 module Disasm = struct
+  type t = disasm
   let insns t = insns_of_blocks t.blocks
   let blocks t = t.blocks
   let insn_at_mem {memmap} m =

lib/bap_disasm/bap_disasm.mli

@@ -16,7 +16,6 @@ open Image_internal_std
     memory region. To create values of this type use [disassemble]
     function *)
 type disasm
-type t = disasm
 
 (** values of type [insn] represents machine instructions decoded
     from the given piece of memory *)
@@ -36,22 +35,34 @@ type block = Bap_disasm_block.t with compare, sexp_of
 
     The returned value will contain all memory reachable from the
     given set of roots, at our best knowledge. *)
-val disassemble : ?roots:addr list -> arch -> mem -> t
+val disassemble : ?roots:addr list -> arch -> mem -> disasm
 
 (** [disassemble_image image] disassemble given image.
     Will take executable sections of the image and disassemble it,
     applying [disassemble] function. If no roots are specified, then
     symbol table will be used as a source of roots. If file doesn't
     contain one, then entry point will be used.
 *)
-val disassemble_image : ?roots:addr list -> Bap_image.t -> t
+val disassemble_image : ?roots:addr list -> Bap_image.t -> disasm
 
 (** [disassemble_file ?roots path] takes a path to a binary and
     disassembles it  *)
-val disassemble_file : ?roots:addr list -> string -> t
+val disassemble_file : ?roots:addr list -> string -> disasm Or_error.t
+
+(** [disassemble_file ?roots path] takes a path to a binary and
+    disassembles it  *)
+val disassemble_file_exn : ?roots:addr list -> string -> disasm
+
+(** [linear_sweep arch mem] will perform a linear sweep disassembly on
+    the specified memory [mem] *)
+val linear_sweep : arch -> mem -> (mem * insn option) list Or_error.t
+val linear_sweep_exn : arch -> mem -> (mem * insn option) list
+
 
 (** Disassembled program  *)
 module Disasm : sig
+  type t = disasm
+
   (** returns all instructions that was successfully decoded in an
       ascending order of their addresses. Each instruction is
       accompanied with its block of memory. *)

lib/bap_disasm/bap_disasm_arm_bit.ml

@@ -18,7 +18,7 @@ let wordm x = Ok (Word.of_int x ~width:32)
 let extend ~dest ~src ?src2 sign size ~rot cond =
   let rot = assert_imm _here_ rot in
   let dest = assert_reg _here_ dest in
-  let amount = match Word.Int.((!$rot * wordm 8)) with
+  let amount = match Word.Int_err.((!$rot * wordm 8)) with
     | Ok amount -> amount
     | Error err -> fail _here_ "failed to obtain amount" in
   let rotated, (_ : exp) =
@@ -28,7 +28,7 @@ let extend ~dest ~src ?src2 sign size ~rot cond =
       Shift.lift_c ~src:(exp_of_op src)
         `ROR ~shift:(Exp.int amount) reg32_t in
   let extracted =
-    Exp.(cast Cast.low (bits_of_size size) rotated) in
+    Bil.(cast low (bits_of_size size) rotated) in
   let extent = cast_of_sign sign 32 extracted in
   let final = match src2 with
     | Some s2 -> Exp.(exp_of_op s2 + extent)

lib/bap_disasm/bap_disasm_arm_flags.ml

@@ -31,7 +31,7 @@ let set_sub s1 s2 r t =
 
 let set_adc s1 s2 r t =
   let sum_with_carry =
-    let extend = Exp.cast Exp.Cast.unsigned (bitlen t + 1) in
+    let extend = Bil.(cast unsigned) (bitlen t + 1) in
     Exp.(extend s1 + extend s2 + extend (var Env.cf)) in
   Stmt.move Env.cf (msb sum_with_carry) :: set_vnzf_add s1 s2 r t
 

lib/bap_disasm/bap_disasm_arm_lifter.ml

@@ -304,7 +304,7 @@ let lift_bits mem ops (insn : Arm.Insn.bits ) =
       assn temp Exp.(load (var mem) src2 LittleEndian `r8);
       Stmt.move mem
         Exp.(store (var mem) src2 (extract 7 0 src1) LittleEndian `r8);
-      assn dest Exp.(cast Cast.unsigned 32 (var temp));
+      assn dest Exp.(cast unsigned 32 (var temp));
     ] cond
 
   (* Pack half *)
@@ -984,7 +984,7 @@ let lift_special ops insn =
 
   | `MRS, [|Reg dest; cond; _|] ->
     let get_bits flag src lsb =
-      Exp.(src lor (cast Cast.unsigned 32 (var flag) lsl int32 lsb)) in
+      Exp.(src lor (cast unsigned 32 (var flag) lsl int32 lsb)) in
     let d = Env.of_reg dest in
     let vd = Exp.var d in
     exec [
@@ -1046,7 +1046,7 @@ let arm_ops ops = try_with (arm_ops_exn ops)
 let insn_exn mem insn =
   let open Arm.Insn in
   let name = Basic.Insn.name insn in
-  Memory.(Addr.Int.(!$(max_addr mem) - !$(min_addr mem)))
+  Memory.(Addr.Int_err.(!$(max_addr mem) - !$(min_addr mem)))
   >>= Word.to_int >>= fun s -> Size.of_int ((s+1) * 8) >>= fun size ->
   Memory.get ~scale:(size ) mem >>| fun word ->
   match Arm.Insn.create insn with

lib/bap_disasm/bap_disasm_arm_mem.ml

@@ -83,7 +83,7 @@ let lift_r  ~(dst1 : Var.t) ?(dst2 : Var.t option) ~(base : Var.t)
     let trunc = match size with
       | B | H ->
         let n = if size = B then 8 else 16 in
-        [Stmt.move temp Exp.(cast Cast.low n (var dst1))]
+        [Stmt.move temp Exp.(cast low n (var dst1))]
       | W | D -> [] in
     let stores =
       let m1,m2 = Env.(new_mem "m1", new_mem "m2") in
@@ -137,7 +137,7 @@ let lift_m dest_list base mode update operation =
       | (Stmt.Jmp exp) -> stmts @ [Stmt.Jmp exp]
       |   _  -> stmt :: move_jump_to_end stmts in
   move_jump_to_end (List.concat [
-    [Stmt.move o_base Exp.(var base)];
-    List.mapi ~f:create_access dest_list;
-    writeback
-  ])
+      [Stmt.move o_base Exp.(var base)];
+      List.mapi ~f:create_access dest_list;
+      writeback
+    ])

lib/bap_disasm/bap_disasm_arm_mov.ml

@@ -79,7 +79,7 @@ let lift ?dest src1 ?src2 (itype ) ?sreg ?simm raw ~wflag cond =
     | `SUB -> Exp.(s1 - s2)
     | `RSB -> Exp.(s2 - s1)
     | `ADD -> Exp.(s1 + s2)
-    | `ADC -> Exp.(s1 + s2 + cast Cast.unsigned 32 vcf)
-    | `SBC -> Exp.(s1 + lnot s2 + cast Cast.unsigned 32 vcf)
-    | `RSC -> Exp.(lnot s1 + s2 + cast Cast.unsigned 32 vcf) in
+    | `ADC -> Exp.(s1 + s2 + cast unsigned 32 vcf)
+    | `SBC -> Exp.(s1 + lnot s2 + cast unsigned 32 vcf)
+    | `RSC -> Exp.(lnot s1 + s2 + cast unsigned 32 vcf) in
   exec (stmts @ [assn dest oper]) ~flags ~wflag cond

lib/bap_disasm/bap_disasm_arm_mul.ml

@@ -36,7 +36,7 @@ let lift_smul ~dest ?hidest ~src1 ~src2 ?accum ?hiaccum ?q size cond =
   let dest = assert_reg _here_ dest in
   let src1 = exp_of_op src1 in
   let src2 = exp_of_op src2 in
-  let excast hi lo s = Exp.(cast Cast.signed 64 (extract hi lo s)) in
+  let excast hi lo s = Exp.(cast signed 64 (extract hi lo s)) in
   let top  = excast 31 16 in
   let bot  = excast 15 0 in
   let top32 = excast 47 16 in
@@ -50,13 +50,13 @@ let lift_smul ~dest ?hidest ~src1 ~src2 ?accum ?hiaccum ?q size cond =
     | TT -> top src1 * top src2
     | D  -> top src1 * top src2 + bot src1 * bot src2
     | DX -> top src1 * bot src2 + bot src1 * top src2
-    | WB -> top32 (cast Cast.signed 64 (src1 * bot src2))
-    | WT -> top32 (cast Cast.signed 64 (src1 * top src2))  in
+    | WB -> top32 (cast signed 64 (src1 * bot src2))
+    | WT -> top32 (cast signed 64 (src1 * top src2))  in
   let result =
     let open Exp in
     match accum, hiaccum with
     | None,   None     -> result
-    | Some a, None     -> result + cast Cast.signed 64 (exp_of_op a)
+    | Some a, None     -> result + cast signed 64 (exp_of_op a)
     | Some a, Some hia -> result + concat (exp_of_op hia) (exp_of_op a)
     | _ -> fail _here_ "Cannot specify only a hi accumulator" in
   let qflag =

lib/bap_disasm/bap_disasm_arm_shift.ml

@@ -24,7 +24,7 @@ let shift_of_word op = match Word.to_int op with
 let shift_c ~src shift_type ~shift t =
   let bits = bitlen t in
   let bits_e = Exp.int (Word.of_int bits ~width:bits) in
-  let nth_bit n e = Exp.(cast Cast.low 1 (e lsr n)) in
+  let nth_bit n e = Exp.(cast low 1 (e lsr n)) in
   let e1 = Exp.int (Word.one bits) in
   match shift_type with
   | `ASR ->
@@ -49,7 +49,7 @@ let shift_c ~src shift_type ~shift t =
     shifted, carry
   | `RRX ->
     let ret1 = Exp.(src lsr e1) in
-    let carryin = Exp.(cast Cast.unsigned bits (var Env.cf) lsl (bits_e - e1)) in
+    let carryin = Exp.(cast unsigned bits (var Env.cf) lsl (bits_e - e1)) in
     let shifted = Exp.(ret1 lor carryin) in
     let carry = nth_bit Exp.(int (Word.zero 0)) src in
     shifted, carry
@@ -65,9 +65,11 @@ let i_shift ~src shift_type t =
   let three = Word.of_int 3 ~width in
   (* lower three bits are type*)
   let r =
-    Word.Int.(!$shift_type land !$mask) >>| shift_of_word >>= fun shift_t ->
+    Word.Int_err.(!$shift_type land !$mask) >>| shift_of_word >>=
+    fun shift_t ->
     (* other bits are immediate *)
-    Word.Int.((!$shift_type land (lnot !$mask)) lsr !$three) >>= fun shift_amt ->
+    Word.Int_err.((!$shift_type land (lnot !$mask)) lsr !$three) >>=
+    fun shift_amt ->
     return (shift_t, shift_amt) in
   match r with
   | Error err -> fail _here_ "%s" Error.(to_string_hum err)
@@ -89,12 +91,13 @@ let mem_shift ~src shift typ =
   let word = Word.of_int ~width in
   let wordm n = Ok (word n) in
   let shift_typ w =
-    Word.Int.((!$w land wordm 0xE000) lsr wordm 13) >>| shift_of_word in
+    Word.Int_err.((!$w land wordm 0xE000) lsr wordm 13) >>|
+    shift_of_word in
   (* Gets the shift amount from the immediate *)
-  let shift_amt w = Word.Int.(!$w land wordm 0xFFF) >>| Exp.int in
+  let shift_amt w = Word.Int_err.(!$w land wordm 0xFFF) >>| Exp.int in
   (* Converts the shift to a negative if the negative bit is set *)
   let to_neg w exp =
-    if Word.Int.(wordm 0x1000 land !$w = wordm 0x1000) then
+    if Word.Int_err.(wordm 0x1000 land !$w = wordm 0x1000) then
       Exp.(int (Word.ones width) * exp)
     else
       exp in

lib/bap_disasm/bap_disasm_arm_utils.ml

@@ -81,12 +81,12 @@ let exp_of_op = function
   | Op.Imm word -> Exp.int word
 
 let cast_type = function
-  | Signed -> Exp.Cast.signed
-  | Unsigned -> Exp.Cast.unsigned
+  | Signed -> Exp.signed
+  | Unsigned -> Exp.unsigned
 
 let cast_of_sign sign size exp = Exp.cast (cast_type sign) size exp
 
 
 
-let msb r = Exp.(cast Cast.high 1 r)
+let msb r = Exp.(cast high 1 r)
 let zero ty = Exp.int (Word.zero (bitlen ty))

lib/bap_disasm/bap_disasm_basic.ml

@@ -137,7 +137,7 @@ module Imm = struct
 
   let to_word t ~width =
     let n = to_int64 t in
-    match Word.bitsub ~hi:(width-1) (Word.of_int64 n) with
+    match Word.extract ~hi:(width-1) (Word.of_int64 n) with
     | Ok word -> Some word
     | Error _ -> None