trivial: add a new alarm capability for timeout (semgrep/semgrep-prop…

…rietary#2130)

test plan:
make lite
make test

synced from Pro d006ea11a64df094f5f03d66c8e6aa630701a781

TCB/Cap.ml

@@ -126,10 +126,10 @@ module Process = struct
   type env = cap
 
   (* advanced stuff
-   * TODO: subtypes, like timeout signal very important
-   * TODO: split signal?
+   * TODO: split signal? use subtypes to make alarm a subtype of signal?
    *)
   type signal = cap
+  type alarm = cap
   type exit = cap
   type pid = cap
   type kill = cap
@@ -208,6 +208,7 @@ type console = < stdin ; stdout ; stderr >
 type argv = < argv : Process.argv >
 type env = < env : Process.env >
 type signal = < signal : Process.signal >
+type alarm = < alarm : Process.signal >
 type exit = < exit : Process.exit >
 type pid = < pid : Process.pid >
 type kill = < kill : Process.kill >
@@ -216,7 +217,7 @@ type fork = < fork : Process.fork >
 type domain = < domain : Process.domain >
 type thread = < thread : Process.thread >
 type process_multi = < pid ; kill ; fork ; domain ; thread >
-type process_single = < signal ; exit ; chdir >
+type process_single = < signal ; alarm ; exit ; chdir >
 type process = < argv ; env ; console ; process_single ; process_multi >
 
 (* exec *)
@@ -271,6 +272,7 @@ let powerbox : all_caps =
     method kill = ()
     method chdir = ()
     method signal = ()
+    method alarm = ()
     method fork = ()
     method exit = ()
     method domain = ()
@@ -308,9 +310,10 @@ let stdout_caps_UNSAFE () =
   end
 
 (* !!DO NOT USE!! *)
-let fork_caps_UNSAFE () =
+let fork_and_alarm_caps_UNSAFE () =
   object
     method fork = ()
+    method alarm = ()
   end
 
 (* !!DO NOT USE!! *)

TCB/Cap.mli

@@ -31,6 +31,7 @@ module Process : sig
   type pid
   type kill
   type chdir
+  type alarm (* one of the signal *)
 
   (* See also the separate Exec.t *)
   type fork
@@ -119,6 +120,7 @@ type console = < stdin ; stdout ; stderr >
 type argv = < argv : Process.argv >
 type env = < env : Process.env >
 type signal = < signal : Process.signal >
+type alarm = < alarm : Process.signal >
 type exit = < exit : Process.exit >
 type pid = < pid : Process.pid >
 type kill = < kill : Process.kill >
@@ -127,7 +129,7 @@ type fork = < fork : Process.fork >
 type domain = < domain : Process.domain >
 type thread = < thread : Process.thread >
 type process_multi = < pid ; kill ; fork ; domain ; thread >
-type process_single = < signal ; exit ; chdir >
+type process_single = < signal ; alarm ; exit ; chdir >
 type process = < argv ; env ; console ; process_single ; process_multi >
 
 (* exec *)
@@ -171,7 +173,7 @@ val no_caps : no_caps
 val network_caps_UNSAFE : unit -> < network >
 val tmp_caps_UNSAFE : unit -> < tmp >
 val stdout_caps_UNSAFE : unit -> < stdout >
-val fork_caps_UNSAFE : unit -> < fork >
+val fork_and_alarm_caps_UNSAFE : unit -> < fork ; alarm >
 val exec_and_tmp_caps_UNSAFE : unit -> < exec ; tmp >
 
 (**************************************************************************)

TCB/forbid_process.jsonnet

@@ -3,9 +3,15 @@ local common = import 'common.libsonnet';
 
 local unix_funcs = [
   'fork',
+  'setitimer',
   //TODO: alarm, signal, kill, waitpid
 ];
 
+local sys_funcs = [
+  'sigalrm',
+  //TODO: set_signal
+];
+
 {
   rules: [
     {
@@ -14,6 +20,9 @@ local unix_funcs = [
         // Unix
         [('Unix.' + p) for p in unix_funcs] +
         [('UUnix.' + p) for p in unix_funcs] +
+        // Sys
+        [('Sys.' + p) for p in sys_funcs] +
+        [('USys.' + p) for p in sys_funcs] +
 	// Parmap
 	['Parmap.$F'] +
         //TODO Other libs?
@@ -22,7 +31,7 @@ local unix_funcs = [
       languages: ['ocaml'],
       paths: {
         exclude: common.exclude_paths +
-	['Parmap_.ml']
+	['Parmap_.ml', 'Time_limit.ml']
       },
       severity: 'ERROR',
       message: |||

src/core_cli/Core_CLI.ml

@@ -341,7 +341,7 @@ let all_actions (caps : Cap.all_caps) () =
       " <metachecks file> <files or dirs>",
       Arg_.mk_action_n_conv Fpath.v
         (Check_rule.check_files
-           (caps :> < Cap.stdout ; Cap.fork >)
+           (caps :> < Cap.stdout ; Cap.fork ; Cap.alarm >)
            !output_format) );
     (* this is run by some of our workflows (e.g., check-pro-rules.jsonnet) *)
     ( "-test_rules",

src/core_scan/Core_scan.ml

@@ -115,8 +115,8 @@ module Out = Semgrep_output_v1_j
    semgrep and semgrep-proprietary use the same definition *)
 type func = Core_scan_config.t -> Core_result.result_or_exn
 
-(* TODO: far more: alarm, stdout (sometimes), ... *)
-type caps = < Cap.fork >
+(* TODO: stdout (sometimes) *)
+type caps = < Cap.fork ; Cap.alarm >
 
 (* A target is [Not_scanned] when semgrep didn't find any applicable rules.
  * The information is useful to return to pysemgrep/osemgrep to
@@ -815,7 +815,8 @@ let sca_rules_filtering (target : Target.regular) (rules : Rule.t list) :
 (*****************************************************************************)
 
 (* build the callback for iter_targets_and_get_matches_and_exn_to_errors *)
-let mk_target_handler (config : Core_scan_config.t) (valid_rules : Rule.t list)
+let mk_target_handler (caps : < Cap.alarm >) (config : Core_scan_config.t)
+    (valid_rules : Rule.t list)
     (prefilter_cache_opt : Match_env.prefilter_config) : target_handler =
   (* Note that this function runs in another process *)
   function
@@ -867,7 +868,11 @@ let mk_target_handler (config : Core_scan_config.t) (valid_rules : Rule.t list)
       let timeout =
         Some
           Match_rules.
-            { timeout = config.timeout; threshold = config.timeout_threshold }
+            {
+              timeout = config.timeout;
+              threshold = config.timeout_threshold;
+              caps :> < Cap.alarm >;
+            }
       in
       let matches =
         (* !!Calling Match_rules!! Calling the matching engine!! *)
@@ -907,7 +912,9 @@ let scan_exn (caps : caps) (config : Core_scan_config.t)
     |> iter_targets_and_get_matches_and_exn_to_errors
          (caps :> < Cap.fork >)
          config
-         (mk_target_handler config valid_rules prefilter_cache_opt)
+         (mk_target_handler
+            (caps :> < Cap.alarm >)
+            config valid_rules prefilter_cache_opt)
   in
   let scanned = scanned_of_targets ~targets ~scanned_targets in
 

src/core_scan/Core_scan.mli

@@ -1,7 +1,9 @@
 (* The type of the semgrep "core" scan. We define it here so that
    semgrep and semgrep-proprietary use the same definition *)
 type func = Core_scan_config.t -> Core_result.result_or_exn
-type caps = < Cap.fork >
+
+(* alias to avoid repeating ourselves in many callers *)
+type caps = < Cap.fork ; Cap.alarm >
 
 (* Entry point. This is used in Core_CLI.ml for semgrep-core,
  * in Pro_core_CLI for semgrep-core-proprietary, in tests, and finally
@@ -26,7 +28,7 @@ type caps = < Cap.fork >
  * or UConsole. In theory, scan() can be completely pure.
  *
  * We require Cap.fork for Parmap.
- * TODO: require Cap.alarm (for timeout in Check_rules()), and more.
+ * We require Cap.alarm for timeout in Check_rules().
  *
  * The scan function has the type [func] defined above.
  *

src/engine/Match_rules.ml

@@ -35,7 +35,7 @@ exception File_timeout of Rule_ID.t list
 (* TODO make this one of the Semgrep_error_code exceptions *)
 exception Multistep_rules_not_available
 
-type timeout_config = { timeout : float; threshold : int }
+type timeout_config = { timeout : float; threshold : int; caps : < Cap.alarm > }
 
 (*****************************************************************************)
 (* Helpers *)

src/engine/Match_rules.mli

@@ -1,7 +1,7 @@
 (* this can be raised when timeout_threshold is set *)
 exception File_timeout of Rule_ID.t list
 
-type timeout_config = { timeout : float; threshold : int }
+type timeout_config = { timeout : float; threshold : int; caps : < Cap.alarm > }
 
 (* Matches many rules against one target. This function is called from
  * Test_engine.ml, Test_subcommand.ml, and of course Core_scan.ml

src/metachecking/Check_rule.ml

@@ -318,8 +318,10 @@ let run_checks (caps : Core_scan.caps) (metachecks : Fpath.t)
       in
       semgrep_found_errs @ ocaml_found_errs
 
-(* for semgrep-core -check_rules, called from pysemgrep --validate *)
-let check_files (caps : < Cap.stdout ; Cap.fork >)
+(* for semgrep-core -check_rules, called from pysemgrep --validate
+ * caps = Core_scan.caps + Cap.stdout
+ *)
+let check_files (caps : < Cap.stdout ; Cap.fork ; Cap.alarm >)
     (output_format : Core_scan_config.output_format) (input : Fpath.t list) :
     unit =
   let errors =

src/metachecking/Check_rule.mli

@@ -9,7 +9,7 @@ val run_checks :
 
 (* -check_rules *)
 val check_files :
-  < Cap.stdout ; Cap.fork > ->
+  < Cap.stdout ; Cap.fork ; Cap.alarm > ->
   Core_scan_config.output_format ->
   Fpath.t list ->
   unit

src/osemgrep/cli/CLI.ml

@@ -44,7 +44,8 @@ type caps =
   ; Cap.signal
   ; Cap.tmp
   ; Cap.chdir
-  ; Cap.fork >
+  ; Cap.fork
+  ; Cap.alarm >
 
 let default_subcommand = "scan"
 
@@ -198,7 +199,12 @@ let dispatch_subcommand (caps : caps) (argv : string array) =
         | "scan" ->
             Scan_subcommand.main
               (caps
-                :> < Cap.stdout ; Cap.network ; Cap.tmp ; Cap.chdir ; Cap.fork >)
+                :> < Cap.stdout
+                   ; Cap.network
+                   ; Cap.tmp
+                   ; Cap.chdir
+                   ; Cap.fork
+                   ; Cap.alarm >)
               subcmd_argv
         | "ci" ->
             Ci_subcommand.main
@@ -208,7 +214,8 @@ let dispatch_subcommand (caps : caps) (argv : string array) =
                    ; Cap.exec
                    ; Cap.tmp
                    ; Cap.chdir
-                   ; Cap.fork >)
+                   ; Cap.fork
+                   ; Cap.alarm >)
               subcmd_argv
         | "install-semgrep-pro" ->
             Install_semgrep_pro_subcommand.main
@@ -217,7 +224,8 @@ let dispatch_subcommand (caps : caps) (argv : string array) =
         (* osemgrep-only: and by default! no need experimental! *)
         | "lsp" ->
             Lsp_subcommand.main
-              (caps :> < Cap.random ; Cap.network ; Cap.tmp ; Cap.fork >)
+              (caps
+                :> < Cap.random ; Cap.network ; Cap.tmp ; Cap.fork ; Cap.alarm >)
               subcmd_argv
         | "logout" ->
             Logout_subcommand.main (caps :> < Cap.stdout >) subcmd_argv

src/osemgrep/cli/CLI.mli

@@ -9,7 +9,8 @@ type caps =
   ; Cap.signal
   ; Cap.tmp
   ; Cap.chdir
-  ; Cap.fork >
+  ; Cap.fork
+  ; Cap.alarm >
 
 (*
    Parse the semgrep command line, run the requested subcommand, and return

src/osemgrep/cli_ci/Ci_subcommand.ml

@@ -90,7 +90,13 @@ module OutJ = Semgrep_output_v1_j
  * TODO: probably far more needed at some point
  *)
 type caps =
-  < Cap.stdout ; Cap.network ; Cap.exec ; Cap.tmp ; Cap.chdir ; Cap.fork >
+  < Cap.stdout
+  ; Cap.network
+  ; Cap.exec
+  ; Cap.tmp
+  ; Cap.chdir
+  ; Cap.fork
+  ; Cap.alarm >
 
 (*****************************************************************************)
 (* Error management *)
@@ -823,7 +829,7 @@ let run_conf (caps : caps) (ci_conf : Ci_CLI.conf) : Exit_code.t =
     in
     let res =
       Scan_subcommand.check_targets_with_rules
-        (caps :> < Cap.stdout ; Cap.chdir ; Cap.tmp ; Cap.fork >)
+        (caps :> < Cap.stdout ; Cap.chdir ; Cap.tmp ; Cap.fork ; Cap.alarm >)
         conf profiler rules_and_origin targets_and_ignored
     in
     match res with

src/osemgrep/cli_ci/Ci_subcommand.mli

@@ -1,22 +1,24 @@
 module OutJ = Semgrep_output_v1_j
 
+type caps =
+  < Cap.stdout
+  ; Cap.network
+  ; Cap.exec
+  ; Cap.tmp
+  ; Cap.chdir
+  ; Cap.fork
+  ; Cap.alarm >
+
 (*
    Parse a semgrep-ci command, execute it and exit.
 
    Usage: main [| "semgrep-ci"; ... |]
 
    This function returns an exit code to be passed to the 'exit' function.
 *)
-val main :
-  < Cap.network ; Cap.stdout ; Cap.exec ; Cap.tmp ; Cap.chdir ; Cap.fork > ->
-  string array ->
-  Exit_code.t
+val main : caps -> string array -> Exit_code.t
 
 (* internal *)
-val run_conf :
-  < Cap.network ; Cap.stdout ; Cap.exec ; Cap.tmp ; Cap.chdir ; Cap.fork > ->
-  Ci_CLI.conf ->
-  Exit_code.t
-
+val run_conf : caps -> Ci_CLI.conf -> Exit_code.t
 val rule_is_blocking : JSON.t -> bool
 val finding_is_blocking : OutJ.cli_match -> bool

src/osemgrep/cli_lsp/Lsp_subcommand.ml

@@ -9,7 +9,7 @@
 (*****************************************************************************)
 (* Types *)
 (*****************************************************************************)
-type caps = < Cap.random ; Cap.network ; Cap.tmp ; Cap.fork >
+type caps = < Cap.random ; Cap.network ; Cap.tmp ; Cap.fork ; Cap.alarm >
 
 (* Set IO here since it is specific to the LS entrypoint *)
 (* This one utilizes unix IO, but the JS version does not *)

src/osemgrep/cli_lsp/Lsp_subcommand.mli

@@ -1,17 +1,13 @@
+type caps = < Cap.random ; Cap.network ; Cap.tmp ; Cap.fork ; Cap.alarm >
+
 (*
    Parse a semgrep-lsp command, execute it and exit.
 
    Usage: main [| "semgrep-lsp"; ... |]
 
    This function returns an exit code to be passed to the 'exit' function.
 *)
-val main :
-  < Cap.random ; Cap.network ; Cap.tmp ; Cap.fork > ->
-  string array ->
-  Exit_code.t
+val main : caps -> string array -> Exit_code.t
 
 (* internal *)
-val run_conf :
-  < Cap.random ; Cap.network ; Cap.tmp ; Cap.fork > ->
-  Lsp_CLI.conf ->
-  Exit_code.t
+val run_conf : caps -> Lsp_CLI.conf -> Exit_code.t