os/Process_effect.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 Process
#
# -----------------------------------------------------------------------


# effect for starting process
#
public Process ref : effect is


  # start a process with name, arguments and environment variables
  #
  public start(name String, args Sequence String, env_vars container.Map String String) outcome os.process
    pre
      safety: env_vars.keys ? (x -> x.codepoints ? .is_ascii)
  => abstract


  # wait for process to finish
  #
  # returns the exit code of the process or an error
  #
  public wait(p os.process, timeout time.duration) outcome u32 => abstract


  # send signal to process
  #
  public send_signal(p os.process, sig os.signal) outcome unit => abstract



  # default implementation of os.Process
  #
  # this will get instated automatically at startup
  #
  public redef fixed type.default_value option os.Process =>

    # this needs to be a ref since it contains an atomic field
    #
    universe.P_ref ref : os.Process is

      running_processes := concur.atomic (container.Set os.process) .new (container.ps_set os.process).empty

      # 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 "creating process $n" fzE_last_error
        else
          res := os.process res_data[0] res_data[1] res_data[2] res_data[3] n args
          _ := running_processes.update (container.Set os.process)->(container.Set os.process) rp->
            rp ? (container.set_of_ordered [res])
          res


      # wait for process to finish
      #
      # returns the exit code of the process or an error
      #
      public redef wait(p os.process, timeout time.duration) outcome u32
      =>
        if !running_processes.contains p
          error "process not in set of running processes."
        else
          start := time.Nano.env.read

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

          for
            r := fzE_process_poll 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 = -1 && elapsed_time <= timeout
            time.Nano.env.sleep (min timeout-elapsed_time polling_time)
          else
            if r >= 0
              _ := running_processes.update (container.Set os.process)->(container.Set os.process) rp->
                rp ? (container.set_of_ordered [p])
              outcome r.as_u32
            else
              if r = -1 && elapsed_time > timeout
                error "Waiting for process with id $(p.pid) timed out."
              else if r < -100
                sig := (r.abs - 100).as_i32
                sig_name := os.signal.from_number sig .bind s->" ($(s.as_string))" .or_default ""
                error "Process $(p.pid) was terminated by signal $sig$sig_name"
              else
                error "Waiting for process with id $(p.pid) was unsuccessful" fzE_last_error


      # send signal to process
      #
      public redef send_signal(p os.process, sig os.signal) outcome unit =>
        fzE_send_signal p.pid sig.as_i32 = 0 ? unit : error "sending signal to process $(p.pid)" fzE_last_error


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


      # 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

    universe.P_ref