abstracting passthroughs more aggressively

Reviewed By: jberdine

Differential Revision: D3706040

fbshipit-source-id: 9d0f305

infer/src/Makefile

@@ -128,7 +128,7 @@ else
 EXTRA_DEPS = opensource
 endif
 
-DEPENDENCIES = IR backend checkers eradicate harness $(EXTRA_DEPS)
+DEPENDENCIES = IR backend checkers eradicate harness quandary $(EXTRA_DEPS)
 
 # ocamlbuild command with options common to all build targets
 OCAMLBUILD_BASE = rebuild $(OCAMLBUILD_OPTIONS) -j $(NCPU) $(addprefix -I , $(DEPENDENCIES))

infer/src/quandary/Sink.ml

@@ -11,6 +11,7 @@ module type S = sig
   include TraceElem.S
 
   val to_callee : t -> CallSite.t -> t
+
   (** ith param * ith source kind *)
   val get : CallSite.t -> (int * t) list
 end

infer/src/quandary/Trace.ml

@@ -24,70 +24,81 @@ module type S = sig
   include Spec
   type t
 
-  (** get the source of the trace *)
+  (** get the sources of the trace. this should never be empty *)
-  val source : t -> Source.t
+  val sources : t -> Source.Set.t
 
-  (** get the sink of the trace, if any *)
+  (** get the sinks of the trace *)
-  val sink : t -> Sink.t option
+  val sinks : t -> Sink.Set.t
 
-  (** return true if this trace represent a dangerous flow *)
+  (** get the reportable source-sink flows in this trace *)
-  val should_report : t -> bool
+  val get_reports : t -> (Source.t * Sink.t * Passthrough.Set.t) list
 
   (** create a trace from a source *)
   val of_source : Source.t -> t
 
+  (** ad a source to the current trace *)
+  val add_source : Source.t -> t -> t
+
   (** add a sink to the current trace. *)
-  val add_sink : t -> Sink.t -> t
+  val add_sink : Sink.t -> t -> t
 
   val compare : t -> t -> int
+
   val pp : F.formatter -> t -> unit
 end
 
 module Make (Spec : Spec) = struct
   include Spec
 
+  module Sources = Source.Set
+  module Sinks = Sink.Set
+
   type t =
     {
-      source : Source.t; (** last function in the trace that returned tainted data *)
+      sources : Sources.t; (** last functions in the trace that returned tainted data *)
-      sink : Sink.t option;
+      sinks : Sinks.t;
-      (** last callee in the trace that transitively called a tainted function (if any) *)
+      (** last callees in the trace that transitively called a tainted function (if any) *)
       passthroughs : Passthrough.Set.t; (** calls that occurred between source and sink *)
     }
 
   let compare t1 t2 =
-    let compare_sink_opts sink1_opt sink2_opt = match sink1_opt, sink2_opt with
+    Sources.compare t1.sources t2.sources
-      | Some sink1, Some sink2 -> Sink.compare sink1 sink2
+    |> next Sinks.compare t1.sinks t2.sinks
-      | None, None -> 0
-      | Some _, None -> (-1)
-      | None, Some _ -> 1 in
-    Source.compare t1.source t2.source
-    |> next compare_sink_opts t1.sink t2.sink
     |> next Passthrough.Set.compare t1.passthroughs t2.passthroughs
 
   let pp fmt t =
-    let pp_sink_opt fmt = function
-      | None -> F.fprintf fmt "?"
-      | Some sink -> Sink.pp fmt sink in
     F.fprintf
       fmt
       "%a -> %a via %a"
-      Source.pp t.source pp_sink_opt t.sink Passthrough.Set.pp t.passthroughs
+      Sources.pp t.sources Sinks.pp t.sinks Passthrough.Set.pp t.passthroughs
 
-  let source t =
+  let sources t =
-    t.source
+    t.sources
 
-  let sink t =
+  let sinks t =
-    t.sink
+    t.sinks
 
-  let should_report t = match t.sink with
+  let get_reports t =
-    | Some sink -> Spec.should_report t.source sink
+    if Sinks.is_empty t.sinks
-    | None -> false
+    then []
+    else
+      let report_one source sink acc =
+        if Spec.should_report source sink
+        then (source, sink, t.passthroughs) :: acc
+        else acc in
+      Sources.fold (fun source acc -> Sinks.fold (report_one source) t.sinks acc) t.sources []
 
   let of_source source =
+    let sources = Sources.singleton source in
     let passthroughs = Passthrough.Set.empty in
