--
--  Copyright (C) 2018-2023, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--

pragma Warnings (Off, "internal GNAT unit");
with System.OS_Interface;
pragma Warnings (On);

with Glib.Error;
with Glib.Spawn;
with Gtkada.Types;

with Spawn.Environments.Internal;
with Spawn.Posix;

package body Spawn.Internal is

   type Process_Access is access all Process'Class;

   function Spawn_Async_With_Fds is
     new Glib.Spawn.Generic_Spawn_Async_With_Fds
       (User_Data => Glib.Gint);

   function Child_Watch is new Glib.Main.Generic_Child_Add_Watch
     (User_Data => Internal.Process_Reference);

   procedure My_Death_Callback
     (pid    : Glib.Spawn.GPid;
      status : Glib.Gint;
      data   : access Internal.Process_Reference)
        with Convention => C;

   procedure Do_Start_Process (Self : aliased in out Process'Class);

   procedure Setup_Child_Process (Fd : access Glib.Gint)
     with Convention => C;
   --  Setup session and controlling terminal when pseudoterminal is used
   --  for interprocess communication.

   package body Environments is

      ---------
      -- "=" --
      ---------

      function "=" (Left, Right : UTF_8_String) return Boolean is
      begin
         return Standard."=" (Left, Right);
      end "=";

      ---------
      -- "<" --
      ---------

      function "<" (Left, Right : UTF_8_String) return Boolean is
      begin
         return Standard."<" (Left, Right);
      end "<";

   end Environments;

   --------------------------
   -- Close_Standard_Error --
   --------------------------

   procedure Close_Standard_Error (Self : in out Process'Class) is
   begin
      Spawn.Channels.Shutdown_Stderr (Self.Channels);
   end Close_Standard_Error;

   --------------------------
   -- Close_Standard_Input --
   --------------------------

   procedure Close_Standard_Input (Self : in out Process'Class) is
   begin
      Spawn.Channels.Shutdown_Stdin (Self.Channels);
   end Close_Standard_Input;

   ---------------------------
   -- Close_Standard_Output --
   ---------------------------

   procedure Close_Standard_Output (Self : in out Process'Class) is
   begin
      Spawn.Channels.Shutdown_Stdout (Self.Channels);
   end Close_Standard_Output;

   ----------------------
   -- Do_Start_Process --
   ----------------------

   procedure Do_Start_Process (Self : aliased in out Process'Class) is
      use Glib;
      use type Interfaces.C.size_t;

      procedure Prepare_Arguments (argv : out Gtkada.Types.Chars_Ptr_Array);
      --  Allocate argumnets

      -----------------------
      -- Prepare_Arguments --
      -----------------------

      procedure Prepare_Arguments (argv : out Gtkada.Types.Chars_Ptr_Array) is
      begin
         argv (0) := Gtkada.Types.New_String (Self.Program);

         for J in 1 .. Self.Arguments.Last_Index loop
            argv (Interfaces.C.size_t (J)) := Gtkada.Types.New_String
              (Self.Arguments.Element (J));
         end loop;

         argv (argv'Last) := Gtkada.Types.Null_Ptr;
      end Prepare_Arguments;

      pid : aliased Glib.Spawn.GPid
        with Import, Address => Self.pid'Address;

      dir  : Gtkada.Types.Chars_Ptr :=
        (if Self.Working_Directory'Length = 0 then Gtkada.Types.Null_Ptr
           else Gtkada.Types.New_String (Self.Working_Directory));

      argv : aliased Gtkada.Types.Chars_Ptr_Array :=
        (0 .. Interfaces.C.size_t (Self.Arguments.Length) + 1 => <>);

      envp : aliased Gtkada.Types.Chars_Ptr_Array :=
        Spawn.Environments.Internal.Raw (Self.Environment);

      Error  : aliased Glib.Error.GError;
      Status : Glib.Gboolean;
      PTY    : aliased Glib.Gint;
      Child  : Spawn.Channels.Pipe_Array;

   begin
      Self.Reference.Self := Self'Unchecked_Access;
      Prepare_Arguments (argv);
      Spawn.Channels.Setup_Channels (Self.Channels, Self.Use_PTY, Child);

      PTY := Spawn.Channels.PTY_Slave (Self.Channels);
      Status :=
        Spawn_Async_With_Fds
          (Working_Directory => dir,
           Argv              => argv'Access,
           Envp              => envp'Access,
           Flags             => Glib.Spawn.G_Spawn_Do_Not_Reap_Child,
           Child_Setup       => Setup_Child_Process'Access,
           Data              => PTY'Unchecked_Access,
           Child_Pid         => pid'Access,
           Stdin_Fd          => Child (Spawn.Common.Stdin),
           Stdout_Fd         => Child (Spawn.Common.Stdout),
           Stderr_Fd         => Child (Spawn.Common.Stderr),
           Error             => Error'Access);

      Gtkada.Types.Free (argv);
      Gtkada.Types.Free (envp);
      Gtkada.Types.Free (dir);
      Spawn.Channels.Close_Child_Descriptors (Self.Channels);

      if Status = 0 then
         Spawn.Channels.Shutdown_Channels (Self.Channels);

         Self.Emit_Error_Occurred (Integer (Glib.Error.Get_Code (Error)));

         return;
      end if;

      Self.Event := Child_Watch
        (pid,
         My_Death_Callback'Access,
         Self.Reference'Access);

      Self.Status := Running;
      Self.Emit_Started;

      Spawn.Channels.Start_Watch (Self.Channels);
   end Do_Start_Process;

   --------------
   -- Finalize --
   --------------

   overriding procedure Finalize (Self : in out Process) is
      use type Glib.Main.G_Source_Id;
   begin
      Spawn.Channels.Shutdown_Channels (Self.Channels);

      if Self.Event /= Glib.Main.No_Source_Id then
         Glib.Main.Remove (Self.Event);
         Self.Event := Glib.Main.No_Source_Id;
      end if;

      Glib.Spawn.Spawn_Close_Pid (Glib.Spawn.GPid (Self.pid));
      Self.pid := 0;
   end Finalize;

   ----------------
   -- Identifier --
   ----------------

   function Identifier (Self : Process'Class) return String is
      use type Interfaces.C.int;
      Image : constant String := Self.pid'Image;
   begin
      return (if Self.pid = 0 then "" else Image (2 .. Image'Last));
   end Identifier;

   ------------------
   -- Kill_Process --
   ------------------

   procedure Kill_Process (Self : in out Process'Class) is
      Ignore : constant Interfaces.C.int :=
        Spawn.Posix.kill
          (Self.pid, Interfaces.C.int (System.OS_Interface.SIGKILL));
   begin
      null;
   end Kill_Process;

   -----------------------
   -- My_Death_Callback --
   -----------------------

   procedure My_Death_Callback
     (pid    : Glib.Spawn.GPid;
      status : Glib.Gint;
      data   : access Internal.Process_Reference)
   is
      use type Glib.GQuark;

      function G_SPAWN_EXIT_ERROR return Glib.GQuark
        with Import        => True,
             Convention    => C,
             External_Name => "g_spawn_exit_error_quark";

      Self  : constant Process_Access := Process_Access (data.Self);
      Error : aliased Glib.Error.GError;

   begin
      Glib.Spawn.Spawn_Close_Pid (pid);

      Self.Event  := Glib.Main.No_Source_Id;
      Self.pid    := 0;

      if Glib.Spawn.Spawn_Check_Exit_Status
        (status, Error'Access)
      then
         Self.Exit_Status := Normal;
         Self.Exit_Code   := 0;

      else
         Self.Exit_Status :=
           (if Glib.Error.Get_Domain (Error) = G_SPAWN_EXIT_ERROR
              then Normal
              else Crash);
         Self.Exit_Code   := Process_Exit_Code (Glib.Error.Get_Code (Error));
      end if;

      if Spawn.Channels.Is_Active (Self.Channels) then
         Self.Pending_Finish := True;
         return;

      end if;

      begin
         Self.Status := Not_Running;
         Self.Emit_Finished (Self.Exit_Status, Self.Exit_Code);

      exception
         when others =>
            null;
      end;

      Spawn.Channels.Shutdown_Channels (Self.Channels);

   exception
      when E : others =>
         Self.Emit_Exception_Occurred (E);
   end My_Death_Callback;

   -------------------------
   -- Read_Standard_Error --
   -------------------------

   procedure Read_Standard_Error
     (Self    : in out Process'Class;
      Data    : out Ada.Streams.Stream_Element_Array;
      Last    : out Ada.Streams.Stream_Element_Offset;
      Success : in out Boolean) is
   begin
      Spawn.Channels.Read_Stderr (Self.Channels, Data, Last, Success);
   end Read_Standard_Error;

   --------------------------
   -- Read_Standard_Output --
   --------------------------

   procedure Read_Standard_Output
     (Self    : in out Process'Class;
      Data    : out Ada.Streams.Stream_Element_Array;
      Last    : out Ada.Streams.Stream_Element_Offset;
      Success : in out Boolean) is
   begin
      Spawn.Channels.Read_Stdout (Self.Channels, Data, Last, Success);
   end Read_Standard_Output;

   -------------------------
   -- Setup_Child_Process --
   -------------------------

   procedure Setup_Child_Process (Fd : access Glib.Gint) is
      use type Glib.Gint;

      Ignore : Interfaces.C.int;
      --  Any failures are ignored.

   begin
      if Fd.all /= -1 then
         Ignore := Spawn.Posix.setsid;
         Ignore :=
           Spawn.Posix.ioctl
             (Interfaces.C.int (Fd.all), Spawn.Posix.TIOCSCTTY, 0);
      end if;
   end Setup_Child_Process;

   -----------
   -- Start --
   -----------

   procedure Start (Self : in out Process'Class) is
   begin
      Self.Status := Starting;
      Self.Exit_Code := -1;
      Do_Start_Process (Self);
   end Start;

   -----------------------
   -- Terminate_Process --
   -----------------------

   procedure Terminate_Process (Self : in out Process'Class) is
      Ignore : constant Interfaces.C.int :=
        Spawn.Posix.kill
          (Self.pid, Interfaces.C.int (System.OS_Interface.SIGTERM));
   begin
      null;
   end Terminate_Process;

   --------------------------
   -- Write_Standard_Input --
   --------------------------

   procedure Write_Standard_Input
     (Self    : in out Process'Class;
      Data    : Ada.Streams.Stream_Element_Array;
      Last    : out Ada.Streams.Stream_Element_Offset;
      Success : in out Boolean) is
   begin
      Spawn.Channels.Write_Stdin (Self.Channels, Data, Last, Success);
   end Write_Standard_Input;

end Spawn.Internal;
