[traces] adding Sink.Make functor for easier sink creation

Summary: Let's write sink specifications with less boilerplate too!

Reviewed By: jvillard

Differential Revision: D4357952

fbshipit-source-id: e6610a3

infer/src/checkers/Sink.ml

@@ -9,22 +9,84 @@
 
 open! IStd
 
-type 'a parameter =
+module F = Format
-  { sink : 'a;
+module L = Logging
-    (** sink type of the parameter *)
+
-    index : int;
+module type Kind = sig
-    (** index of the parameter *)
+  include TraceElem.Kind
-    report_reachable : bool;
+
-    (** if true, report if *any* value heap-reachable from the sink parameter is a source.
+  (** return the parameter index and sink kind for the given call site with the given actuals *)
-        if false, report only if the value passed to the sink is itself a source *)
+  val get : Procname.t -> (Exp.t * Typ.t) list -> (t * int * bool) list
-  }
+end
-
-let make_sink_param sink index ~report_reachable =
-  { sink; index; report_reachable; }
 
 module type S = sig
   include TraceElem.S
 
+  type parameter =
+    {
+      sink : t;
+      (** sink type of the parameter *)
+      index : int;
+      (** index of the parameter *)
+      report_reachable : bool;
+      (** if true, report if *any* value heap-reachable from the sink parameter is a source.
+          if false, report only if the value passed to the sink is itself a source *)
+    }
+
   (** return the parameter index and sink kind for the given call site with the given actuals *)
-  val get : CallSite.t -> (Exp.t * Typ.t) list -> t parameter list
+  val get : CallSite.t -> (Exp.t * Typ.t) list -> parameter list
+end
+
+module Make (Kind : Kind) = struct
+  module Kind = Kind
+
+  type t =
+    {
+      kind : Kind.t;
+      site : CallSite.t;
+    } [@@deriving compare]
+
+  type parameter =
+    {
+      sink : t;
+      (** sink type of the parameter *)
+      index : int;
+      (** index of the parameter *)
+      report_reachable : bool;
+      (** if true, report if *any* value heap-reachable from the sink parameter is a source.
+          if false, report only if the value passed to the sink is itself a source *)
+    }
+
+  let equal t1 t2 =
+    compare t1 t2 = 0
+
+  let kind t =
+    t.kind
+
+  let call_site t =
+    t.site
+
+  let make kind site =
+    { kind; site; }
+
+  let make_sink_param sink index ~report_reachable =
+    { sink; index; report_reachable; }
+
+  let get site actuals =
+    IList.map
+      (fun (kind, index, report_reachable) ->
+         make_sink_param (make kind site) index ~report_reachable)
+      (Kind.get (CallSite.pname site) actuals)
+
+  let with_callsite t callee_site =
+    { t with site = callee_site; }
+
+  let pp fmt s =
+    F.fprintf fmt "%a(%a)" Kind.pp s.kind CallSite.pp s.site
+
+  module Set = PrettyPrintable.MakePPSet(struct
+      type nonrec t = t
+      let compare = compare
+      let pp_element = pp
+    end)
 end

infer/src/checkers/Sink.mli

@@ -9,22 +9,29 @@
 
 open! IStd
 
-type 'a parameter =
+module type Kind = sig
-  { sink : 'a;
+  include TraceElem.Kind
-    (** sink type of the parameter *)
-    index : int;
-    (** index of the parameter *)
-    report_reachable : bool;
-    (** if true, report if *any* value heap-reachable from the sink parameter is a source.
-        if false, report only if the value passed to the sink is itself a source *)
-  }
-
-val make_sink_param : 'a -> int -> report_reachable:bool -> 'a parameter
 
+  (** return the parameter index and sink kind for the given call site with the given actuals *)
+  val get : Procname.t -> (Exp.t * Typ.t) list -> (t * int * bool) list
+end
 
 module type S = sig
   include TraceElem.S
 
+  type parameter =
+    {
+      sink : t;
+      (** sink type of the parameter *)
+      index : int;
+      (** index of the parameter *)
+      report_reachable : bool;
+      (** if true, report if *any* value heap-reachable from the sink parameter is a source.
+          if false, report only if the value passed to the sink is itself a source *)
+    }
+
   (** return the parameter index and sink kind for the given call site with the given actuals *)
