You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

398 lines
12 KiB

(*
* Copyright (c) 2013-present, Facebook, Inc.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
(** Module for Pattern matching. *)
let type_is_object typ =
match typ.Typ.desc with
| Tptr ({desc= Tstruct name}, _) ->
Typ.Name.equal name Typ.Name.Java.java_lang_object
| _ ->
false
(** Holds iff the predicate holds on a supertype of the named type, including the type itself *)
let rec supertype_exists tenv pred name =
match Tenv.lookup tenv name with
| Some ({supers} as struct_typ) ->
pred name struct_typ || List.exists ~f:(fun name -> supertype_exists tenv pred name) supers
| None ->
false
let rec supertype_find_map_opt tenv f name =
match f name with
| None -> (
match Tenv.lookup tenv name with
| Some {supers} ->
List.find_map ~f:(supertype_find_map_opt tenv f) supers
| None ->
None )
| result ->
result
(** return true if [typ0] <: [typ1] *)
let is_subtype tenv name0 name1 =
Typ.Name.equal name0 name1
|| supertype_exists tenv (fun name _ -> Typ.Name.equal name name1) name0
let is_subtype_of_str tenv cn1 classname_str =
let typename = Typ.Name.Java.from_string classname_str in
is_subtype tenv cn1 typename
let implements interface tenv typename =
let is_interface s _ = String.equal interface (Typ.Name.name s) in
supertype_exists tenv is_interface (Typ.Name.Java.from_string typename)
let implements_iterator = implements "java.util.Iterator"
let implements_collection = implements "java.util.Collection"
(** The type the method is invoked on *)
let get_this_type proc_attributes =
match proc_attributes.ProcAttributes.formals with (_, t) :: _ -> Some t | _ -> None
let type_get_direct_supertypes tenv (typ: Typ.t) =
match typ.desc with
| Tptr ({desc= Tstruct name}, _) | Tstruct name -> (
match Tenv.lookup tenv name with Some {supers} -> supers | None -> [] )
| _ ->
[]
let type_get_class_name {Typ.desc} =
match desc with Typ.Tptr (typ, _) -> Typ.name typ | _ -> None
let type_get_annotation tenv (typ: Typ.t) : Annot.Item.t option =
match typ.desc with
| Tptr ({desc= Tstruct name}, _) | Tstruct name -> (
match Tenv.lookup tenv name with Some {annots} -> Some annots | None -> None )
| _ ->
None
let rec get_type_name {Typ.desc} =
match desc with
| Typ.Tstruct name ->
Typ.Name.name name
| Typ.Tptr (t, _) ->
get_type_name t
| _ ->
"_"
let get_field_type_name tenv (typ: Typ.t) (fieldname: Typ.Fieldname.t) : string option =
match typ.desc with
| Tstruct name | Tptr ({desc= Tstruct name}, _) -> (
match Tenv.lookup tenv name with
| Some {fields} -> (
match List.find ~f:(function fn, _, _ -> Typ.Fieldname.equal fn fieldname) fields with
| Some (_, ft, _) ->
Some (get_type_name ft)
| None ->
None )
| None ->
None )
| _ ->
None
let java_get_const_type_name (const: Const.t) : string =
match const with
| Const.Cstr _ ->
"java.lang.String"
| Const.Cint _ ->
"java.lang.Integer"
| Const.Cfloat _ ->
"java.lang.Double"
| _ ->
"_"
let get_vararg_type_names tenv (call_node: Procdesc.Node.t) (ivar: Pvar.t) : string list =
(* Is this the node creating ivar? *)
let initializes_array instrs =
instrs
|> Instrs.find_map ~f:(function
| Sil.Store (Exp.Lvar iv, _, Exp.Var t2, _) when Pvar.equal ivar iv ->
Some t2
| _ ->
None )
|> Option.exists ~f:(fun t2 ->
Instrs.exists instrs ~f:(function
| Sil.Call ((t1, _), Exp.Const (Const.Cfun pn), _, _, _) ->
Ident.equal t1 t2
&& Typ.Procname.equal pn (Typ.Procname.from_string_c_fun "__new_array")
| _ ->
false ) )
in
(* Get the type name added to ivar or None *)
let added_type_name instrs =
let nvar_type_name nvar =
instrs
|> Instrs.find_map ~f:(function
| Sil.Load (nv, e, t, _) when Ident.equal nv nvar ->
Some (e, t)
| _ ->
None )
|> Option.bind ~f:(function
| Exp.Lfield (_, id, t), _ ->
get_field_type_name tenv t id
| _, t ->
Some (get_type_name t) )
in
let added_nvar array_nvar =
instrs
|> Instrs.find_map ~f:(function
| Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _)
when Ident.equal iv array_nvar ->
Some (nvar_type_name nvar)
| Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _)
when Ident.equal iv array_nvar ->
Some (Some (java_get_const_type_name c))
| _ ->
None )
|> Option.join
in
let array_nvar =
instrs
|> Instrs.find_map ~f:(function
| Sil.Load (nv, Exp.Lvar iv, _, _) when Pvar.equal iv ivar ->
Some nv
| _ ->
None )
|> Option.bind ~f:added_nvar
in
array_nvar
in
(* Walk nodes backward until definition of ivar, adding type names *)
let rec type_names acc node =
let instrs = Procdesc.Node.get_instrs node in
if initializes_array instrs then acc
else
match Procdesc.Node.get_preds node with
| [n] -> (
match added_type_name instrs with
| Some name ->
type_names (name :: acc) n
| None ->
type_names acc n )
| _ ->
raise Caml.Not_found
in
type_names [] call_node
let is_getter pname_java =
Str.string_match (Str.regexp "get*") (Typ.Procname.Java.get_method pname_java) 0
let type_is_class typ =
match typ.Typ.desc with
| Tptr ({desc= Tstruct _}, _) ->
true
| Tptr ({desc= Tarray _}, _) ->
true
| Tstruct _ ->
true
| _ ->
false
let initializer_classes =
List.map ~f:Typ.Name.Java.from_string
[ "android.app.Activity"
; "android.app.Application"
; "android.app.Fragment"
; "android.app.Service"
; "android.support.v4.app.Fragment"
; "junit.framework.TestCase" ]
let initializer_methods = ["onActivityCreated"; "onAttach"; "onCreate"; "onCreateView"; "setUp"]
(** Check if the type has in its supertypes from the initializer_classes list. *)
let type_has_initializer (tenv: Tenv.t) (t: Typ.t) : bool =
let is_initializer_class typename _ =
List.mem ~equal:Typ.Name.equal initializer_classes typename
in
match t.desc with
| Typ.Tstruct name | Tptr ({desc= Tstruct name}, _) ->
supertype_exists tenv is_initializer_class name
| _ ->
false
(** Check if the method is one of the known initializer methods. *)
let method_is_initializer (tenv: Tenv.t) (proc_attributes: ProcAttributes.t) : bool =
match get_this_type proc_attributes with
| Some this_type ->
if type_has_initializer tenv this_type then
match proc_attributes.ProcAttributes.proc_name with
| Typ.Procname.Java pname_java ->
let mname = Typ.Procname.Java.get_method pname_java in
List.exists ~f:(String.equal mname) initializer_methods
| _ ->
false
else false
| None ->
false
(** Get the vararg values by looking for array assignments to the pvar. *)
let java_get_vararg_values node pvar idenv =
let values_of_instr acc = function
| Sil.Store (Exp.Lindex (array_exp, _), _, content_exp, _)
when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv array_exp) ->
(* Each vararg argument is an assignment to a pvar denoting an array of objects. *)
content_exp :: acc
| _ ->
acc
in
let values_of_node acc n =
Procdesc.Node.get_instrs n |> Instrs.fold ~f:values_of_instr ~init:acc
in
match Errdesc.find_program_variable_assignment node pvar with
| Some (node', _) ->
Procdesc.fold_slope_range node' node ~f:values_of_node ~init:[]
| None ->
[]
let proc_calls resolve_attributes pdesc filter : (Typ.Procname.t * ProcAttributes.t) list =
let res = ref [] in
let do_instruction _ instr =
match instr with
| Sil.Call (_, Exp.Const (Const.Cfun callee_pn), _, _, _) -> (
match resolve_attributes callee_pn with
| Some callee_attributes ->
if filter callee_pn callee_attributes then res := (callee_pn, callee_attributes) :: !res
| None ->
() )
| _ ->
()
in
let do_node node =
let instrs = Procdesc.Node.get_instrs node in
Instrs.iter ~f:(do_instruction node) instrs
in
let nodes = Procdesc.get_nodes pdesc in
List.iter ~f:do_node nodes ;
List.rev !res
let override_find ?(check_current_type= true) f tenv proc_name =
let method_name = Typ.Procname.get_method proc_name in
let is_override pname =
(* Note: very coarse! TODO: match parameter names/types to get an exact match *)
String.equal (Typ.Procname.get_method pname) method_name
&& not (Typ.Procname.is_constructor pname)
in
let rec find_super_type_ super_class_name =
Tenv.lookup tenv super_class_name
|> Option.bind ~f:(fun {Typ.Struct.methods; supers} ->
match List.find ~f:(fun pname -> is_override pname && f pname) methods with
| None ->
List.find_map ~f:find_super_type_ supers
| pname_opt ->
pname_opt )
in
let find_super_type type_name =
List.find_map ~f:find_super_type_
(type_get_direct_supertypes tenv (Typ.mk (Tstruct type_name)))
in
if check_current_type && f proc_name then Some proc_name
else
match proc_name with
| Typ.Procname.Java proc_name_java ->
find_super_type
(Typ.Name.Java.from_string (Typ.Procname.Java.get_class_name proc_name_java))
| Typ.Procname.ObjC_Cpp proc_name_cpp ->
find_super_type (Typ.Procname.ObjC_Cpp.get_class_type_name proc_name_cpp)
| _ ->
None
let override_exists ?(check_current_type= true) f tenv proc_name =
override_find ~check_current_type f tenv proc_name |> Option.is_some
(* Only java supported at the moment *)
let override_iter f tenv proc_name =
ignore (override_exists (fun pname -> f pname ; false) tenv proc_name)
(** return the set of instance fields that are assigned to a null literal in [procdesc] *)
let get_fields_nullified procdesc =
(* walk through the instructions and look for instance fields that are assigned to null *)
let collect_nullified_flds (nullified_flds, this_ids) _ = function
| Sil.Store (Exp.Lfield (Exp.Var lhs, fld, _), _, rhs, _)
when Exp.is_null_literal rhs && Ident.Set.mem lhs this_ids ->
(Typ.Fieldname.Set.add fld nullified_flds, this_ids)
| Sil.Load (id, rhs, _, _) when Exp.is_this rhs ->
(nullified_flds, Ident.Set.add id this_ids)
| _ ->
(nullified_flds, this_ids)
in
let nullified_flds, _ =
Procdesc.fold_instrs procdesc ~f:collect_nullified_flds
~init:(Typ.Fieldname.Set.empty, Ident.Set.empty)
in
nullified_flds
(** Checks if the exception is an unchecked exception *)
let is_runtime_exception tenv typename =
is_subtype_of_str tenv typename "java.lang.RuntimeException"
(** Checks if the class name is a Java exception *)
let is_throwable tenv typename = is_subtype_of_str tenv typename "java.lang.Throwable"
(** tests whether any class attributes (e.g., @ThreadSafe) pass check of first argument,
including for supertypes*)
let check_class_attributes check tenv = function
| Typ.Procname.Java java_pname ->
let check_class_annots _ {Typ.Struct.annots} = check annots in
supertype_exists tenv check_class_annots (Typ.Procname.Java.get_class_type_name java_pname)
| _ ->
false
(** tests whether any class attributes (e.g., @ThreadSafe) pass check of first argument,
for the current class only*)
let check_current_class_attributes check tenv = function
| Typ.Procname.Java java_pname -> (
match Tenv.lookup tenv (Typ.Procname.Java.get_class_type_name java_pname) with
| Some struct_typ ->
check struct_typ.annots
| _ ->
false )
| _ ->
false
(** find superclasss with attributes (e.g., @ThreadSafe), including current class*)
let rec find_superclasses_with_attributes check tenv tname =
match Tenv.lookup tenv tname with
| Some struct_typ ->
let result_from_supers =
List.concat (List.map ~f:(find_superclasses_with_attributes check tenv) struct_typ.supers)
in
if check struct_typ.annots then tname :: result_from_supers else result_from_supers
| _ ->
[]