[quandary] delegate handling of call to HIL

Reviewed By: jeremydubreil

Differential Revision: D4950905

fbshipit-source-id: ea35d83
master
Sam Blackshear 8 years ago committed by Facebook Github Bot
parent 80030c8de7
commit 3258bc2ec4

@ -16,7 +16,7 @@ module type Kind = sig
include TraceElem.Kind include TraceElem.Kind
(** return the parameter index and sink kind for the given call site with the given actuals *) (** return the parameter index and sink kind for the given call site with the given actuals *)
val get : Typ.Procname.t -> (Exp.t * Typ.t) list -> Tenv.t -> (t * int * bool) list val get : Typ.Procname.t -> HilExp.t list -> Tenv.t -> (t * int * bool) list
end end
module type S = sig module type S = sig
@ -34,7 +34,7 @@ module type S = sig
} }
(** return the parameter index and sink kind for the given call site with the given actuals *) (** 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 -> Tenv.t -> parameter list val get : CallSite.t -> HilExp.t list -> Tenv.t -> parameter list
end end
module Make (Kind : Kind) = struct module Make (Kind : Kind) = struct

@ -13,7 +13,7 @@ module type Kind = sig
include TraceElem.Kind include TraceElem.Kind
(** return the parameter index and sink kind for the given call site with the given actuals *) (** return the parameter index and sink kind for the given call site with the given actuals *)
val get : Typ.Procname.t -> (Exp.t * Typ.t) list -> Tenv.t -> (t * int * bool) list val get : Typ.Procname.t -> HilExp.t list -> Tenv.t -> (t * int * bool) list
end end
module type S = sig module type S = sig
@ -31,7 +31,7 @@ module type S = sig
} }
(** return the parameter index and sink kind for the given call site with the given actuals *) (** 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 -> Tenv.t -> parameter list val get : CallSite.t -> HilExp.t list -> Tenv.t -> parameter list
end end
module Make (Kind : Kind) : S with module Kind = Kind module Make (Kind : Kind) : S with module Kind = Kind

@ -136,9 +136,9 @@ let of_lhs_exp lhs_exp typ ~(f_resolve_id : Var.t -> Raw.t option) =
let append (base, old_accesses) new_accesses = let append (base, old_accesses) new_accesses =
base, old_accesses @ new_accesses base, old_accesses @ new_accesses
let with_base_var var = function let with_base base = function
| Exact ((_, base_typ), accesses) -> Exact ((var, base_typ), accesses) | Exact (_, accesses) -> Exact (base, accesses)
| Abstracted ((_, base_typ), accesses) -> Abstracted ((var, base_typ), accesses) | Abstracted (_, accesses) -> Abstracted (base, accesses)
let rec is_prefix_path path1 path2 = let rec is_prefix_path path1 path2 =
if phys_equal path1 path2 if phys_equal path1 path2

@ -73,7 +73,7 @@ val append : Raw.t -> access list -> Raw.t
(** swap base of existing access path for [base_var] (e.g., `with_base_bvar x y.f.g` produces (** swap base of existing access path for [base_var] (e.g., `with_base_bvar x y.f.g` produces
`x.f.g` *) `x.f.g` *)
val with_base_var : Var.t -> t -> t val with_base : base -> t -> t
(** return true if [ap1] is a prefix of [ap2]. returns true for equal access paths *) (** return true if [ap1] is a prefix of [ap2]. returns true for equal access paths *)
val is_prefix : Raw.t -> Raw.t -> bool val is_prefix : Raw.t -> Raw.t -> bool

@ -24,8 +24,12 @@ include
| _ -> assert false | _ -> assert false
let handle_unknown_call pname ret_typ_opt actuals tenv = let handle_unknown_call pname ret_typ_opt actuals tenv =
let types_match typ class_string tenv = match typ.Typ.desc with let get_receiver_typ tenv = function
| Typ.Tptr ({desc=Tstruct original_typename}, _) -> | HilExp.AccessPath access_path -> AccessPath.Raw.get_typ access_path tenv
| _ -> None in
let types_match typ class_string tenv =
match typ with
| Some ({ Typ.desc=Typ.Tptr ({desc=Tstruct original_typename}, _) }) ->
PatternMatch.supertype_exists PatternMatch.supertype_exists
tenv tenv
(fun typename _ -> String.equal (Typ.Name.name typename) class_string) (fun typename _ -> String.equal (Typ.Name.name typename) class_string)
@ -51,8 +55,9 @@ include
| classname, _, Some ({Typ.desc=Tptr _ | Tstruct _}) -> | classname, _, Some ({Typ.desc=Tptr _ | Tstruct _}) ->
begin begin
match actuals with match actuals with
| (_, receiver_typ) :: _ | receiver_exp :: _
when not is_static && types_match receiver_typ classname tenv -> when not is_static &&
types_match (get_receiver_typ tenv receiver_exp) classname tenv ->
(* if the receiver and return type are the same, propagate to both. we're (* if the receiver and return type are the same, propagate to both. we're
assuming the call is one of the common "builder-style" methods that both assuming the call is one of the common "builder-style" methods that both
updates and returns the receiver *) updates and returns the receiver *)

@ -85,7 +85,8 @@ module Make (TaintSpecification : TaintSpec.S) = struct
Var.of_id (Ident.create_footprint Ident.name_spec formal_index) Var.of_id (Ident.create_footprint Ident.name_spec formal_index)
let make_footprint_access_path formal_index access_path = let make_footprint_access_path formal_index access_path =
AccessPath.with_base_var (make_footprint_var formal_index) access_path let _, base_typ = fst (AccessPath.extract access_path) in
AccessPath.with_base (make_footprint_var formal_index, base_typ) access_path
module TransferFunctions (CFG : ProcCfg.S) = struct module TransferFunctions (CFG : ProcCfg.S) = struct
module CFG = CFG module CFG = CFG
@ -143,9 +144,9 @@ module Make (TaintSpecification : TaintSpec.S) = struct
| AccessPath access_path -> exp_get_node_ ~abstracted access_path access_tree proc_data | AccessPath access_path -> exp_get_node_ ~abstracted access_path access_tree proc_data
| _ -> None | _ -> None
let add_source source ret_id ret_typ access_tree = let add_source source ret_base access_tree =
let trace = TraceDomain.of_source source in let trace = TraceDomain.of_source source in
let id_ap = AccessPath.Exact (AccessPath.of_id ret_id ret_typ) in let id_ap = AccessPath.Exact (ret_base, []) in
TaintDomain.add_trace id_ap trace access_tree TaintDomain.add_trace id_ap trace access_tree
let endpoints = String.Set.of_list (QuandaryConfig.Endpoint.of_json Config.quandary_endpoints) let endpoints = String.Set.of_list (QuandaryConfig.Endpoint.of_json Config.quandary_endpoints)
@ -194,18 +195,19 @@ module Make (TaintSpecification : TaintSpec.S) = struct
List.iter ~f:report_error (TraceDomain.get_reportable_paths ~cur_site trace ~trace_of_pname) List.iter ~f:report_error (TraceDomain.get_reportable_paths ~cur_site trace ~trace_of_pname)
let add_sinks sinks actuals ({ Domain.access_tree; id_map; } as astate) proc_data callee_site = let add_sinks sinks actuals ({ Domain.access_tree; } as astate) proc_data callee_site =
let f_resolve_id = resolve_id id_map in
(* add [sink] to the trace associated with the [formal_index]th actual *) (* add [sink] to the trace associated with the [formal_index]th actual *)
let add_sink_to_actual access_tree_acc (sink_param : TraceDomain.Sink.parameter) = let add_sink_to_actual access_tree_acc (sink_param : TraceDomain.Sink.parameter) =
let actual_exp, actual_typ = List.nth_exn actuals sink_param.index in match List.nth_exn actuals sink_param.index with
match AccessPath.of_lhs_exp actual_exp actual_typ ~f_resolve_id with | HilExp.AccessPath actual_ap_raw ->
| Some actual_ap_raw ->
let actual_ap = let actual_ap =
let is_array_typ = match actual_typ.Typ.desc with let is_array_typ =
| Typ.Tptr ({desc=Tarray _}, _) (* T* [] (Java-style) *) match AccessPath.Raw.get_typ actual_ap_raw proc_data.ProcData.tenv with
| Some
({ desc=(
Typ.Tptr ({desc=Tarray _}, _) (* T* [] (Java-style) *)
| Tptr ({desc=Tptr _}, _) (* T** (C/C++ style 1) *) | Tptr ({desc=Tptr _}, _) (* T** (C/C++ style 1) *)
| Tarray _ (* T[] C/C++ style 2 *) -> | Tarray _ )}) (* T[] C/C++ style 2 *) ->
true true
| _ -> | _ ->
false in false in
@ -222,14 +224,14 @@ module Make (TaintSpecification : TaintSpec.S) = struct
| None -> | None ->
access_tree_acc access_tree_acc
end end
| None -> | _ ->
access_tree_acc in access_tree_acc in
let access_tree' = List.fold ~f:add_sink_to_actual ~init:access_tree sinks in let access_tree' = List.fold ~f:add_sink_to_actual ~init:access_tree sinks in
{ astate with Domain.access_tree = access_tree'; } { astate with Domain.access_tree = access_tree'; }
let apply_summary let apply_summary
ret_opt ret_opt
actuals (actuals : HilExp.t list)
summary summary
(astate_in : Domain.astate) (astate_in : Domain.astate)
(proc_data : FormalMap.t ProcData.t) (proc_data : FormalMap.t ProcData.t)
@ -238,15 +240,15 @@ module Make (TaintSpecification : TaintSpec.S) = struct
let get_caller_ap formal_ap = let get_caller_ap formal_ap =
let apply_return ret_ap = match ret_opt with let apply_return ret_ap = match ret_opt with
| Some (ret_id, _) -> AccessPath.with_base_var (Var.of_id ret_id) ret_ap | Some base_var -> AccessPath.with_base base_var ret_ap
| None -> failwith "Have summary for retval, but no ret id to bind it to!" in | None -> failwith "Have summary for retval, but no ret id to bind it to!" in
let get_actual_ap formal_index = let get_actual_ap formal_index =
let f_resolve_id = resolve_id astate_in.id_map in
List.nth actuals formal_index |>
Option.value_map Option.value_map
~f:(fun (actual_exp, actual_typ) -> ~f:(function
AccessPath.of_lhs_exp actual_exp actual_typ ~f_resolve_id ) | HilExp.AccessPath access_path -> Some access_path
~default:None in | _ -> None)
~default:None
(List.nth actuals formal_index) in
let project ~formal_ap ~actual_ap = let project ~formal_ap ~actual_ap =
let projected_ap = AccessPath.append actual_ap (snd (AccessPath.extract formal_ap)) in let projected_ap = AccessPath.append actual_ap (snd (AccessPath.extract formal_ap)) in
if AccessPath.is_exact formal_ap if AccessPath.is_exact formal_ap
@ -338,38 +340,9 @@ module Make (TaintSpecification : TaintSpec.S) = struct
~default:TaintDomain.empty_node in ~default:TaintDomain.empty_node in
TaintDomain.add_node (AccessPath.Exact lhs_access_path) rhs_node astate.access_tree in TaintDomain.add_node (AccessPath.Exact lhs_access_path) rhs_node astate.access_tree in
{ astate with access_tree; } { astate with access_tree; }
| _ ->
astate in
let f_resolve_id id = | Call (ret_opt, Direct called_pname, actuals, call_flags, callee_loc) ->
try Some (IdAccessPathMapDomain.find id astate.id_map) let handle_unknown_call callee_pname access_tree =
with Not_found -> None in
match HilInstr.of_sil ~f_resolve_id instr with
| Bind (id, access_path) ->
let id_map = IdAccessPathMapDomain.add id access_path astate.id_map in
{ astate with id_map; }
| Unbind ids ->
let id_map =
List.fold
~f:(fun acc id -> IdAccessPathMapDomain.remove id acc) ~init:astate.id_map ids in
{ astate with id_map; }
| Instr hil_instr ->
exec_instr_ hil_instr
| Ignore ->
astate
let exec_instr (astate : Domain.astate) (proc_data : FormalMap.t ProcData.t) _ instr =
let f_resolve_id = resolve_id astate.id_map in
match instr with
| Sil.Store _ ->
exec_hil_instr astate proc_data instr
| Sil.Call (Some _, Const (Cfun callee_pname), _, _, _)
when BuiltinDecl.is_declared callee_pname ->
if Typ.Procname.equal callee_pname BuiltinDecl.__cast
then exec_hil_instr astate proc_data instr
else astate
| Sil.Call (ret, Const (Cfun called_pname), actuals, callee_loc, call_flags) ->
let handle_unknown_call callee_pname astate =
let is_variadic = match callee_pname with let is_variadic = match callee_pname with
| Typ.Procname.Java pname -> | Typ.Procname.Java pname ->
begin begin
@ -379,12 +352,13 @@ module Make (TaintSpecification : TaintSpec.S) = struct
end end
| _ -> false in | _ -> false in
let should_taint_typ typ = is_variadic || TaintSpecification.is_taintable_type typ in let should_taint_typ typ = is_variadic || TaintSpecification.is_taintable_type typ in
let exp_join_traces trace_acc (exp, typ) = let exp_join_traces trace_acc exp =
match exp_get_node ~abstracted:true exp typ astate proc_data with match hil_exp_get_node ~abstracted:true exp access_tree proc_data with
| Some (trace, _) -> TraceDomain.join trace trace_acc | Some (trace, _) -> TraceDomain.join trace trace_acc
| None -> trace_acc in | None -> trace_acc in
let propagate_to_access_path access_path actuals (astate : Domain.astate) = let propagate_to_access_path access_path actuals access_tree =
let initial_trace = access_path_get_trace access_path astate.access_tree proc_data in let initial_trace =
access_path_get_trace access_path access_tree proc_data in
let trace_with_propagation = let trace_with_propagation =
List.fold ~f:exp_join_traces ~init:initial_trace actuals in List.fold ~f:exp_join_traces ~init:initial_trace actuals in
let filtered_sources = let filtered_sources =
@ -399,40 +373,30 @@ module Make (TaintSpecification : TaintSpec.S) = struct
(TraceDomain.sources trace_with_propagation) in (TraceDomain.sources trace_with_propagation) in
if TraceDomain.Sources.is_empty filtered_sources if TraceDomain.Sources.is_empty filtered_sources
then then
astate access_tree
else else
let trace' = TraceDomain.update_sources trace_with_propagation filtered_sources in let trace' = TraceDomain.update_sources trace_with_propagation filtered_sources in
let access_tree = TaintDomain.add_trace access_path trace' access_tree in
TaintDomain.add_trace access_path trace' astate.access_tree in
{ astate with Domain.access_tree; } in
let handle_unknown_call_ astate_acc propagation = let handle_unknown_call_ astate_acc propagation =
match propagation, actuals, ret with match propagation, actuals, ret_opt with
| _, [], _ -> | _, [], _ ->
astate_acc astate_acc
| TaintSpec.Propagate_to_return, actuals, Some (ret_id, ret_typ) -> | TaintSpec.Propagate_to_return, actuals, Some ret_ap ->
let ret_ap = AccessPath.Exact (AccessPath.of_id ret_id ret_typ) in propagate_to_access_path (AccessPath.Exact (ret_ap, [])) actuals astate_acc
propagate_to_access_path ret_ap actuals astate_acc
| TaintSpec.Propagate_to_receiver, | TaintSpec.Propagate_to_receiver,
(receiver_exp, receiver_typ) :: (_ :: _ as other_actuals), AccessPath receiver_ap :: (_ :: _ as other_actuals),
_ -> _ ->
begin propagate_to_access_path (AccessPath.Exact receiver_ap) other_actuals astate_acc
match AccessPath.of_lhs_exp receiver_exp receiver_typ ~f_resolve_id with
| Some ap ->
propagate_to_access_path (AccessPath.Exact ap) other_actuals astate_acc
| None ->
(* this can happen when (for example) the receiver is a string literal *)
astate_acc
end
| _ -> | _ ->
astate_acc in astate_acc in
let propagations = let propagations =
TaintSpecification.handle_unknown_call TaintSpecification.handle_unknown_call
callee_pname callee_pname
(Option.map ~f:snd ret) (Option.map ~f:snd ret_opt)
actuals actuals
proc_data.tenv in proc_data.tenv in
List.fold ~f:handle_unknown_call_ ~init:astate propagations in List.fold ~f:handle_unknown_call_ ~init:access_tree propagations in
let analyze_call astate_acc callee_pname = let analyze_call astate_acc callee_pname =
let call_site = CallSite.make callee_pname callee_loc in let call_site = CallSite.make callee_pname callee_loc in
@ -444,9 +408,9 @@ module Make (TaintSpecification : TaintSpec.S) = struct
let source = TraceDomain.Source.get call_site proc_data.tenv in let source = TraceDomain.Source.get call_site proc_data.tenv in
let astate_with_source = let astate_with_source =
match source, ret with match source, ret_opt with
| Some source, Some (ret_id, ret_typ) -> | Some source, Some ret_exp ->
let access_tree = add_source source ret_id ret_typ astate_with_sink.access_tree in let access_tree = add_source source ret_exp astate_with_sink.access_tree in
{ astate_with_sink with access_tree; } { astate_with_sink with access_tree; }
| Some _, None -> | Some _, None ->
L.err L.err
@ -464,10 +428,11 @@ module Make (TaintSpecification : TaintSpec.S) = struct
else else
match Summary.read_summary proc_data.pdesc callee_pname with match Summary.read_summary proc_data.pdesc callee_pname with
| Some summary -> | Some summary ->
apply_summary ret actuals summary astate_with_source proc_data call_site apply_summary ret_opt actuals summary astate_with_source proc_data call_site
| None -> | None ->
handle_unknown_call callee_pname astate_with_source in let access_tree =
handle_unknown_call callee_pname astate_with_source.access_tree in
{ astate with access_tree; } in
Domain.join astate_acc astate_with_summary in Domain.join astate_acc astate_with_summary in
(* highly polymorphic call sites stress reactive mode too much by using too much memory. (* highly polymorphic call sites stress reactive mode too much by using too much memory.
@ -480,14 +445,33 @@ module Make (TaintSpecification : TaintSpec.S) = struct
called_pname :: call_flags.cf_targets called_pname :: call_flags.cf_targets
else else
begin begin
L.out "Skipping highly polymorphic call site for %a@." Typ.Procname.pp called_pname; L.out
"Skipping highly polymorphic call site for %a@." Typ.Procname.pp called_pname;
[called_pname] [called_pname]
end in end in
(* for each possible target of the call, apply the summary. join all results together *) (* for each possible target of the call, apply the summary. join all results together *)
List.fold ~f:analyze_call ~init:Domain.empty targets List.fold ~f:analyze_call ~init:Domain.empty targets
| Sil.Call _ ->
failwith "Unimp: non-pname call expressions"
| _ -> | _ ->
astate in
let f_resolve_id id =
try Some (IdAccessPathMapDomain.find id astate.id_map)
with Not_found -> None in
match HilInstr.of_sil ~f_resolve_id instr with
| Bind (id, access_path) ->
let id_map = IdAccessPathMapDomain.add id access_path astate.id_map in
{ astate with id_map; }
| Unbind ids ->
let id_map =
List.fold
~f:(fun acc id -> IdAccessPathMapDomain.remove id acc) ~init:astate.id_map ids in
{ astate with id_map; }
| Instr hil_instr ->
exec_instr_ hil_instr
| Ignore ->
astate
let exec_instr (astate : Domain.astate) (proc_data : FormalMap.t ProcData.t) _ instr =
exec_hil_instr astate proc_data instr exec_hil_instr astate proc_data instr
end end

@ -23,7 +23,7 @@ module type S = sig
(** return a summary for handling an unknown call at the given site with the given return type (** return a summary for handling an unknown call at the given site with the given return type
and actuals *) and actuals *)
val handle_unknown_call : val handle_unknown_call :
Typ.Procname.t -> Typ.t option -> (Exp.t * Typ.t) list -> Tenv.t -> handle_unknown list Typ.Procname.t -> Typ.t option -> HilExp.t list -> Tenv.t -> handle_unknown list
(** return true if the given typ can be tainted *) (** return true if the given typ can be tainted *)
val is_taintable_type : Typ.t -> bool val is_taintable_type : Typ.t -> bool

Loading…
Cancel
Save