-  val get : CallSite.t -> (Exp.t * Typ.t) list -> t parameter list
+  val get : CallSite.t -> (Exp.t * Typ.t) list -> parameter list
 end
+
+module Make (Kind : Kind) : S with module Kind = Kind

infer/src/checkers/SinkTrace.ml

@@ -32,6 +32,8 @@ end
 
 module MakeSink(TraceElem : TraceElem.S) = struct
   include TraceElem
+  type parameter = { sink : t; index : int; report_reachable : bool; }
+
   let get _ _ = []
 end
 

infer/src/quandary/CppTrace.ml

@@ -53,60 +53,26 @@ end
 
 module CppSource = Source.Make(Kind)
 
-module CppSink = struct
+module SinkKind = struct
-
-  module Kind = struct
-    type t =
-      | ShellExec (** shell exec function *)
-      | Other (** for testing or uncategorized sinks *)
-    [@@deriving compare]
-
-    let equal snk1 snk2 =
-      compare snk1 snk2 = 0
-
-    let pp fmt = function
-      | ShellExec -> F.fprintf fmt "ShellExec"
-      | Other -> F.fprintf fmt "Other"
-  end
 
   type t =
-    {
+    | ShellExec (** shell exec function *)
-      kind : Kind.t;
+    | Other (** for testing or uncategorized sinks *)
-      site : CallSite.t;
+  [@@deriving compare]
-    } [@@deriving compare]
-
-  let equal t1 t2 =
-    compare t1 t2 = 0
-
-  let kind t =
-    t.kind
-
-  let call_site t =
-    t.site
-
-  let make kind site =
-    { kind; site; }
 
-  let get site actuals =
+  let get pname actuals =
-    let taint_all actuals sink ~report_reachable =
+    let taint_all actuals kind ~report_reachable =
       IList.mapi
-        (fun actual_num _ -> Sink.make_sink_param sink actual_num ~report_reachable)
+        (fun actual_num _ -> kind, actual_num, report_reachable)
         actuals in
-    match CallSite.pname site with
+    match pname with
-    | (Procname.ObjC_Cpp cpp_pname) as pname ->
+    | Procname.C _ ->
-        begin
-          match Procname.objc_cpp_get_class_name cpp_pname, Procname.get_method pname with
-          (* placeholder for real sinks *)
-          | "Namespace here", "method name here" -> []
-          | _ -> []
-        end
-    | (C _ as pname) ->
         begin
           match Procname.to_string pname with
           | "execl" | "execlp" | "execle" | "execv" | "execvp" ->
-              taint_all actuals (make ShellExec site) ~report_reachable:false
+              taint_all actuals ShellExec ~report_reachable:false
           | "__infer_taint_sink" ->
-              [Sink.make_sink_param (make Other site) 0 ~report_reachable:false]
+              [Other, 0, false]
           | _ ->
               []
         end
@@ -115,19 +81,13 @@ module CppSink = struct
     | pname ->
         failwithf "Non-C++ procname %a in C++ analysis@." Procname.pp pname
 
-  let with_callsite t callee_site =
+  let pp fmt = function
-    { t with site = callee_site; }
+    | ShellExec -> F.fprintf fmt "ShellExec"
-
+    | Other -> F.fprintf fmt "Other"
-  let pp fmt s =
-    F.fprintf fmt "%a(%a)" Kind.pp s.kind CallSite.pp s.site
-
-  module Set = PrettyPrintable.MakePPSet(struct
-      type nonrec t = t
-      let compare = compare
-      let pp_element = pp
-    end)
 end
 
