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.

389 lines
15 KiB

(*
* Copyright (c) 2018-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 L = Logging
module AbstractAddress = PulseDomain.AbstractAddress
module Attribute = PulseDomain.Attribute
module Attributes = PulseDomain.Attributes
module Memory = PulseAbductiveDomain.Memory
module Stack = PulseAbductiveDomain.Stack
open Result.Monad_infix
include (* ocaml ignores the warning suppression at toplevel, hence the [include struct ... end] trick *)
struct
[@@@warning "-60"]
(** Do not use {!PulseDomain} directly, go through {!PulseAbductiveDomain} instead *)
module PulseDomain = struct end [@@deprecated "Use PulseAbductiveDomain instead."]
end
type t = PulseAbductiveDomain.t
type 'a access_result = ('a, PulseDiagnostic.t) result
(** Check that the address is not known to be invalid *)
let check_addr_access access action (address, breadcrumbs) astate =
Memory.check_valid action address astate
|> Result.map_error ~f:(fun invalidated_by ->
PulseDiagnostic.AccessToInvalidAddress
{access; invalidated_by; accessed_by= {action; breadcrumbs}} )
(** Walk the heap starting from [addr] and following [path]. Stop either at the element before last
and return [new_addr] if [overwrite_last] is [Some new_addr], or go until the end of the path if it
is [None]. Create more addresses into the heap as needed to follow the [path]. Check that each
address reached is valid. *)
let rec walk ~dereference_to_ignore access_expr action ~on_last addr_trace path astate =
let check_addr_access_optional action addr_trace astate =
match dereference_to_ignore with
| Some 0 ->
Ok astate
| _ ->
check_addr_access access_expr action addr_trace astate
in
match (path, on_last) with
| [], `Access ->
Ok (astate, addr_trace)
| [], `Overwrite _ ->
L.die InternalError "Cannot overwrite last address in empty path"
| [a], `Overwrite new_addr_trace ->
check_addr_access_optional action addr_trace astate
>>| fun astate ->
let astate = Memory.add_edge (fst addr_trace) a new_addr_trace astate in
(astate, new_addr_trace)
| a :: path, _ ->
check_addr_access_optional action addr_trace astate
>>= fun astate ->
let dereference_to_ignore =
Option.map ~f:(fun index -> max 0 (index - 1)) dereference_to_ignore
in
let astate, addr_trace' = Memory.materialize_edge (fst addr_trace) a astate in
let access_expr =
HilExp.AccessExpression.add_access a access_expr |> Option.value ~default:access_expr
in
walk access_expr ~dereference_to_ignore action ~on_last addr_trace' path astate
let write_var var new_addr_trace astate =
let astate, (var_address_of, _) = Stack.materialize var astate in
(* Update heap with var_address_of -*-> new_addr *)
Memory.add_edge var_address_of HilExp.Access.Dereference new_addr_trace astate
let ends_with_addressof = function HilExp.AccessExpression.AddressOf _ -> true | _ -> false
let last_dereference access_list =
let rec last_dereference_inner access_list index result =
match access_list with
| [] ->
result
| HilExp.Access.Dereference :: rest ->
last_dereference_inner rest (index + 1) (Some index)
| _ :: rest ->
last_dereference_inner rest (index + 1) result
in
last_dereference_inner access_list 0 None
let rec to_accesses location access_expr astate =
let exception Failed_fold of PulseDiagnostic.t in
try
HilExp.AccessExpression.to_accesses_fold access_expr ~init:astate
~f_array_offset:(fun astate hil_exp_opt ->
match hil_exp_opt with
| None ->
(astate, AbstractAddress.mk_fresh ())
| Some hil_exp -> (
match eval_hil_exp location hil_exp astate with
| Ok result ->
result
| Error diag ->
raise (Failed_fold diag) ) )
|> Result.return
with Failed_fold diag -> Error diag
(** add addresses to the state to give an address to the destination of the given access path *)
and walk_access_expr ~on_last astate access_expr location =
to_accesses location access_expr astate
>>= fun (astate, base, access_list) ->
let dereference_to_ignore =
if ends_with_addressof access_expr then last_dereference access_list else None
in
let access_var, _ = base in
if Config.write_html then
L.d_printfln "Accessing %a -> [%a]" Var.pp access_var
(Pp.seq ~sep:"," Memory.Access.pp)
access_list ;
match (on_last, access_list) with
| `Overwrite new_addr_trace, [] ->
Ok (write_var access_var new_addr_trace astate, new_addr_trace)
| `Access, _ | `Overwrite _, _ :: _ -> (
let astate, base_addr_trace =
let astate, (addr, init_loc_opt) = Stack.materialize access_var astate in
let trace =
Option.map init_loc_opt ~f:(fun init_loc ->
if Var.is_cpp_temporary access_var then PulseTrace.CppTemporaryCreated init_loc
else PulseTrace.VariableDeclaration init_loc )
|> Option.to_list
in
(astate, (addr, trace))
in
match access_list with
| [HilExp.Access.TakeAddress] ->
Ok (astate, base_addr_trace)
| _ ->
let action = PulseTrace.Immediate {imm= access_expr; location} in
walk
(HilExp.AccessExpression.base base)
~dereference_to_ignore action ~on_last base_addr_trace
(HilExp.Access.Dereference :: access_list)
astate )
(** Use the stack and heap to walk the access path represented by the given expression down to an
abstract address representing what the expression points to.
Return an error state if it traverses some known invalid address or if the end destination is
known to be invalid. *)
and materialize_address astate access_expr = walk_access_expr ~on_last:`Access astate access_expr
and read location access_expr astate = materialize_address astate access_expr location
and read_all location access_exprs astate =
List.fold_result access_exprs ~init:astate ~f:(fun astate access_expr ->
read location access_expr astate >>| fst )
and eval_hil_exp location (hil_exp : HilExp.t) astate =
match hil_exp with
| AccessExpression access_expr ->
read location access_expr astate >>| fun (astate, (addr, _)) -> (astate, addr)
| _ ->
read_all location (HilExp.get_access_exprs hil_exp) astate
>>| fun astate -> (astate, AbstractAddress.mk_fresh ())
(** Use the stack and heap to walk the access path represented by the given expression down to an
abstract address representing what the expression points to, and replace that with the given
address.
Return an error state if it traverses some known invalid address. *)
let overwrite_address astate access_expr new_addr_trace =
walk_access_expr ~on_last:(`Overwrite new_addr_trace) astate access_expr
(** Add the given address to the set of know invalid addresses. *)
let mark_invalid action address astate = Memory.invalidate address action astate
let realloc_var var location astate =
Stack.add var (AbstractAddress.mk_fresh (), Some location) astate
let havoc_var trace var astate = write_var var (AbstractAddress.mk_fresh (), trace) astate
let havoc trace location (access_expr : HilExp.AccessExpression.t) astate =
overwrite_address astate access_expr (AbstractAddress.mk_fresh (), trace) location >>| fst
let write location access_expr addr astate =
overwrite_address astate access_expr addr location >>| fun (astate, _) -> astate
let invalidate cause location access_expr astate =
materialize_address astate access_expr location
>>= fun (astate, addr_trace) ->
check_addr_access access_expr (Immediate {imm= access_expr; location}) addr_trace astate
>>| mark_invalid cause addr_trace
let invalidate_array_elements cause location access_expr astate =
materialize_address astate access_expr location
>>= fun (astate, addr_trace) ->
check_addr_access access_expr (Immediate {imm= access_expr; location}) addr_trace astate
>>| fun astate ->
match Memory.find_opt (fst addr_trace) astate with
| None ->
astate
| Some (edges, _) ->
Memory.Edges.fold
(fun access dest_addr_trace astate ->
match (access : Memory.Access.t) with
| ArrayAccess _ ->
mark_invalid cause dest_addr_trace astate
| _ ->
astate )
edges astate
let check_address_escape escape_location proc_desc address trace astate =
let check_address_of_cpp_temporary () =
Memory.find_opt address astate
|> Option.fold_result ~init:() ~f:(fun () (_, attrs) ->
IContainer.iter_result ~fold:Attributes.fold attrs ~f:(fun attr ->
match attr with
| Attribute.AddressOfCppTemporary (variable, _) ->
Error
(PulseDiagnostic.StackVariableAddressEscape
{variable; location= escape_location; trace})
| _ ->
Ok () ) )
in
let check_address_of_stack_variable () =
let proc_name = Procdesc.get_proc_name proc_desc in
IContainer.iter_result ~fold:(IContainer.fold_of_pervasives_map_fold ~fold:Stack.fold) astate
~f:(fun (variable, (var_address, _)) ->
if
AbstractAddress.equal var_address address
&& ( Var.is_cpp_temporary variable
|| Var.is_local_to_procedure proc_name variable
&& not (Procdesc.is_captured_var proc_desc variable) )
then (
L.d_printfln_escaped "Stack variable address &%a detected at address %a" Var.pp variable
AbstractAddress.pp address ;
Error
(PulseDiagnostic.StackVariableAddressEscape {variable; location= escape_location; trace}) )
else Ok () )
in
check_address_of_cpp_temporary () >>= check_address_of_stack_variable >>| fun () -> astate
let mark_address_of_cpp_temporary location variable address astate =
Memory.add_attributes address
(Attributes.singleton (AddressOfCppTemporary (variable, location)))
astate
let remove_vars vars astate =
let astate =
List.fold vars ~init:astate ~f:(fun heap var ->
match Stack.find_opt var astate with
| Some (address, location) when Var.is_cpp_temporary var ->
mark_address_of_cpp_temporary location var address astate
| _ ->
heap )
in
let astate' = Stack.remove_vars vars astate in
if phys_equal astate' astate then astate else PulseAbductiveDomain.discard_unreachable astate'
module Closures = struct
open Result.Monad_infix
module Memory = PulseAbductiveDomain.Memory
let fake_capture_field_prefix = "__capture_"
let mk_fake_field ~id =
Typ.Fieldname.Clang.from_class_name
(Typ.CStruct (QualifiedCppName.of_list ["std"; "function"]))
(Printf.sprintf "%s%d" fake_capture_field_prefix id)
let is_captured_fake_access (access : _ HilExp.Access.t) =
match access with
| FieldAccess fieldname
when String.is_prefix ~prefix:fake_capture_field_prefix (Typ.Fieldname.to_string fieldname)
->
true
| _ ->
false
let mk_capture_edges captured =
let fake_fields =
List.rev_mapi captured ~f:(fun id captured_addr_trace ->
(HilExp.Access.FieldAccess (mk_fake_field ~id), captured_addr_trace) )
in
Memory.Edges.of_seq (Caml.List.to_seq fake_fields)
let check_captured_addresses location lambda addr astate =
match Memory.find_opt addr astate with
| None ->
Ok astate
| Some (edges, attributes) ->
IContainer.iter_result ~fold:Attributes.fold attributes ~f:(function
| Attribute.Closure _ ->
IContainer.iter_result
~fold:(IContainer.fold_of_pervasives_map_fold ~fold:Memory.Edges.fold) edges
~f:(fun (access, addr_trace) ->
if is_captured_fake_access access then
check_addr_access lambda (Immediate {imm= lambda; location}) addr_trace astate
>>| fun _ -> ()
else Ok () )
| _ ->
Ok () )
>>| fun () -> astate
let write location access_expr pname captured astate =
let closure_addr = AbstractAddress.mk_fresh () in
write location access_expr
(closure_addr, [PulseTrace.Assignment {lhs= access_expr; location}])
astate
>>| fun astate ->
let fake_capture_edges = mk_capture_edges captured in
Memory.set_cell closure_addr (fake_capture_edges, Attributes.singleton (Closure pname)) astate
let record location access_expr pname captured astate =
List.fold_result captured ~init:(astate, [])
~f:(fun ((astate, captured) as result) (captured_as, captured_exp) ->
match captured_exp with
| HilExp.AccessExpression (AddressOf access_expr as captured_access_expr) ->
read location access_expr astate
>>= fun (astate, (address, trace)) ->
let new_trace =
PulseTrace.Capture {captured_as; captured= captured_access_expr; location} :: trace
in
Ok (astate, (address, new_trace) :: captured)
| _ ->
Ok result )
>>= fun (astate, captured_addresses) ->
write location access_expr pname captured_addresses astate
end
module StdVector = struct
open Result.Monad_infix
module Memory = PulseAbductiveDomain.Memory
let is_reserved location vector_access_expr astate =
read location vector_access_expr astate
>>| fun (astate, (addr, _)) -> (astate, Memory.is_std_vector_reserved addr astate)
let mark_reserved location vector_access_expr astate =
read location vector_access_expr astate
>>| fun (astate, (addr, _)) -> Memory.std_vector_reserve addr astate
end
module Interproc = struct
open Result.Monad_infix
(* compute addresses for actuals and then call {!PulseAbductiveDomain.PrePost.apply} on each
pre/post pair in the summary. *)
let call callee_pname ~formals ~ret ~actuals _flags call_loc astate pre_posts =
L.d_printfln "PulseOperations.call" ;
List.fold_result actuals ~init:(astate, []) ~f:(fun (astate, rev_actual_addresses) actual ->
match actual with
| HilExp.AccessExpression access_expr ->
read call_loc access_expr astate
>>| fun (astate, (addr, trace)) ->
(astate, Some (addr, access_expr, trace) :: rev_actual_addresses)
| _ ->
Ok (astate, None :: rev_actual_addresses) )
>>= fun (astate, rev_actual_addresses) ->
let actuals = List.rev rev_actual_addresses in
read call_loc HilExp.AccessExpression.(address_of_base ret) astate
>>= fun (astate, ret) ->
List.fold_result pre_posts ~init:[] ~f:(fun posts pre_post ->
(* apply all pre/post specs *)
PulseAbductiveDomain.PrePost.apply callee_pname call_loc pre_post ~formals ~ret ~actuals
astate
>>| fun post -> post :: posts )
end