WIP more tests passing

src/analyzing/AST_to_IL.ml

@@ -446,7 +446,7 @@ and assign env ~g_expr lhs tok rhs_exp =
           let fixme_lval = fresh_lval ~str:"_FIXME" env tok in
           add_instr env (mk_i (Assign (fixme_lval, rhs_exp)) eorig);
           fixme_exp kind any_generic (related_exp g_expr))
-  | G.Container (((G.Tuple | G.Array) as ckind), (tok1, lhss, tok2)) ->
+  | G.Container (((G.Tuple | G.List | G.Array) as ckind), (tok1, lhss, tok2)) ->
       (* TODO: handle cases like [a, b, ...rest] = e *)
       (* E1, ..., En = RHS *)
       (* tmp = RHS*)

src/il/Display_IL.ml

@@ -71,10 +71,9 @@ and string_of_exp e = string_of_exp_kind e.e
 
 let string_of_argument arg =
   match arg with
-  | Unnamed { e = Fetch lval; _ } -> string_of_lval lval
-  | Unnamed _
-  | Named _ ->
-      "_"
+  | Unnamed e
+  | Named (_, e) ->
+      string_of_exp e
 
 let string_of_arguments args =
   List_.map string_of_argument args |> String.concat ","

src/tainting/Dataflow_tainting.ml

@@ -1269,15 +1269,17 @@ and check_tainted_expr env exp : Taints.t * S.shape * Lval_env.t =
         (* TODO *)
         let taints, lval_env =
           union_map_taints_and_vars env
-          (fun env -> function
-            (* FIXME *)
-            | Field (_, e)
-            | Spread e ->
-                check_without_shape env e
-            | Entry (ke, ve) ->
-                let k_taints, lval_env = check_without_shape env ke in
-                let v_taints, lval_env = check_without_shape { env with lval_env } ve in
-                (Taints.union k_taints v_taints, lval_env))
+            (fun env -> function
+              (* FIXME *)
+              | Field (_, e)
+              | Spread e ->
+                  check_without_shape env e
+              | Entry (ke, ve) ->
+                  let k_taints, lval_env = check_without_shape env ke in
+                  let v_taints, lval_env =
+                    check_without_shape { env with lval_env } ve
+                  in
+                  (Taints.union k_taints v_taints, lval_env))
             fields
         in
         (taints, S.Bot (* TODO *), lval_env)
@@ -1351,25 +1353,9 @@ and check_function_call_arguments env args =
 let check_tainted_var env (var : IL.name) : Taints.t * S.shape * Lval_env.t =
   check_tainted_lval env (LV.lval_of_var var)
 
-(* Given a function/method call 'fun_exp'('args_exps'), and an argument
- * spec 'sig_lval' from the taint signature of the called function/method,
- * determine what lvalue corresponds to 'sig_lval'.
- *
- * In the simplest case this just obtains the actual argument:
- * E.g. `lval_of_sig_lval f [x;y;z] [a;b;c] (x,0) = a`
- *
- * The 'sig_lval' may refer to `this` and also have an offset:
- * E.g. `lval_of_sig_lval o.f [] [] (this,-1).x = o.x`
- *)
-let lval_of_sig_lval fun_exp fparams args_exps (sig_lval : T.lval) :
-    (* Besides the 'lval', we also return a "tainted token" pointing to an
-     * identifier in the actual code that relates to 'sig_lval', to be used
-     * in the taint trace.  For example, if we're calling `obj.method` and
-     * `this.x` were tainted, then we would record that taint went through
-     * `obj`. *)
-    (lval * T.tainted_token) option =
+let rev_offset_of_sig_offset offset =
   let os =
-    sig_lval.offset
+    offset
     |> List_.map (function
          | T.Ofld x -> Some { o = Dot x; oorig = NoOrig }
          | T.Oint i ->
@@ -1400,17 +1386,34 @@ let lval_of_sig_lval fun_exp fparams args_exps (sig_lval : T.lval) :
                }
          | T.Oany -> None)
   in
