infer_clone/infer/src/checkers/Litho.ml

(*
 * Copyright (c) 2017 - 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! IStd
module F = Format
module L = Logging
module Domain = LithoDomain

module Summary = Summary.Make (struct
  type payload = Domain.astate

  let update_payload astate (summary: Specs.summary) =
    {summary with payload= {summary.payload with litho= Some astate}}


  let read_payload (summary: Specs.summary) = summary.payload.litho
end)

module TransferFunctions (CFG : ProcCfg.S) = struct
  module CFG = CFG
  module Domain = Domain

  type extras = ProcData.no_extras

  let is_graphql_getter procname summary =
    Option.is_none summary
    (* we skip analysis of all GraphQL procs *)
    &&
    match procname with
    | Typ.Procname.Java java_procname
      -> (
        PatternMatch.is_getter java_procname
        &&
        match Typ.Procname.Java.get_package java_procname with
        | Some package ->
            String.is_prefix ~prefix:"com.facebook.graphql.model" package
        | None ->
            false )
    | _ ->
        false


  let apply_callee_summary summary_opt caller_pname ret_opt actuals astate =
    match summary_opt with
    | Some summary ->
        (* TODO: append paths if the footprint access path is an actual path instead of a var *)
        let f_sub {Domain.LocalAccessPath.access_path= (var, _), _} =
          match Var.get_footprint_index var with
          | Some footprint_index -> (
            match List.nth actuals footprint_index with
            | Some HilExp.AccessPath actual_access_path ->
                Some (Domain.LocalAccessPath.make actual_access_path caller_pname)
            | _ ->
                None )
          | None ->
              if Var.is_return var then
                match ret_opt with
                | Some ret ->
                    Some (Domain.LocalAccessPath.make (ret, []) caller_pname)
                | None ->
                    assert false
              else None
        in
        Domain.substitute ~f_sub summary
    | None ->
        astate


  let exec_instr astate (proc_data: extras ProcData.t) _ (instr: HilInstr.t) : Domain.astate =
    let caller_pname = Procdesc.get_proc_name proc_data.pdesc in
    match instr with
    | Call
        ( (Some return_base as ret_opt)
        , Direct callee_procname
        , ((HilExp.AccessPath receiver_ap) :: _ as actuals)
        , _
        , _ ) ->
        let summary = Summary.read_summary proc_data.pdesc callee_procname in
        (* track the call if the callee is a graphql getter *or* the receiver is already tracked *)
        (* TODO: we should probably track all formals as well *)
        let receiver = Domain.LocalAccessPath.make receiver_ap caller_pname in
        if is_graphql_getter callee_procname summary || Domain.mem receiver astate then
          let receiver = Domain.LocalAccessPath.make receiver_ap caller_pname in
          let return_access_path = Domain.LocalAccessPath.make (return_base, []) caller_pname in
          let return_calls =
            (try Domain.find return_access_path astate with Not_found -> Domain.CallSet.empty)
            |> Domain.CallSet.add (Domain.MethodCall.make receiver callee_procname)
          in
          Domain.add return_access_path return_calls astate
        else
          (* treat it like a normal call *)
          apply_callee_summary summary caller_pname ret_opt actuals astate
    | Call (ret_opt, Direct callee_procname, actuals, _, _) ->
        let summary = Summary.read_summary proc_data.pdesc callee_procname in
        apply_callee_summary summary caller_pname ret_opt actuals astate
    | Assign (lhs_ap, HilExp.AccessPath rhs_ap, _)
      -> (
        (* creating an alias for the rhs binding; assume all reads will now occur through the
           alias. this helps us keep track of chains in cases like tmp = getFoo(); x = tmp;
           tmp.getBar() *)
        let lhs_access_path = Domain.LocalAccessPath.make lhs_ap caller_pname in
        let rhs_access_path = Domain.LocalAccessPath.make rhs_ap caller_pname in
        try
          let call_set = Domain.find rhs_access_path astate in
          Domain.remove rhs_access_path astate |> Domain.add lhs_access_path call_set
        with Not_found -> astate )
    | _ ->
        astate
end

module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions)

let report access_path call_chain summary =
  let call_strings = List.map ~f:(Typ.Procname.to_simplified_string ~withclass:false) call_chain in
  let call_string = String.concat ~sep:"." call_strings in
  let message = F.asprintf "%a.%s" AccessPath.pp access_path call_string in
  let exn = Exceptions.Checkers (IssueType.graphql_field_access, Localise.verbatim_desc message) in
  let loc = Specs.get_loc summary in
  let ltr = [Errlog.make_trace_element 0 loc message []] in
  Reporting.log_error summary ~loc ~ltr exn


let should_report proc_desc =
  match Procdesc.get_proc_name proc_desc with
  | Typ.Procname.Java java_pname -> (
    match Typ.Procname.Java.get_method java_pname with "onCreateLayout" -> true | _ -> false )
  | _ ->
      false


let report_graphql_getters summary access_path call_chain =
  let call_strings = List.map ~f:(Typ.Procname.to_simplified_string ~withclass:false) call_chain in
  let call_string = String.concat ~sep:"." call_strings in
  let message = F.asprintf "%a.%s" AccessPath.pp access_path call_string in
  let exn = Exceptions.Checkers (IssueType.graphql_field_access, Localise.verbatim_desc message) in
  let loc = Specs.get_loc summary in
  let ltr = [Errlog.make_trace_element 0 loc message []] in
  Reporting.log_error summary ~loc ~ltr exn


let postprocess astate proc_desc : Domain.astate =
  let formal_map = FormalMap.make proc_desc in
  let f_sub access_path = Domain.LocalAccessPath.to_formal_option access_path formal_map in
  Domain.substitute ~f_sub astate


let checker {Callbacks.summary; proc_desc; tenv} =
  let proc_data = ProcData.make_default proc_desc tenv in
  match Analyzer.compute_post proc_data ~initial:Domain.empty with
  | Some post ->
      ( if should_report proc_desc then
          let f = report_graphql_getters summary in
          Domain.iter_call_chains ~f post ) ;
      let payload = postprocess post proc_desc in
      Summary.update_summary payload summary
  | None ->
      summary