+module CppSink = Sink.Make(SinkKind)
+
 include
   Trace.Make(struct
     module Source = CppSource
@@ -135,9 +95,9 @@ include
 
     let should_report source sink =
       match Source.kind source, Sink.kind sink with
-      | Kind.EnvironmentVariable, Sink.Kind.ShellExec ->
+      | EnvironmentVariable, ShellExec ->
           true
-      | Kind.Other, Sink.Kind.Other ->
+      | Other, Other ->
           true
       | _ ->
           false

infer/src/quandary/JavaTrace.ml

@@ -12,9 +12,7 @@ open! IStd
 module F = Format
 module L = Logging
 
-
+module SourceKind = struct
-
-module Kind = struct
   type t =
     | PrivateData (** private user or device-specific data *)
     | Intent
@@ -90,58 +88,34 @@ module Kind = struct
     | Unknown -> F.fprintf fmt "Unknown"
 end
 
-module JavaSource = Source.Make(Kind)
+module JavaSource = Source.Make(SourceKind)
-
-module JavaSink = struct
-
-  module Kind = struct
-    type t =
-      | Intent (** sink that trusts an Intent *)
-      | Logging (** sink that logs one or more of its arguments *)
-      | Other (** for testing or uncategorized sinks *)
-    [@@deriving compare]
-
-    let pp fmt = function
-      | Intent -> F.fprintf fmt "Intent"
-      | Logging -> F.fprintf fmt "Logging"
-      | Other -> F.fprintf fmt "Other"
-  end
 
+module SinkKind = struct
   type t =
-    {
+    | Intent (** sink that trusts an Intent *)
-      kind : Kind.t;
+    | Logging (** sink that logs one or more of its arguments *)
-      site : CallSite.t;
+    | Other (** for testing or uncategorized sinks *)
-    } [@@deriving compare]
+  [@@deriving compare]
-
-  let kind t =
-    t.kind
-
-  let call_site t =
-    t.site
-
-  let make kind site =
-    { kind; site; }
 
-  let get site actuals =
+  let get pname actuals =
     (* taint all the inputs of [pname]. for non-static procedures, taints the "this" parameter only
        if [taint_this] is true. *)
-    let taint_all ?(taint_this=false) kind site ~report_reachable =
+    let taint_all ?(taint_this=false) kind ~report_reachable =
       let actuals_to_taint, offset =
-        if Procname.java_is_static (CallSite.pname site) || taint_this
+        if Procname.java_is_static pname || taint_this
         then actuals, 0
         else IList.tl actuals, 1 in
-      let sink = make kind site in
       IList.mapi
-        (fun param_num _ -> Sink.make_sink_param sink (param_num + offset) ~report_reachable)
+        (fun param_num _ -> kind, param_num + offset, report_reachable)
         actuals_to_taint in
     (* taint the nth non-"this" parameter (0-indexed) *)
-    let taint_nth n kind site ~report_reachable =
+    let taint_nth n kind ~report_reachable =
-      let first_index = if Procname.java_is_static (CallSite.pname site) then n else n + 1 in
+      let first_index = if Procname.java_is_static pname then n else n + 1 in
-      [Sink.make_sink_param (make kind site) first_index ~report_reachable] in
+      [kind, first_index, report_reachable] in
-    match CallSite.pname site with
+    match pname with
-    | Procname.Java pname ->
+    | Procname.Java java_pname ->
         begin
-          match Procname.java_get_class_name pname, Procname.java_get_method pname with
+          match Procname.java_get_class_name java_pname, Procname.java_get_method java_pname with
           | ("android.app.Activity" | "android.content.ContextWrapper" | "android.content.Context"),
             ("bindService" |
              "sendBroadcast" |
@@ -157,9 +131,9 @@ module JavaSink = struct
              "startActivityIfNeeded" |
              "startNextMatchingActivity" |
              "startService") ->
-              taint_nth 0 Intent site ~report_reachable:true
+              taint_nth 0 Intent ~report_reachable:true
           | "android.app.Activity", ("startActivityFromChild" | "startActivityFromFragment") ->
-              taint_nth 1 Intent site ~report_reachable:true
+              taint_nth 1 Intent ~report_reachable:true
           | "android.content.Intent",
             ("fillIn" |
              "makeMainSelectorActivity" |
@@ -176,30 +150,25 @@ module JavaSink = struct
              "setSelector" |
              "setType" |
              "setTypeAndNormalize") ->
-              taint_all Intent site ~report_reachable:true
+              taint_all Intent ~report_reachable:true
           | "android.util.Log", ("e" | "println" | "w" | "wtf") ->
-              taint_all Logging site ~report_reachable:true
+              taint_all Logging ~report_reachable:true
           | "com.facebook.infer.builtins.InferTaint", "inferSensitiveSink" ->
-              [Sink.make_sink_param (make Other site) 0 ~report_reachable:false]
+              [Other, 0, false]
           | _ ->
               []
         end
     | pname when BuiltinDecl.is_declared pname -> []
     | pname -> failwithf "Non-Java procname %a in Java analysis@." Procname.pp pname
 
-  let with_callsite t callee_site =
+  let pp fmt = function
-    { t with site = callee_site; }
+    | Intent -> F.fprintf fmt "Intent"
-
+    | Logging -> F.fprintf fmt "Logging"
-  let pp fmt s =
+    | Other -> F.fprintf fmt "Other"
-    F.fprintf fmt "%a(%a)" Kind.pp s.kind CallSite.pp s.site
-
-  module Set = PrettyPrintable.MakePPSet(struct
-      type nonrec t = t
-      let compare = compare
-      let pp_element = pp
-    end)
 end
 
+module JavaSink = Sink.Make(SinkKind)
+
 include
   Trace.Make(struct
     module Source = JavaSource
@@ -207,10 +176,10 @@ include
 
     let should_report source sink =
       match Source.kind source, Sink.kind sink with
-      | Kind.Other, Sink.Kind.Other
+      | Other, Other
-      | Kind.PrivateData, Sink.Kind.Logging ->
+      | PrivateData, Logging ->
           true
-      | Kind.Intent, Sink.Kind.Intent ->
+      | Intent, Intent ->
           true
       | _ ->
           false

infer/src/quandary/TaintAnalysis.ml

@@ -198,7 +198,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
     let add_sinks sinks actuals ({ Domain.access_tree; id_map; } as astate) proc_data callee_site =
       let f_resolve_id = resolve_id id_map in
       (* add [sink] to the trace associated with the [formal_num]th actual *)
-      let add_sink_to_actual access_tree_acc (sink_param : TraceDomain.Sink.t Sink.parameter) =
+      let add_sink_to_actual access_tree_acc (sink_param : TraceDomain.Sink.parameter) =
         let actual_exp, actual_typ = IList.nth actuals sink_param.index in
         match AccessPath.of_lhs_exp actual_exp actual_typ ~f_resolve_id with
         | Some actual_ap_raw ->

infer/src/unit/TaintTests.ml

@@ -12,30 +12,7 @@ open! IStd
 module F = Format
 
 module MockTrace = Trace.Make(struct
-    module MockTraceElem = struct
+    module MockTraceElem = CallSite
-      type t = CallSite.t
-
-      module Kind = struct
-        type t = unit
-        let compare _ _ = assert false
-        let pp _ _ = assert false
-      end
-
-      let call_site t = t
-      let kind _ = ()
-      let make _ site = site
-      let compare = CallSite.compare
-      let pp = CallSite.pp
-
-      let with_callsite t _ = t
-
-      module Set = PrettyPrintable.MakePPSet(struct
-          type nonrec t = t
-          let compare = compare
-          let pp_element = pp
-        end)
-    end
-
     module Source = Source.Make(struct
         include MockTraceElem
 
@@ -50,14 +27,14 @@ module MockTrace = Trace.Make(struct
           []
       end)
 
-    module Sink = struct
+    module Sink = Sink.Make(struct
-      include MockTraceElem
+        include MockTraceElem
 
-      let get site _ =
+        let get pname _ =
-        if String.is_prefix ~prefix:"SINK" (Procname.to_string (CallSite.pname site))
+          if String.is_prefix ~prefix:"SINK" (Procname.to_string pname)
-        then [Sink.make_sink_param site 0 ~report_reachable:false]
+          then [CallSite.make pname Location.dummy, 0, false]
-        else []
+          else []
-    end
+      end)
 
     let should_report _ _ = false
   end)

infer/src/unit/TraceTests.ml

@@ -63,6 +63,7 @@ end
 
 module MockSink = struct
   include MockTraceElem
+  type parameter = { sink : t; index : int; report_reachable : bool; }
 
   let get _ = assert false