os/processes.fz

# This file is part of the Fuzion language implementation.
#
# The Fuzion language implementation is free software: you can redistribute it
# and/or modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation, version 3 of the License.
#
# The Fuzion language implementation is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
# License for more details.
#
# You should have received a copy of the GNU General Public License along with The
# Fuzion language implementation.  If not, see <https://www.gnu.org/licenses/>.


# -----------------------------------------------------------------------
#
#  Tokiwa Software GmbH, Germany
#
#  Source code of Fuzion standard library feature processes
#
# -----------------------------------------------------------------------


# effect for starting processes
#
public processes (ph os.Process_Handler, public running_processes container.Set os.process) : effect is


  # start a process with name, arguments and environment variables
  #
  module start(name String, args Sequence String, env_vars container.Map String String) =>
    (ph.start name args env_vars).bind p->
      os.processes ph (running_processes ? (container.set_of_ordered [p]))
        .replace
      p



  # cleanup effect
  #
  public redef finally unit =>
    running_processes.for_each p->
      # NYI: UNDER DEVELOPMENT: register failures
      _ := p.wait
      _ := fzE_pipe_close p.std_out
      _ := fzE_pipe_close p.std_err


  # wait for process to finish
  #
  # returns the exit code of the process or an error
  #
  module wait(p os.process, timeout time.duration) outcome u32
  pre running_processes.contains p
  =>
    start := time.nano.env.read

    # the maximum poll time for process exit
    #
    upper_bound_poll_time := time.duration.s 1

    os.processes ph (running_processes ? (container.set_of_ordered [p]))
      .replace
    # NYI: UNDER DEVELOPMENT: register errors in runtime_errors_effect
    _ := fzE_pipe_close p.std_in = 0

    for
      r := fzE_process_wait p.pid
      elapsed_time := time.nano.env.read-start
      # NYI: UNDER DEVELOPMENT: replace polling by signaled waits (POSIX) / events (WIN) or similar.
      # 1ms, 2ms, 4ms, 8ms, 16ms, 32ms, ..., 1s
      polling_time := time.duration.ms 1, min upper_bound_poll_time polling_time*2
    while r < 0 && elapsed_time <= timeout
      time.nano.env.sleep (min timeout-elapsed_time polling_time)
    else
      if r >= 0
        r.as_u32
      else
        if elapsed_time > timeout
          error "Waiting for process with id {p.pid} timed out."
        else
          error "Waiting for process with id {p.pid} was unsuccessful" fzE_last_error


  # the processes that were registered
  # in this effect as a string
  #
  public redef as_string String =>
    $running_processes


  # default implementation of os.processes
  #
  # this will get instated automatically at startup
  #
  public redef fixed type.default_value option os.processes =>
    os.processes os.default_handler (container.ps_set os.process).empty


default_handler : os.Process_Handler is

  # start process with option to pass environment variables
  #
  # helper feature for start and `infix |`
  #
  public redef start(n String, args Sequence String, env_vars container.Map String String) outcome os.process
  =>
    sys => fuzion.sys
    NULL := [u8 0].internal_array.data
     # posix_spawn needs last arg to be NULL
    arg_data := array (Array u8) args.count+2 i->
      if i=0 then sys.c_string n else if i<=args.count then sys.c_string args[i-1] else NULL
    env_var_strings := env_vars
      .items
      .map x->
        k, v := x
        "$k=$v"
      .as_array

    # posix_spawn needs last arg to be NULL
    env_data := array (Array u8) env_var_strings.count+1 (i -> if i<env_var_strings.count then sys.c_string env_var_strings[i] else NULL)

    res_data := sys.internal_array_init i64 4

    if (fzE_process_create arg_data.internal_array.data arg_data.count env_data.internal_array.data env_data.count res_data.data) = -1
      error "*** error creating process $n" fzE_last_error
    else
      os.process res_data[0] res_data[1] res_data[2] res_data[3] n args