-  let* rev_offset =
-    os
-    |> List.fold_left
-         (fun acc opt_o ->
-           match (acc, opt_o) with
-           | Some acc, Some o -> Some (o :: acc)
-           | _, None
-           | None, _ ->
-               None)
-         (Some [])
-  in
+  os
+  |> List.fold_left
+       (fun acc opt_o ->
+         match (acc, opt_o) with
+         | Some acc, Some o -> Some (o :: acc)
+         | _, None
+         | None, _ ->
+             None)
+       (Some [])
+
+(* Given a function/method call 'fun_exp'('args_exps'), and an argument
+ * spec 'sig_lval' from the taint signature of the called function/method,
+ * determine what lvalue corresponds to 'sig_lval'.
+ *
+ * In the simplest case this just obtains the actual argument:
+ * E.g. `lval_of_sig_lval f [x;y;z] [a;b;c] (x,0) = a`
+ *
+ * The 'sig_lval' may refer to `this` and also have an offset:
+ * E.g. `lval_of_sig_lval o.f [] [] (this,-1).x = o.x`
+ *)
+let lval_of_sig_lval fun_exp fparams args_exps (sig_lval : T.lval) :
+    (* Besides the 'lval', we also return a "tainted token" pointing to an
+     * identifier in the actual code that relates to 'sig_lval', to be used
+     * in the taint trace.  For example, if we're calling `obj.method` and
+     * `this.x` were tainted, then we would record that taint went through
+     * `obj`. *)
+    (lval * T.tainted_token) option =
+  let* rev_offset = rev_offset_of_sig_offset sig_lval.offset in
   let* lval, obj =
     match sig_lval.base with
     | BGlob gvar -> Some ({ base = Var gvar; rev_offset }, gvar)
@@ -1465,15 +1468,36 @@ let lval_of_sig_lval fun_exp fparams args_exps (sig_lval : T.lval) :
   in
   Some (lval, snd obj.ident)
 
+let taints_of_sig_base env fparams args_taints base =
+  match base with
+  | T.BArg pos -> find_pos_in_actual_args args_taints fparams pos
+  | BThis -> None (* TODO *)
+  | BGlob var ->
+      let* (S.Ref (xtaints, shape)) = Lval_env.find_var_opt env.lval_env var in
+      Some (Xtaint.to_taints xtaints, shape)
+
 (* What is the taint denoted by 'sig_lval' ? *)
 let taints_of_sig_lval env fparams fun_exp args_exps
     (args_taints : (Taints.t * S.shape) argument list) (sig_lval : T.lval) =
-  match sig_lval with
-  | { base = BArg pos; offset = [] } ->
-      find_pos_in_actual_args args_taints fparams pos
-  | __else__ ->
+  let { T.base; offset } = sig_lval in
+  match taints_of_sig_base env fparams args_taints base with
+  | Some (taints, shape) when shape <> S.Bot || sig_lval.offset =*= [] -> (
+      match offset with
+      | [] -> Some (taints, shape)
+      | _ :: _ ->
+          let* rev_offset = rev_offset_of_sig_offset offset in
+          let offset = List.rev rev_offset in
+          let* (S.Ref (xtaints, shape)) = S.find_in_shape offset shape in
+          Some (Xtaint.to_taints xtaints, shape))
+  | Some _
+  | None ->
       (* We want to know what's the taint carried by 'arg_exp.x1. ... .xN'. *)
+      Logs.debug (fun m ->
+          m ~tags:debug "taints_of_sig_lval %s -> ?" (T.show_lval sig_lval));
       let* lval, _obj = lval_of_sig_lval fun_exp fparams args_exps sig_lval in
+      Logs.debug (fun m ->
+          m ~tags:debug "taints_of_sig_lval -> %s"
+            (Display_IL.string_of_lval lval));
       let arg_taints, shape, _lval_env = check_tainted_lval env lval in
       Some (arg_taints, shape)
 

src/tainting/Taint_shape.mli

@@ -78,6 +78,7 @@ val union_taints_in_ref : ref -> Taint.taints
 
 val union_taints_in_shape : shape -> Taint.taints
 val find_in_ref : IL.offset list -> ref -> ref option
+val find_in_shape : IL.offset list -> shape -> ref option
 val find_xtaint_ref : IL.offset list -> ref -> Xtaint.t
 val unify_ref_shape : Taint.taints -> shape -> IL.offset list -> ref -> ref
 

src/tainting/Xtaint.mli

@@ -19,4 +19,4 @@ val show : t -> string
 val union : t -> t -> t
 (** Merge xtaints at JOIN nodes of the CFG. *)
 
-val to_taints : t_or_sanitized -> Taint.taints
+val to_taints : [< t | `Sanitized ] -> Taint.taints