-    let sink = None in
+    let sinks = Sinks.empty in
-    { source; passthroughs; sink; }
+    { sources; passthroughs; sinks; }
+
+  let add_source source t =
+    let sources = Sources.add source t.sources in
+    { t with sources; }
 
-  let add_sink t sink =
+  let add_sink sink t =
-    { t with sink = Some sink; }
+    let sinks = Sinks.add sink t.sinks in
+    { t with sinks; }
 end

infer/src/quandary/TraceElem.ml

@@ -15,12 +15,12 @@ module type S = sig
 
   val call_site : t -> CallSite.t
   val kind : t -> kind
-  val is_empty : t -> bool
 
   val make : kind -> CallSite.t -> t
-  val make_empty : CallSite.t -> t
 
   val compare : t -> t -> int
   val equal : t -> t -> bool
   val pp : F.formatter -> t -> unit
+
+  module Set : PrettyPrintable.PPSet with type elt = t
 end

infer/src/unit/TraceTests.ml

@@ -0,0 +1,107 @@
+(*
+ * Copyright (c) 2016 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ *)
+
+open! Utils
+
+module L = Logging
+module F = Format
+
+module MockTraceElem = struct
+  type kind =
+    | Kind1
+    | Kind2
+
+  type t = kind
+
+  let call_site _ = assert false
+
+  let kind t = t
+
+  let make kind _ = kind
+
+  let compare t1 t2 =
+    match t1, t2 with
+    | Kind1, Kind1 -> 0
+    | Kind1, _ -> (-1)
+    | _, Kind1 -> 1
+    | Kind2, Kind2 -> 0
+
+  let equal t1 t2 =
+    compare t1 t2 = 0
+
+  let pp fmt = function
+    | Kind1 -> F.fprintf fmt "Kind1"
+    | Kind2 -> F.fprintf fmt "Kind2"
+
+  module Set = PrettyPrintable.MakePPSet(struct
+      type nonrec t = t
+      let compare = compare
+      let pp_element = pp
+    end)
+
+  let to_callee _ _ = assert false
+end
+
+module MockSource = struct
+  include MockTraceElem
+
+  let make : kind -> CallSite.t -> t = MockTraceElem.make
+
+  let get _ = assert false
+  let is_footprint _ = assert false
+  let make_footprint _ = assert false
+  let get_footprint_access_path _ = assert false
+  let to_return _ _ = assert false
+end
+
+module MockSink = struct
+  include MockTraceElem
+
+
+  let get _ = assert false
+end
+
+
+module MockTrace = Trace.Make(struct
+    module Source = MockSource
+    module Sink = MockSink
+
+    let should_report source sink =
+      Source.kind source = Sink.kind sink
+  end)
+
+let tests =
+  let open OUnit2 in
+  let get_reports =
+    let get_reports_ _ =
+      let source1 = MockSource.make MockTraceElem.Kind1 CallSite.dummy in
+      let source2 = MockSource.make MockTraceElem.Kind2 CallSite.dummy in
+      let sink1 = MockSink.make MockTraceElem.Kind1 CallSite.dummy in
+      let sink2 = MockSink.make MockTraceElem.Kind2 CallSite.dummy in
+      let trace =
+        MockTrace.of_source source1
+        |> MockTrace.add_source source2
+        |> MockTrace.add_sink sink1
+        |> MockTrace.add_sink sink2 in
+      let reports = MockTrace.get_reports trace in
+
+      assert_equal (IList.length reports) 2;
+      assert_bool
+        "Reports should contain source1 -> sink1"
+        (IList.exists
+           (fun (source, sink, _) -> MockSource.equal source source1 && MockSink.equal sink sink1)
+           reports);
+      assert_bool
+        "Reports should contain source2 -> sink2"
+        (IList.exists
+           (fun (source, sink, _) -> MockSource.equal source source2 && MockSink.equal sink sink2)
+           reports) in
+    "get_reports">::get_reports_ in
+
+  "trace_domain_suite">:::[get_reports]

infer/src/unit/inferunit.ml

@@ -18,12 +18,13 @@ let () =
     AccessPathTests.tests;
     AccessTreeTests.tests;
     AddressTakenTests.tests;
+    BoundedCallTreeTests.tests;
     CopyPropagationTests.tests;
     ProcCfgTests.tests;
     LivenessTests.tests;
     SchedulerTests.tests;
-    BoundedCallTreeTests.tests;
     StacktraceTests.tests;
+    TraceTests.tests;
   ] in
   let test_suite = "all" >::: tests in
   OUnit2.run_test_tt_main test_suite