hphp/hack/src/hh_client.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 (**
  11  * Hack for HipHop: type checker's client code.
  12  *
  13  * This code gets called in various different ways:
  14  * - from emacs, where the output is asynchronous
  15  * - from vim, where vim is blocked until this code exits
  16  * - from arc diff, our linter
  17  * - from arc land, our commit hook
  18  * - from check trunk, our irc bot which checks the state of trunk
  19  * - manually, from the command line
  20  *
  21  * Usage: hh_client [OPTION]... [WWW DIRECTORY] [FILE]...
  22  *
  23  *)
  24
  25 open Hh_prelude
  26
  27 let () = Random.self_init ()
  28
  29 let () =
  30   (* no-op, needed at entry-point for Daemon hookup *)
  31   Daemon.check_entry_point ();
  32
  33   (* Ignore SIGPIPE since we might get a server hangup and don't care (can
  34    * detect and handle better than a signal). Ignore SIGUSR1 since we sometimes
  35    * use that for the server to tell us when it's done initializing, but if we
  36    * aren't explicitly listening we don't care. *)
  37   Sys_utils.set_signal Sys.sigpipe Sys.Signal_ignore;
  38   Sys_utils.set_signal
  39     Sys.sigint
  40     (Sys.Signal_handle (fun _ -> raise Exit_status.(Exit_with Interrupted)));
  41   let init_id = Random_id.short_string () in
  42   let command = ClientArgs.parse_args ~init_id in
  43   let command_name =
  44     match command with
  45     | ClientCommand.CCheck _ -> "Check"
  46     | ClientCommand.CStart _ -> "Start"
  47     | ClientCommand.CStop _ -> "Stop"
  48     | ClientCommand.CRestart _ -> "Restart"
  49     | ClientCommand.CLsp _ -> "Lsp"
  50     | ClientCommand.CDebug _ -> "Debug"
  51     | ClientCommand.CDownloadSavedState _ -> "DownloadSavedState"
  52     | ClientCommand.CRage _ -> "Rage"
  53   in
  54
  55   (* Set up logging. *)
  56   let root = ClientArgs.root command in
  57   HackEventLogger.client_init
  58     ~init_id
  59     (Option.value root ~default:Path.dummy_path);
  60   Hh_logger.Level.set_min_level_file Hh_logger.Level.Info;
  61   Hh_logger.Level.set_min_level_stderr Hh_logger.Level.Error;
  62   Hh_logger.set_id (Printf.sprintf "%s#%s" command_name init_id);
  63   begin
  64     match root with
  65     | None -> ()
  66     | Some root ->
  67       let client_log_fn = ServerFiles.client_log root in
  68       (try
  69          (* For irritating reasons T67177821 we might not have permissions
  70          to write to the file. Pending a fix, let's only set up Hh_logger
  71          to write to the file if we can indeed safely write to it. *)
  72          Sys_utils.touch
  73            (Sys_utils.Touch_existing_or_create_new
  74               { mkdir_if_new = false; perm_if_new = 0o666 })
  75            client_log_fn;
  76          Hh_logger.set_log client_log_fn
  77        with _ -> ())
  78   end;
  79   Hh_logger.log
  80     "[hh_client] %s"
  81     (String.concat ~sep:" " (Array.to_list Sys.argv));
  82
  83   try
  84     let exit_status =
  85       match command with
  86       | ClientCommand.CCheck check_env ->
  87         Lwt_main.run (ClientCheck.main check_env)
  88       | ClientCommand.CStart env -> Lwt_main.run (ClientStart.main env)
  89       | ClientCommand.CStop env -> Lwt_main.run (ClientStop.main env)
  90       | ClientCommand.CRestart env -> Lwt_main.run (ClientRestart.main env)
  91       | ClientCommand.CLsp env -> Lwt_main.run (ClientLsp.main env)
  92       | ClientCommand.CDebug env -> Lwt_main.run (ClientDebug.main env)
  93       | ClientCommand.CRage env -> Lwt_main.run (ClientRage.main env)
  94       | ClientCommand.CDownloadSavedState env ->
  95         Lwt_main.run (ClientDownloadSavedState.main env)
  96     in
  97     Exit_status.exit exit_status
  98   with exn ->
  99     let e = Exception.wrap exn in
 100     (* We trust that if someone raised Exit_with then they had the decency to print
 101     out a user-facing message; we will only print out a user-facing message here
 102     for uncaught exceptions: lvl=Error gets sent to stderr, but lvl=Info doesn't. *)
 103     let (es, lvl) =
 104       match exn with
 105       | Exit_status.Exit_with es -> (es, Hh_logger.Level.Info)
 106       | _ -> (Exit_status.Uncaught_exception, Hh_logger.Level.Error)
 107     in
 108     Hh_logger.log
 109       ~lvl
 110       "hh_client bad exit: %s - %s\n%s"
 111       (Exit_status.show es)
 112       (Exception.get_ctor_string e)
 113       (Exception.get_backtrace_string e |> Exception.clean_stack);
 114     HackEventLogger.client_bad_exit ~command_name es e;
 115     Exit_status.exit es