hphp/hack/src/server/serverArgs.ml

   1 (**
   2  * Copyright (c) 2015, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11 include ServerArgs_sig.Types
  12
  13 (*****************************************************************************)
  14 (* The options from the command line *)
  15 (*****************************************************************************)
  16
  17 type options = {
  18   ai_mode: Ai_options.t option;
  19   check_mode: bool;
  20   config: (string * string) list;
  21   dynamic_view: bool;
  22   file_info_on_disk: bool;
  23   from: string;
  24   gen_saved_ignore_type_errors: bool;
  25   ignore_hh_version: bool;
  26   json_mode: bool;
  27   load_state_canary: bool;
  28   log_inference_constraints: bool;
  29   max_procs: int;
  30   no_load: bool;
  31   prechecked: bool option;
  32   profile_log: bool;
  33   replace_state_after_saving: bool;
  34   root: Path.t;
  35   save_filename: string option;
  36   should_detach: bool;
  37   waiting_client: Unix.file_descr option;
  38   watchman_debug_logging: bool;
  39   with_mini_state: mini_state_target option;
  40 }
  41
  42 (*****************************************************************************)
  43 (* Usage code *)
  44 (*****************************************************************************)
  45 let usage = Printf.sprintf "Usage: %s [WWW DIRECTORY]\n" Sys.argv.(0)
  46
  47 (*****************************************************************************)
  48 (* Options *)
  49 (*****************************************************************************)
  50
  51 module Messages = struct
  52   let ai = " run ai with options"
  53   let check = " check and exit"
  54   let config = " override arbitrary value from hh.conf (format: <key>=<value>)"
  55   let daemon = " detach process"
  56   let dynamic_view = " start with dynamic view for IDE files on by default."
  57   let file_info_on_disk = " [experimental] a saved state option to store file info" ^
  58                           " (the naming table) in SQLite. Only has meaning in --saved-state mode."
  59   let from = " so we know who's invoking - e.g. nuclide, vim, emacs, vscode"
  60   let from_vim = " DEPRECATED"
  61   let from_emacs = " DEPRECATED"
  62   let from_hhclient = " DEPRECATED"
  63   let gen_saved_ignore_type_errors = " generate a saved state even if there are type errors."
  64   let ignore_hh_version = " ignore hh_version check when loading saved states"
  65   let json = " output errors in json format (arc lint mode)"
  66   let load_state_canary = " Look up a saved state using the hg commit" ^
  67                           " hash instead of the SVN rev."
  68   let log_inference_constraints = " (for hh debugging purpose only) log type" ^
  69     " inference constraints into external logger (e.g. Scuba)"
  70   let max_procs = " max numbers of workers"
  71   let mini_state_json_descr =
  72     "Either\n" ^
  73     "   { \"data_dump\" : <mini_state_target json> }\n" ^
  74     "or\n" ^
  75     "   { \"from_file\" : <path to file containing mini_state_target json }\n" ^
  76     "where mini_state_target json looks liks:\n" ^
  77     "   {\n" ^
  78     "      \"state\" : <saved state filename>\n" ^
  79     "      \"corresponding_base_revision\" : <SVN rev #>\n" ^
  80     "      \"deptable\" : <dependency table filename>\n" ^
  81     "      \"changes\" : [array of files changed since that saved state]\n" ^
  82     "   }"
  83   let no_load = " don't load from a saved state"
  84   let prechecked = " override value of \"prechecked_files\" flag from hh.conf"
  85   let profile_log = " enable profile logging"
  86   let replace_state_after_saving = " if combined with --save-mini, causes the saved state" ^
  87                         " to replace the program state; otherwise, the state files are not" ^
  88                         " used after being written to disk (default: false)"
  89   let save_mini = " save mini server state to file"
  90   let waiting_client= " send message to fd/handle when server has begun" ^
  91                       " starting and again when it's done starting"
  92   let watchman_debug_logging =
  93     " Enable debug logging on Watchman client. This is very noisy"
  94
  95   let with_mini_state = " init with the given saved state instead of getting" ^
  96                         " it by running load mini state script." ^
  97                         " Expects a JSON blob specified as" ^
  98                         mini_state_json_descr
  99 end
 100
 101 let print_json_version () =
 102   let open Hh_json in
 103   let json = JSON_Object [
 104     "commit", JSON_String Build_id.build_revision;
 105     "commit_time", int_ Build_id.build_commit_time;
 106     "api_version", int_ Build_id.build_api_version;
 107   ] in
 108   print_endline @@ json_to_string json
 109
 110 (*****************************************************************************)
 111 (* The main entry point *)
 112 (*****************************************************************************)
 113
 114 let parse_mini_state_json (json, _keytrace) =
 115   let prechecked_changes = Option.value ~default:[]
 116     (Hh_json.(get_field_opt (Access.get_array "prechecked_changes")) json) in
 117   let json = Hh_json.Access.return json in
 118   let open Hh_json.Access in
 119   json >>= get_string "state" >>= fun (state, _state_keytrace) ->
 120   json >>= get_string "corresponding_base_revision"
 121     >>= fun (for_base_rev, _for_base_rev_keytrace) ->
 122   json >>= get_string "deptable" >>= fun (deptable, _deptable_keytrace) ->
 123   json >>= get_array "changes" >>= fun (changes, _) ->
 124     let array_to_path_list = List.map
 125       ~f:(fun file -> Hh_json.get_string_exn file |> Relative_path.from_root)
 126     in
 127     let prechecked_changes = array_to_path_list prechecked_changes in
 128     let changes = array_to_path_list changes in
 129     return (Mini_state_target_info {
 130       saved_state_fn = state;
 131       corresponding_base_revision = for_base_rev;
 132       deptable_fn = deptable;
 133       prechecked_changes;
 134       changes;
 135     })
 136
 137 let verify_with_mini_state v = match !v with
 138   | None -> None
 139   | Some blob ->
 140     let json = Hh_json.json_of_string blob in
 141     let json = Hh_json.Access.return json in
 142     let open Hh_json.Access in
 143     let data_dump_parse_result =
 144       json
 145         >>= get_obj "data_dump"
 146         >>= parse_mini_state_json
 147     in
 148     let from_file_parse_result =
 149       json
 150         >>= get_string "from_file"
 151         >>= fun (filename, _filename_keytrace) ->
 152         let contents = Sys_utils.cat filename in
 153         let json = Hh_json.json_of_string contents in
 154         (Hh_json.Access.return json)
 155           >>= parse_mini_state_json
 156     in
 157     match
 158       (Result.ok_fst data_dump_parse_result),
 159       (Result.ok_fst from_file_parse_result) with
 160     | (`Fst (parsed_data_dump, _)), (`Fst (_parsed_from_file, _)) ->
 161       Hh_logger.log "Warning - %s"
 162         ("Parsed mini state target from both JSON blob data dump" ^
 163         " and from contents of file.");
 164       Hh_logger.log "Preferring data dump result";
 165       Some parsed_data_dump
 166     | (`Fst (parsed_data_dump, _)), (`Snd _) ->
 167       Some parsed_data_dump
 168     | (`Snd _), (`Fst (parsed_from_file, _)) ->
 169       Some parsed_from_file
 170     | (`Snd data_dump_failure), (`Snd from_file_failure) ->
 171       Hh_logger.log "parsing optional arg with_mini_state failed:\n%s\n%s"
 172         (Printf.sprintf "  data_dump failure:%s"
 173               (access_failure_to_string data_dump_failure))
 174         (Printf.sprintf "  from_file failure:%s"
 175               (access_failure_to_string from_file_failure));
 176       Hh_logger.log "See input: %s" blob;
 177       raise (Arg.Bad "--with-mini-state")
 178
 179 let parse_options () =
 180   let ai_mode = ref None in
 181   let check_mode = ref false in
 182   let config = ref [] in
 183   let dynamic_view = ref false in
 184   let file_info_on_disk = ref false in
 185   let from = ref "" in
 186   let from_emacs = ref false in
 187   let from_hhclient = ref false in
 188   let from_vim = ref false in
 189   let gen_saved_ignore_type_errors = ref false in
 190   let ignore_hh = ref false in
 191   let json_mode = ref false in
 192   let load_state_canary = ref false in
 193   let log_inference_constraints = ref false in
 194   let max_procs = ref GlobalConfig.nbr_procs in
 195   let no_load = ref false in
 196   let prechecked = ref None in
 197   let profile_log = ref false in
 198   let root = ref "" in
 199   let replace_state_after_saving = ref false in
 200   let save = ref None in
 201   let should_detach = ref false in
 202   let version = ref false in
 203   let waiting_client= ref None in
 204   let watchman_debug_logging = ref false in
 205   let with_mini_state = ref None in
 206
 207   let set_ai = fun s -> ai_mode := Some (Ai_options.prepare ~server:true s) in
 208   let set_max_procs = fun s -> max_procs := min !max_procs s in
 209   let set_save_mini = fun s -> save := Some s in
 210   let set_wait = fun fd -> waiting_client := Some (Handle.wrap_handle fd) in
 211   let set_with_mini_state = fun s -> with_mini_state := Some s in
 212   let set_from = fun s -> from := s in
 213
 214   let options = [
 215       "--ai", Arg.String set_ai, Messages.ai;
 216       "--check", Arg.Set check_mode, Messages.check;
 217       "--config",
 218         Arg.String (fun s -> config := (String_utils.split2_exn '=' s) :: !config),
 219         Messages.config;
 220       "--daemon", Arg.Set should_detach, Messages.daemon;
 221       "--dynamic-view", Arg.Set dynamic_view, Messages.dynamic_view;
 222       "--file-info-on-disk", Arg.Set file_info_on_disk, Messages.file_info_on_disk;
 223       "--from-emacs", Arg.Set from_emacs, Messages.from_emacs;
 224       "--from-hhclient", Arg.Set from_hhclient, Messages.from_hhclient;
 225       "--from-vim", Arg.Set from_vim, Messages.from_vim;
 226       "--from", Arg.String set_from, Messages.from;
 227       "--gen-saved-ignore-type-errors",
 228         Arg.Set gen_saved_ignore_type_errors,
 229         Messages.gen_saved_ignore_type_errors;
 230       "--ignore-hh-version", Arg.Set ignore_hh, Messages.ignore_hh_version;
 231       "--json", Arg.Set json_mode, Messages.json;
 232       "--load-state-canary", Arg.Set load_state_canary, Messages.load_state_canary;
 233       "--log-inference-constraints", Arg.Set log_inference_constraints, Messages.log_inference_constraints;
 234       "--max-procs", Arg.Int set_max_procs, Messages.max_procs;
 235       "--no-load", Arg.Set no_load, Messages.no_load;
 236       "--no-prechecked", Arg.Unit (fun () -> prechecked := Some false), Messages.prechecked;
 237       "--prechecked", Arg.Unit (fun () -> prechecked := Some true), Messages.prechecked;
 238       "--profile-log", Arg.Set profile_log, Messages.profile_log;
 239       "--replace-state-after-saving",
 240         Arg.Set replace_state_after_saving,
 241         Messages.replace_state_after_saving;
 242       "--save-mini", Arg.String set_save_mini, Messages.save_mini;
 243       "--version", Arg.Set version, "";
 244       "--waiting-client", Arg.Int set_wait, Messages.waiting_client;
 245       "--watchman-debug-logging", Arg.Set watchman_debug_logging, Messages.watchman_debug_logging;
 246       "--with-mini-state", Arg.String set_with_mini_state, Messages.with_mini_state;
 247       "-d", Arg.Set should_detach, Messages.daemon;
 248       "-s", Arg.String set_save_mini, Messages.save_mini;
 249     ] in
 250   let options = Arg.align options in
 251   Arg.parse options (fun s -> root := s) usage;
 252   if !version then begin
 253     if !json_mode then print_json_version ()
 254     else print_endline Build_id.build_id_ohai;
 255     exit 0
 256   end;
 257   (* --json and --save both imply check *)
 258   let check_mode = !check_mode || !json_mode || !save <> None; in
 259   if check_mode && !waiting_client <> None then begin
 260     Printf.eprintf "--check is incompatible with wait modes!\n";
 261     Exit_status.(exit Input_error)
 262   end;
 263   let with_mini_state = verify_with_mini_state with_mini_state in
 264   (match !root with
 265   | "" ->
 266       Printf.eprintf "You must specify a root directory!\n";
 267       Exit_status.(exit Input_error)
 268   | _ -> ());
 269   let root_path = Path.make !root in
 270   ai_mode := (match !ai_mode with
 271     | Some (ai) ->
 272         (* ai may have json mode enabled internally, in which case,
 273          * it should not be disabled by hack if --json was not used *)
 274         if !json_mode then Some (Ai_options.set_json_mode ai true)
 275         else Some (ai)
 276     | None -> None);
 277   Wwwroot.assert_www_directory root_path;
 278   if (!gen_saved_ignore_type_errors) && not (Option.is_some (!save)) then begin
 279     Printf.eprintf "--ignore-type-errors is only valid when producing saved states\n%!";
 280     exit 1
 281   end;
 282   {
 283     ai_mode = !ai_mode;
 284     check_mode = check_mode;
 285     config = !config;
 286     dynamic_view = !dynamic_view;
 287     file_info_on_disk = !file_info_on_disk;
 288     from = !from;
 289     gen_saved_ignore_type_errors = !gen_saved_ignore_type_errors;
 290     ignore_hh_version = !ignore_hh;
 291     json_mode = !json_mode;
 292     load_state_canary = !load_state_canary;
 293     log_inference_constraints = !log_inference_constraints;
 294     max_procs = !max_procs;
 295     no_load = !no_load;
 296     prechecked = !prechecked;
 297     profile_log = !profile_log;
 298     replace_state_after_saving = !replace_state_after_saving;
 299     root = root_path;
 300     save_filename = !save;
 301     should_detach = !should_detach;
 302     waiting_client = !waiting_client;
 303     watchman_debug_logging = !watchman_debug_logging;
 304     with_mini_state = with_mini_state;
 305   }
 306
 307 (* useful in testing code *)
 308 let default_options ~root = {
 309   ai_mode = None;
 310   check_mode = false;
 311   config = [];
 312   dynamic_view = false;
 313   file_info_on_disk = false;
 314   from = "";
 315   gen_saved_ignore_type_errors = false;
 316   ignore_hh_version = false;
 317   json_mode = false;
 318   load_state_canary = false;
 319   log_inference_constraints = false;
 320   max_procs = GlobalConfig.nbr_procs;
 321   no_load = true;
 322   prechecked = None;
 323   profile_log = false;
 324   replace_state_after_saving = false;
 325   root = Path.make root;
 326   save_filename = None;
 327   should_detach = false;
 328   waiting_client = None;
 329   watchman_debug_logging = false;
 330   with_mini_state = None;
 331 }
 332
 333 (*****************************************************************************)
 334 (* Accessors *)
 335 (*****************************************************************************)
 336
 337 let ai_mode options = options.ai_mode
 338 let check_mode options = options.check_mode
 339 let config options = options.config
 340 let dynamic_view options = options.dynamic_view
 341 let file_info_on_disk options = options.file_info_on_disk
 342 let from options = options.from
 343 let gen_saved_ignore_type_errors options = options.gen_saved_ignore_type_errors
 344 let ignore_hh_version options = options.ignore_hh_version
 345 let json_mode options = options.json_mode
 346 let load_state_canary options = options.load_state_canary
 347 let log_inference_constraints options = options.log_inference_constraints
 348 let max_procs options = options.max_procs
 349 let no_load options = options.no_load
 350 let prechecked options = options.prechecked
 351 let profile_log options = options.profile_log
 352 let replace_state_after_saving options = options.replace_state_after_saving
 353 let root options = options.root
 354 let save_filename options = options.save_filename
 355 let should_detach options = options.should_detach
 356 let waiting_client options = options.waiting_client
 357 let watchman_debug_logging options = options.watchman_debug_logging
 358 let with_mini_state options = options.with_mini_state
 359
 360 (*****************************************************************************)
 361 (* Setters *)
 362 (*****************************************************************************)
 363
 364 let set_gen_saved_ignore_type_errors options ignore_type_errors = { options with
 365   gen_saved_ignore_type_errors = ignore_type_errors}
 366 let set_no_load options is_no_load = {options with no_load = is_no_load}
 367 let set_mini_state_target options target = match target with
 368   | None ->
 369     { options with with_mini_state = None }
 370   | Some target ->
 371     { options with
 372       with_mini_state = Some (Informant_induced_mini_state_target target)
 373     }
 374
 375 (****************************************************************************)
 376 (* Misc *)
 377 (****************************************************************************)
 378 let to_string
 379   {
 380     ai_mode;
 381     check_mode;
 382     config;
 383     dynamic_view;
 384     file_info_on_disk;
 385     from;
 386     gen_saved_ignore_type_errors;
 387     ignore_hh_version;
 388     json_mode;
 389     load_state_canary;
 390     log_inference_constraints;
 391     max_procs;
 392     no_load;
 393     prechecked;
 394     profile_log;
 395     replace_state_after_saving;
 396     root;
 397     save_filename;
 398     should_detach;
 399     waiting_client;
 400     watchman_debug_logging;
 401     with_mini_state;
 402   } =
 403     let ai_mode_str = match ai_mode with
 404       | None -> "<>"
 405       | Some _ -> "Some(...)" in
 406     let mini_state_str = match with_mini_state with
 407       | None -> "<>"
 408       | Some _ -> "MiniStateTarget(...)" in
 409     let waiting_client_str = match waiting_client with
 410       | None -> "<>"
 411       | Some _ -> "WaitingClient(...)" in
 412     let save_filename_str = match save_filename with
 413       | None -> "<>"
 414       | Some path -> path in
 415     let prechecked_str = match prechecked with
 416       | None -> "<>"
 417       | Some b -> string_of_bool b in
 418     let config_str = Printf.sprintf "[%s]"
 419       (String.concat ~sep:", " @@ List.map ~f:(fun (key, value) -> Printf.sprintf "%s=%s" key value) config)
 420     in
 421     ([
 422       "ServerArgs.options({";
 423         "ai_mode: "; ai_mode_str; ", ";
 424         "check_mode: "; string_of_bool check_mode; ", ";
 425         "config: "; config_str;
 426         "dynamic_view: "; string_of_bool dynamic_view; ", ";
 427         "file_info_on_disk: "; string_of_bool file_info_on_disk; ", ";
 428         "from: "; from; ", ";
 429         "gen_saved_ignore_type_errors: "; string_of_bool gen_saved_ignore_type_errors; ", ";
 430         "ignore_hh_version: "; string_of_bool ignore_hh_version; ", ";
 431         "json_mode: "; string_of_bool json_mode; ", ";
 432         "load_state_canary: "; string_of_bool load_state_canary; ", ";
 433         "log_inference_constraints: "; string_of_bool log_inference_constraints; ", ";
 434         "maxprocs: "; string_of_int max_procs; ", ";
 435         "no_load: "; string_of_bool no_load; ", ";
 436         "prechecked: "; prechecked_str;
 437         "profile_log: "; string_of_bool profile_log; ", ";
 438         "replace_state_after_saving: "; string_of_bool replace_state_after_saving; ", ";
 439         "root: "; Path.to_string root; ", ";
 440         "save_filename: "; save_filename_str; ", ";
 441         "should_detach: "; string_of_bool should_detach; ", ";
 442         "waiting_client: "; waiting_client_str; ", ";
 443         "watchman_debug_logging: "; string_of_bool watchman_debug_logging; ", ";
 444         "with_mini_state: "; mini_state_str; ", ";
 445       "})"
 446     ] |> String.concat ~sep:"")