[taint] Extend the definition of taint value to take into account whe…

…n the value comes from fields of or pointed to by sink values

Summary: This will be useful to not use the value histories in this case because that may cause false negatives. See further up the stack.

Reviewed By: geralt-encore

Differential Revision: D50126323

fbshipit-source-id: 309ab759a10b46a9bcc32e131dcd373f758019e0

infer/src/pulse/PulseDiagnostic.ml

@@ -665,9 +665,7 @@ let get_message_and_suggestion diagnostic =
       ( if TaintItem.equal source sink then
           F.asprintf "%s. Value is tainted by %a" policy_description TaintItem.pp source
         else
-          let flows_to =
-            match sink.TaintItem.origin with TaintItem.SetField -> "" | _ -> " flows to"
-          in
+          let flows_to = if TaintItem.is_set_field_origin sink then "" else " flows to" in
           if DecompilerExpr.is_unknown expr then
             F.asprintf "%s. Value is tainted by %a and%s %a" policy_description TaintItem.pp source
               flows_to TaintItem.pp sink

infer/src/pulse/PulseReport.ml

@@ -35,8 +35,8 @@ let report tenv ~is_suppressed ~latent proc_desc err_log diagnostic =
     let extras =
       let copy_type = get_copy_type diagnostic |> Option.map ~f:Typ.to_string in
       let taint_source, taint_sink =
-        let proc_name_of_taint TaintItem.{value} =
-          Format.asprintf "%a" TaintItem.pp_value_plain value
+        let proc_name_of_taint taint_item =
+          Format.asprintf "%a" TaintItem.pp_value_plain (TaintItem.value_of_taint taint_item)
         in
         match diagnostic with
         | TaintFlow {flow_kind= FlowFromSource; source= source, _} ->

infer/src/pulse/PulseTaintItem.ml

@@ -62,15 +62,72 @@ let pp_value_plain f value =
       F.fprintf f "%a" Fieldname.pp field_name
 
 
-type t = {kinds: TaintConfig.Kind.t list; value: value; origin: origin} [@@deriving compare, equal]
+type value_tuple =
+  | Basic of {value: value; origin: origin}
+  | FieldOf of {name: string; value_tuple: value_tuple}
+  | PointedToBy of {value_tuple: value_tuple}
+[@@deriving compare, equal]
+
+let rec pp_value_tuple fmt value_tuple =
+  match value_tuple with
+  | Basic {value; origin} ->
+      F.fprintf fmt "%a %a" pp_origin origin pp_value value
+  | FieldOf {value_tuple} | PointedToBy {value_tuple} ->
+      F.fprintf fmt "%a" pp_value_tuple value_tuple
+
 
-let pp fmt {kinds; value; origin} =
-  F.fprintf fmt "%a %a with kind%s %a" pp_origin origin pp_value value
+type t = {kinds: TaintConfig.Kind.t list; value_tuple: value_tuple} [@@deriving compare, equal]
+
+let pp fmt {value_tuple; kinds} =
+  F.fprintf fmt "%a with kind%s %a" pp_value_tuple value_tuple
     (match kinds with [_] -> "" | _ -> "s")
     (Pp.comma_seq TaintConfig.Kind.pp)
     kinds
 
 
-let is_argument_origin {origin} =
+let is_argument_origin {value_tuple} =
   let rec aux = function Argument _ -> true | FieldOfValue {origin} -> aux origin | _ -> false in
-  aux origin
+  let rec is_argument value_tuple =
+    match value_tuple with
+    | Basic {origin} ->
+        aux origin
+    | FieldOf {value_tuple} | PointedToBy {value_tuple} ->
+        is_argument value_tuple
+  in
+  is_argument value_tuple
+
+
+let is_set_field_origin {value_tuple} =
+  let rec aux = function SetField -> true | FieldOfValue {origin} -> aux origin | _ -> false in
+  let rec is_set_field value_tuple =
+    match value_tuple with
+    | Basic {origin} ->
+        aux origin
+    | FieldOf {value_tuple} | PointedToBy {value_tuple} ->
+        is_set_field value_tuple
+  in
+  is_set_field value_tuple
+
+
+let value_of_taint {value_tuple} =
+  let rec value_of value_tuple =
+    match value_tuple with
+    | Basic {value} ->
+        value
+    | FieldOf {value_tuple} | PointedToBy {value_tuple} ->
+        value_of value_tuple
+  in
+  value_of value_tuple
+
+
+let field_of_origin {value_tuple; kinds} fieldname =
+  let rec field_of_origin value_tuple =
+    match value_tuple with
+    | Basic {value; origin} ->
+        Basic {value; origin= FieldOfValue {name= fieldname; origin}}
+    | FieldOf {name; value_tuple} ->
+        FieldOf {name; value_tuple= field_of_origin value_tuple}
+    | PointedToBy {value_tuple} ->
+        PointedToBy {value_tuple= field_of_origin value_tuple}
+  in
+  {value_tuple= field_of_origin value_tuple; kinds}

infer/src/pulse/PulseTaintItem.mli

@@ -25,7 +25,13 @@ type value =
   | TaintProcedure of Procname.t
 [@@deriving compare, equal]
 
-type t = {kinds: TaintConfig.Kind.t list; value: value; origin: origin} [@@deriving compare, equal]
+type value_tuple =
+  | Basic of {value: value; origin: origin}
+  | FieldOf of {name: string; value_tuple: value_tuple}
+  | PointedToBy of {value_tuple: value_tuple}
+[@@deriving compare, equal]
+
+type t = {kinds: TaintConfig.Kind.t list; value_tuple: value_tuple} [@@deriving compare, equal]
 
 val pp_value : F.formatter -> value -> unit
 
@@ -34,3 +40,9 @@ val pp_value_plain : F.formatter -> value -> unit
 val pp : F.formatter -> t -> unit
 
 val is_argument_origin : t -> bool
+
+val is_set_field_origin : t -> bool
+
+val value_of_taint : t -> value
+
+val field_of_origin : t -> string -> t

infer/src/pulse/PulseTaintItemMatcher.ml

@@ -219,7 +219,9 @@ let match_field_target matches actual potential_taint_value : taint_match list =
     let origin : TaintItem.origin =
       match matcher.field_target with GetField -> GetField | SetField -> SetField
     in
-    let taint = {TaintItem.value= potential_taint_value; origin; kinds= matcher.kinds} in
+    let taint =
+      {TaintItem.value_tuple= Basic {value= potential_taint_value; origin}; kinds= matcher.kinds}
+    in
     {taint; value_origin; typ; exp= Some exp} :: acc
   in
   List.fold matches ~init:[] ~f:(fun acc (matcher : TaintConfig.Unit.field_unit) ->
@@ -329,11 +331,7 @@ let move_taint_to_field tenv path location potential_taint_value taint_match fie
         in
         L.d_printfln "match! tainting field %s with type %a" fieldname (Typ.pp_full Pp.text)
           field_typ ;
-        let taint =
-          TaintItem.
-            { taint_match.taint with
-              origin= FieldOfValue {name= fieldname; origin= taint_match.taint.origin} }
-        in
+        let taint = TaintItem.field_of_origin taint_match.taint fieldname in
         ( astate (* TODO(arr): replace with a proper value path *)
         , Some {taint; value_origin= ret_value; typ= field_typ; exp= None} )
       in
@@ -361,7 +359,10 @@ let match_procedure_target tenv astate matches path location return_opt ~has_add
             match return_as_actual with
             | Some actual ->
                 let astate, acc = acc in
-                let taint = {TaintItem.value= potential_taint_value; origin= ReturnValue; kinds} in
+                let taint =
+                  { TaintItem.value_tuple= Basic {value= potential_taint_value; origin= ReturnValue}
+                  ; kinds }
+                in
                 let value_origin, typ, exp = actual in
                 (astate, {taint; value_origin; typ; exp} :: acc)
             | None ->
@@ -375,7 +376,9 @@ let match_procedure_target tenv astate matches path location return_opt ~has_add
                 Stack.find_opt return astate
                 |> Option.fold ~init:acc ~f:(fun (_, tainted) return_value ->
                        let taint =
-                         {TaintItem.value= potential_taint_value; origin= ReturnValue; kinds}
+                         { TaintItem.value_tuple=
+                             Basic {value= potential_taint_value; origin= ReturnValue}
+                         ; kinds }
                        in
                        let value_origin =
                          ValueOrigin.OnStack {var= return; addr_hist= return_value}
@@ -392,7 +395,9 @@ let match_procedure_target tenv astate matches path location return_opt ~has_add
               L.d_printfln_escaped "match! tainting actual #%d with type %a" i (Typ.pp_full Pp.text)
                 actual_typ ;
               let taint =
-                {TaintItem.value= potential_taint_value; origin= Argument {index= i}; kinds}
+                { TaintItem.value_tuple=
+                    Basic {value= potential_taint_value; origin= Argument {index= i}}
+                ; kinds }
               in
               (astate, {taint; value_origin= actual_value_origin; typ= actual_typ; exp} :: tainted)
               )
@@ -408,7 +413,9 @@ let match_procedure_target tenv astate matches path location return_opt ~has_add
               instance_reference
             in
             let taint =
-              {TaintItem.value= potential_taint_value; origin= InstanceReference; kinds}
+              { TaintItem.value_tuple=
+                  Basic {value= potential_taint_value; origin= InstanceReference}
+              ; kinds }
             in
             let astate, tainted = acc in
             (astate, {taint; value_origin; typ; exp= Some exp} :: tainted)

infer/src/pulse/PulseTaintOperations.ml

@@ -252,7 +252,7 @@ let taint_allocation tenv path location ~typ_desc ~alloc_desc ~allocator (v, his
                     let proc_name = Procname.from_string_c_fun alloc_desc in
                     let value = TaintItem.TaintProcedure proc_name in
                     let origin = TaintItem.Allocation {typ= type_name} in
-                    {TaintItem.kinds; value; origin}
+                    {TaintItem.kinds; value_tuple= Basic {value; origin}}
                   in
                   let hist =
                     ValueHistory.sequence
@@ -602,19 +602,21 @@ let check_flows_wrt_sink ?(policy_violations_reported = IntSet.empty) path locat
           ((policy_violations_reported, astate), sanitizers) ) )
 
 
-let should_ignore_all_flows_to potential_taint_value =
+let rec should_ignore_all_flows_to (potential_taint_value : TaintItem.value_tuple) =
   match potential_taint_value with
-  | TaintItem.TaintProcedure proc_name ->
+  | Basic {value= TaintProcedure proc_name} ->
       Procname.is_objc_dealloc proc_name || BuiltinDecl.is_declared proc_name
-  | _ ->
+  | Basic _ ->
       false
+  | FieldOf {value_tuple} | PointedToBy {value_tuple} ->
+      should_ignore_all_flows_to value_tuple
 
 
 let taint_sinks path location tainted astate =
   let aux () =
     PulseResult.list_fold tainted ~init:astate
       ~f:(fun astate TaintItemMatcher.{taint= sink; value_origin} ->
-        if should_ignore_all_flows_to sink.value then Ok astate
+        if should_ignore_all_flows_to sink.value_tuple then Ok astate
         else
           let v, history = ValueOrigin.addr_hist value_origin in
           let sink_trace = Trace.Immediate {location; history} in