(* * Copyright (c) 2009-2013, Monoidics ltd. * Copyright (c) Facebook, Inc. and its affiliates. * * 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 Hashtbl = Caml.Hashtbl (** Printers for the analysis results *) module L = Logging module F = Format (** Module to read specific lines from files. The data from any file will stay in memory until the handle is collected by the gc. *) module LineReader = struct (** Map a file name to an array of string, one for each line in the file. *) type t = (SourceFile.t, string array) Hashtbl.t let create () = Hashtbl.create 1 let read_file fname = let cin = In_channel.create fname in let lines = ref [] in try while true do let line_raw = In_channel.input_line_exn cin in let line = let len = String.length line_raw in if len > 0 && Char.equal line_raw.[len - 1] '\r' then String.sub line_raw ~pos:0 ~len:(len - 1) else line_raw in lines := line :: !lines done ; assert false (* execution never reaches here *) with End_of_file -> In_channel.close cin ; Array.of_list_rev !lines let file_data (hash : t) fname = try Some (Hashtbl.find hash fname) with Caml.Not_found -> ( try let lines_arr = read_file (SourceFile.to_abs_path fname) in Hashtbl.add hash fname lines_arr ; Some lines_arr with exn when SymOp.exn_not_failure exn -> None ) let from_file_linenum hash fname linenum = match file_data hash fname with | Some lines_arr when linenum > 0 && linenum <= Array.length lines_arr -> Some lines_arr.(linenum - 1) | _ -> None let from_loc hash loc = from_file_linenum hash loc.Location.file loc.Location.line let iter hash fname ~f = file_data hash fname |> Option.iter ~f:(Array.iteri ~f:(fun linenum line -> f (linenum + 1) line)) end (** Current formatter for the html output *) let curr_html_formatter = ref F.std_formatter (** Return true if the node was visited during analysis *) let is_visited node = match Summary.OnDisk.get (Procdesc.Node.get_proc_name node) with | None -> false | Some summary -> let stats = summary.Summary.stats in let node_id = (Procdesc.Node.get_id node :> int) in Summary.Stats.is_visited stats node_id let pp_node_link_seq = let compare_node = let key node = (Procdesc.Node.get_wto_index node, Procdesc.Node.get_id node) in fun node1 node2 -> [%compare: int * Procdesc.Node.id] (key node1) (key node2) in fun path_to_root ~description fmt nodes -> let nodes = List.sort nodes ~compare:compare_node in let pp_one fmt node = let description = if description then Procdesc.Node.get_description (Pp.html Black) node else "" in let pname = Procdesc.Node.get_proc_name node in Io_infer.Html.pp_node_link path_to_root pname ~description ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) ~isvisited:(is_visited node) fmt (Procdesc.Node.get_id node :> int) in Pp.seq pp_one fmt nodes (** Print information into html files for nodes when starting and finishing the processing of a node *) module NodesHtml : sig val start_session : pp_name:(Format.formatter -> unit) -> Procdesc.Node.t -> int -> unit val finish_session : Procdesc.Node.t -> unit end = struct let log_files = Hashtbl.create 11 let pp_node_link_seq fmt node = pp_node_link_seq [".."] ~description:false fmt node let start_session ~pp_name node session = let loc = Procdesc.Node.get_loc node in let source = loc.Location.file in let line = loc.Location.line in let proc_name = Procdesc.Node.get_proc_name node in let nodeid = (Procdesc.Node.get_id node :> int) in let node_fname = Io_infer.Html.node_filename proc_name nodeid in let needs_initialization, (fd, fmt) = let node_path = ["nodes"; node_fname] in let modified = Io_infer.Html.modified_during_analysis source node_path in if modified then (false, Io_infer.Html.open_out source node_path) else (true, Io_infer.Html.create source node_path) in curr_html_formatter := fmt ; Hashtbl.replace log_files (node_fname, source) fd ; if needs_initialization then ( F.fprintf fmt "

Cfg Node %a

" (Io_infer.Html.pp_line_link source ~text:(Some (string_of_int nodeid)) [".."]) line ; F.fprintf fmt "PROC: %a LINE: %a@\n" (Io_infer.Html.pp_proc_link [".."] proc_name) (Escape.escape_xml (Procname.to_string proc_name)) (Io_infer.Html.pp_line_link source [".."]) line ; F.fprintf fmt "
PREDS:@\n" ; pp_node_link_seq fmt (Procdesc.Node.get_preds node) ; F.fprintf fmt "
SUCCS:@\n" ; pp_node_link_seq fmt (Procdesc.Node.get_succs node) ; F.fprintf fmt "
EXN:@\n" ; pp_node_link_seq fmt (Procdesc.Node.get_exn node) ; F.fprintf fmt "
@\n" ; F.fprintf fmt "%a" (Pp.color_string Green) (Instrs.pp (Pp.html Green)) (Procdesc.Node.get_instrs node) ) ; F.fprintf fmt "%a%a %t" Io_infer.Html.pp_hline () (Io_infer.Html.pp_session_link source ~with_name:true [".."] ~proc_name) (nodeid, session, line) pp_name ; F.fprintf fmt "@\n" (Pp.color_string Black) let finish_session node = F.fprintf !curr_html_formatter "@?" ; let fd = let source = (Procdesc.Node.get_loc node).file in let node_fname = let proc_name = Procdesc.Node.get_proc_name node in let nodeid = (Procdesc.Node.get_id node :> int) in Io_infer.Html.node_filename proc_name nodeid in Hashtbl.find log_files (node_fname, source) in Unix.close fd ; curr_html_formatter := F.std_formatter end module ProcsHtml : sig val write : Procdesc.t -> unit end = struct let write pdesc = let pname = Procdesc.get_proc_name pdesc in let loc = Procdesc.get_loc pdesc in let source = loc.file in let nodes = List.sort ~compare:Procdesc.Node.compare (Procdesc.get_nodes pdesc) in let linenum = loc.Location.line in let fd, fmt = Io_infer.Html.create source [Procname.to_filename pname] in F.fprintf fmt "

Procedure %a

@\n" (Io_infer.Html.pp_line_link source ~text:(Some (Escape.escape_xml (Procname.to_string pname))) []) linenum ; pp_node_link_seq [] ~description:true fmt nodes ; ( match Summary.OnDisk.get pname with | None -> () | Some summary -> F.pp_print_string fmt "
@\n" ; Summary.pp_html source fmt summary ) ; F.fprintf fmt "
@\n
@\n%a
@\n" ProcAttributes.pp (Procdesc.get_attributes pdesc) ; Io_infer.Html.close (fd, fmt) end module FilesHtml : sig val write_all_html_files : SourceFile.t -> unit val ensure_file_is_written : Procdesc.Node.t -> unit end = struct (* Only used in debug html mode *) let linereader = LineReader.create () (** Create a hash table mapping line numbers to the set of errors occurring on that line *) let create_table_err_per_line err_log = let err_per_line = Hashtbl.create 17 in let add_err (key : Errlog.err_key) (err_data : Errlog.err_data) = let err_str = F.asprintf "%s %a" key.err_name.IssueType.unique_id Localise.pp_error_desc key.err_desc in try let set = Hashtbl.find err_per_line err_data.loc.Location.line in Hashtbl.replace err_per_line err_data.loc.Location.line (String.Set.add set err_str) with Caml.Not_found -> Hashtbl.add err_per_line err_data.loc.Location.line (String.Set.singleton err_str) in Errlog.iter add_err err_log ; err_per_line (** Create error message for html file *) let pp_err_message fmt err_string = F.fprintf fmt "\n
%s
" err_string let process_proc table_nodes_at_linenum global_err_log proc_desc = let proc_name = Procdesc.get_proc_name proc_desc in let _ = (* Initializes wto_indexes *) Procdesc.get_wto proc_desc in let process_node n = let lnum = (Procdesc.Node.get_loc n).Location.line in let curr_nodes = try Hashtbl.find table_nodes_at_linenum lnum with Caml.Not_found -> [] in Hashtbl.replace table_nodes_at_linenum lnum (n :: curr_nodes) in List.iter ~f:process_node (Procdesc.get_nodes proc_desc) ; match Summary.OnDisk.get proc_name with | None -> () | Some summary -> Errlog.update global_err_log (Summary.get_err_log summary) (** Create filename.ext.html. *) let write_html_file filename procs = let fname_encoding = DB.source_file_encoding filename in let fd, fmt = Io_infer.Html.create filename [".."; fname_encoding] in F.fprintf fmt "

File %a

@\n@\n" SourceFile.pp filename ; let global_err_log = Errlog.empty () in let table_nodes_at_linenum = Hashtbl.create 11 in List.iter ~f:(process_proc table_nodes_at_linenum global_err_log) procs ; let table_err_per_line = create_table_err_per_line global_err_log in let print_one_line line_number line_raw = let line_html = Escape.escape_xml line_raw in F.fprintf fmt "@\n" in LineReader.iter linereader filename ~f:print_one_line ; F.fprintf fmt "
%d%s " line_number line_number line_html ; ( match Hashtbl.find table_nodes_at_linenum line_number with | nodes_at_linenum -> pp_node_link_seq [fname_encoding] ~description:true fmt nodes_at_linenum ; List.iter nodes_at_linenum ~f:(fun n -> match Procdesc.Node.get_kind n with | Procdesc.Node.Start_node -> let proc_name = Procdesc.Node.get_proc_name n in let proc_name_escaped = Escape.escape_xml (Procname.to_string proc_name) in if Summary.OnDisk.get proc_name |> Option.is_some then ( F.pp_print_char fmt ' ' ; let label = F.asprintf "summary for %s" proc_name_escaped in Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label ) else F.fprintf fmt "no summary for %s" proc_name_escaped | _ -> () ) | exception Caml.Not_found -> () ) ; ( match Hashtbl.find table_err_per_line line_number with | errset -> String.Set.iter errset ~f:(pp_err_message fmt) | exception Caml.Not_found -> () ) ; F.fprintf fmt "
@\n" ; Errlog.pp_html filename [fname_encoding] fmt global_err_log ; Io_infer.Html.close (fd, fmt) let is_whitelisted = match Config.write_html_whitelist_regex with | [] -> fun _ -> true | _ as reg_list -> let regex = Str.regexp (String.concat ~sep:"\\|" reg_list) in fun file -> let fname = SourceFile.to_rel_path file in Str.string_match regex fname 0 (* Stores all the proc_descs in source files. We need to keep collecting them because some may be captured by other files, happens especially with templates in header files. *) let pdescs_in_source = Hashtbl.create 1 let write_all_html_files source_file = let procs_in_source = SourceFiles.proc_names_of_source source_file in let source_files_in_cfg = List.fold procs_in_source ~init:SourceFile.Set.empty ~f:(fun files proc_name -> match Procdesc.load proc_name with | Some proc_desc -> if Procdesc.is_defined proc_desc then let file = (Procdesc.get_loc proc_desc).Location.file in if is_whitelisted file then ( let pdescs_in_file = try Hashtbl.find pdescs_in_source file with Caml.Not_found -> Procname.Map.empty in let pdescs_in_file = Procname.Map.add proc_name proc_desc pdescs_in_file in Hashtbl.replace pdescs_in_source file pdescs_in_file ; SourceFile.Set.add file files ) else files else files | None -> files ) in SourceFile.Set.iter (fun file -> let pdescs_in_file = match Hashtbl.find pdescs_in_source file with | pdescs_map -> Procname.Map.bindings pdescs_map |> List.map ~f:snd | exception Caml.Not_found -> [] in DB.Results_dir.init file ; write_html_file file pdescs_in_file ) source_files_in_cfg let ensure_file_is_written = let written_files = Hashtbl.create 1 in fun node -> let file = (Procdesc.Node.get_loc node).Location.file in if not (Hashtbl.mem written_files file) then ( write_all_html_files file ; Hashtbl.add written_files file () ) end (* =============== Printing functions =============== *) (** Execute the delayed print actions *) let force_delayed_prints () = F.pp_print_flush !curr_html_formatter () ; (* flush html stream *) L.force_and_reset_delayed_prints !curr_html_formatter ; F.pp_print_flush !curr_html_formatter () (** Start a session, and create a new html file for the node if it does not exist yet *) let node_start_session ~pp_name node session = if Config.write_html then ( FilesHtml.ensure_file_is_written node ; NodesHtml.start_session ~pp_name node session ) (** Finish a session, and perform delayed print actions if required *) let node_finish_session node = if not Config.only_cheap_debug then force_delayed_prints () else L.reset_delayed_prints () ; if Config.write_html then NodesHtml.finish_session node (** Write html file for the procedure. *) let write_proc_html pdesc = if Config.write_html then ProcsHtml.write pdesc (** Create the HTML debug file for the source file. *) let write_all_html_files = FilesHtml.write_all_html_files