---
breaks: false
tags: public-tech
---

# タイムアウトありでコマンドを実行し、その標準出力と標準エラー出力の内容を得る

この記事は [OCaml Tips Advent Calendar 2022](https://adventar.org/calendars/8396) の14日目です。

OCaml でコマンドを実行する方法としては `Sys.command` がありますが、
これは C 言語の system(3) 相当で、標準入出力などを制御することはできません。
標準入出力や標準エラーを扱うためには `Unix.open_process_args_full` が使えます。
この関数を呼び出すと、標準入力を投げつけるための `in_channel` と、標準出力・
標準エラー出力を受け取るための `out_channel` をもらうことができます。
これらのチャネルに対して `In_channel.input_all` や
`Out_channel.output_string` を適用することで、
コマンドへの入力やコマンドからの出力を制御できます。

これらのチャネルは `Unix.close_process_full` で閉じ、
戻り値としてコマンドの実行結果を `process_status` 型の
値として得ることができます。コマンドの実行が成功した
場合は `WEXITED n` が返却され、`n` に exit code が入ります。
コマンドがシグナルで終了した場合は `WSIGNALED n` や `WSTOPPED n` が返却され、
`n` にシグナルの種類が入ります。この値は signal(7) に書かれている値**ではなく**、
OCaml が `Sys` モジュール下で定義した値になります。例えば
SIGSEGV の場合 `Sys.sigsegv` で `-10` になります。

さて `Unix.close_process_full` は、コマンドの実行が終わるまでブロックされるため、
単純にはコマンド実行のタイムアウトを実現できません[^timeout]。
そこで今回は、タイムアウトするべき一定時間がコマンド実行から経過した場合に `SIGALRM` を
発生させ、これを親プロセスでハンドルして子プロセスを kill します。
`SIGALRM` のトリガーには `Unix.alarm` が、子プロセスの kill には
`Unix.process_full_pid` と `Unix.kill` が使えます。

[^timeout]: timeout(1) を併用することで実現できる気もしますが、もともとのコマンドからのシグナルを正しく受け取れないんじゃないかと思います。あんまりちゃんと確認していません。

以上をまとめて一つの関数にすると次のような感じになります。
ついでに `Unix.chdir` を使ってワーキングディレクトリを変更してから
コマンドを実行する機能もつけています。
なお、このコードを Dune 配下で実行するためには
dune ファイルの `libraries` に `unix` を追加してください。

exception
  ExecCmdFailure of {
    status : [ `Timeout | `Unix of Unix.process_status ];
    wd : string;
    params : string list;
    err : string;
    out : string;
  }

let exec_cmd ?(timeout = None) ?(may_fail = false) ?(wd = "") prog args =
  let changed_wd wd f =
    let org = Unix.getcwd () in
    Unix.chdir wd;
    f |> Fun.protect ~finally:(fun () -> Unix.chdir org)
  in
  let f () =
    (* Execute command *)
    let params = prog :: args in
    let ic_out, oc_in, ic_err =
      Unix.open_process_args_full (List.hd params) (Array.of_list params)
        (Unix.environment ())
    in
    (* Set timeout if specified *)
    let is_timeout = ref false in
    let prev_handler =
      timeout
      |> Option.map (fun seconds ->
             let open Sys in
             let pid = Unix.process_full_pid (ic_out, oc_in, ic_err) in
             let handler _ =
               is_timeout := true;
               Unix.kill pid sigterm
             in
             let h = signal sigalrm (Signal_handle handler) in
             Unix.alarm seconds |> ignore;
             h)
    in
    (fun () ->
      (* Wait for the command to finish (or abort) *)
      let out = In_channel.input_all ic_out in
      let err = In_channel.input_all ic_err in
      let res = Unix.close_process_full (ic_out, oc_in, ic_err) in
      match res with
      | WEXITED 0 -> (0, out, err)
      | WEXITED c when may_fail -> (c, out, err)
      | unix_status ->
          let status = if !is_timeout then `Timeout else `Unix unix_status in
          let exc = ExecCmdFailure { status; wd; params; err; out } in
          raise exc)
    |> Fun.protect ~finally:(fun () ->
           let open Sys in
           prev_handler |> Option.iter (set_signal sigalrm))
  in
  if wd = "" then f () else changed_wd wd f

let () =
  (* ls をホームディレクトリで実行 *)
  let code, out, err = exec_cmd ~wd:"/home/anqou" "ls" [] in
  Printf.printf "%d, %s, %s\n" code out err;
  (* sleep 10 を実行、ただし 1 秒でタイムアウト *)
  try exec_cmd ~timeout:(Some 1) "sleep" [ "10" ] |> ignore
  with ExecCmdFailure { status = `Timeout; _ } -> print_endline "timeout"