File : posix-unsafe_process_primitives.adb


pragma Source_Reference (1, "posix-unsafe_process_primitives.gpb");
------------------------------------------------------------------------------
--                                                                          --
--            FLORIST (FSU Implementation of POSIX.5) COMPONENTS            --
--                                                                          --
--       P O S I X . U N S A F E _ P R O C E S S _ P R I M I T I V E S      --
--                                                                          --
--                                  B o d y                                 --
--                                                                          --
--                                                                          --
--  Copyright (c) 1996-1998             Florida  State  University  (FSU),  --
--  All Rights Reserved.                                                    --
--                                                                          --
--  This file is a component of FLORIST, an  implementation of an  Ada API  --
--  for the POSIX OS services, for use with  the  GNAT  Ada  compiler  and  --
--  the FSU Gnu Ada Runtime Library (GNARL).   The  interface  is intended  --
--  to be close to that specified in  IEEE STD  1003.5: 1990  and IEEE STD  --
--  1003.5b: 1996.                                                          --
--                                                                          --
--  FLORIST is free software;  you can  redistribute  it and/or  modify it  --
--  under terms of the  GNU  General  Public  License as  published by the  --
--  Free Software Foundation;  either version  2, or (at  your option) any  --
--  later version.  FLORIST 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  distributed  with  GNARL;  see  --
--  file  COPYING.  If not,  write to  the  Free  Software  Foundation, 59  --
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.                   --
--                                                                          --
--  As a special exception, if other files instantiate generics from  this  --
--  unit, or you link this unit with other files to produce an  executable, --
--  this  unit does not by itself cause the  resulting  executable  to  be  --
--  covered  by the  GNU  General  Public License. This exception does not  --
--  however invalidate any other  reasons why the executable file might be  --
--  covered by the GNU Public License.                                      --
--                                                                          --
------------------------------------------------------------------------------
--  [$Revision: 1.4 $]


with POSIX.C,
     POSIX.Implementation,
     POSIX.Process_Environment,
     POSIX.Process_Identification,
     System,
     System.Tasking,
     System.Soft_Links,
     Unchecked_Conversion;
package body POSIX.Unsafe_Process_Primitives is

   use POSIX.C,
       POSIX.Implementation;

   function To_Process_ID is new Unchecked_Conversion
     (pid_t, POSIX.Process_Identification.Process_ID);
   function To_String_List_Ptr is new Unchecked_Conversion
     (POSIX_String_List, String_List_Ptr);
   function To_String_List_Ptr is new Unchecked_Conversion
     (POSIX.Process_Environment.Environment, String_List_Ptr);
   function To_Address is new Unchecked_Conversion
     (System.Tasking.Task_ID, System.Address);

   -------------------------
   --  Local Subprograms  --
   -------------------------

   function Make_Path_Name
     (Directory : POSIX_String;
      File : POSIX_String) return POSIX_String;
   pragma Inline (Make_Path_Name);

   --  Concatenate a directory name and a file name.

   function Make_Path_Name
     (Directory : POSIX_String;
      File : POSIX_String) return POSIX_String is
   begin
      if Directory = "" then return File; end if;
      if Directory (Directory'Last) = '/' then
         return Directory & File;
      end if;
      return Directory & '/' & File;
   end Make_Path_Name;

   ------------
   --  Fork  --
   ------------

   function fork return pid_t;
   pragma Import (C, fork, fork_LINKNAME);

   function getpid return pid_t;
   pragma Import (C, getpid, getpid_LINKNAME);

   function Fork return POSIX.Process_Identification.Process_ID is
      Result : pid_t;
      package TSL renames System.Soft_Links;
      --  save local values of soft-link data
      NT_Sec_Stack_Addr : System.Address := TSL.Get_Sec_Stack_Addr.all;
      NT_Exc_Stack_Addr : System.Address := TSL.Get_Exc_Stack_Addr.all;





      NT_Jmpbuf_Address : System.Address := TSL.Get_Jmpbuf_Address.all;
   begin
      Result := fork;
      if Result = -1 then Raise_POSIX_Error; end if;
      if Result = 0 then

         This_Process := getpid;

         --  reset soft links to non-tasking versions of operations

         TSL.Abort_Defer        := TSL.Abort_Defer_NT'Access;
         TSL.Abort_Undefer      := TSL.Abort_Undefer_NT'Access;

         TSL.Lock_Task          := TSL.Task_Lock_NT'Access;
         TSL.Unlock_Task        := TSL.Task_Unlock_NT'Access;
         TSL.Get_Jmpbuf_Address := TSL.Get_Jmpbuf_Address_NT'Access;
         TSL.Set_Jmpbuf_Address := TSL.Set_Jmpbuf_Address_NT'Access;
         TSL.Get_Sec_Stack_Addr := TSL.Get_Sec_Stack_Addr_NT'Access;
         TSL.Set_Sec_Stack_Addr := TSL.Set_Sec_Stack_Addr_NT'Access;
         TSL.Get_Exc_Stack_Addr := TSL.Get_Exc_Stack_Addr_NT'Access;
         TSL.Set_Exc_Stack_Addr := TSL.Set_Exc_Stack_Addr_NT'Access;








         --  reset global data to saved local values for this thread
         TSL.Set_Sec_Stack_Addr (NT_Sec_Stack_Addr);

         TSL.Set_Exc_Stack_Addr
           (To_Address (System.Tasking.Self), NT_Exc_Stack_Addr);



         TSL.Set_Jmpbuf_Address (NT_Jmpbuf_Address);





      end if;
      return To_Process_ID (Result);
   end Fork;

   ------------
   --  Exec  --
   ------------

   function execve
     (path : char_ptr;
      argv : char_ptr_ptr;
      envp : char_ptr_ptr) return int;
   pragma Import (C, execve, execve_LINKNAME);

   procedure Exec
     (Pathname : in POSIX.Pathname;
      Arg_List : in POSIX.POSIX_String_List
               := POSIX.Empty_String_List;
      Env_List : in POSIX.Process_Environment.Environment) is
      Pathname_With_NUL : POSIX_String := Pathname & NUL;
      Arg : String_List_Ptr := To_String_List_Ptr (Arg_List);
      Env : String_List_Ptr := To_String_List_Ptr (Env_List);
   begin
      if Arg = null then Arg := Null_String_List_Ptr;
      end if;
      if Env = null then Env := Null_String_List_Ptr;
      end if;
      Check (execve
        (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access,
         Arg.Char (1)'Unchecked_Access,
         Env.Char (1)'Unchecked_Access));
   end Exec;

   ------------
   --  Exec  --
   ------------

   function execv
     (path : char_ptr;
      argv : char_ptr_ptr) return int;
   pragma Import (C, execv, execv_LINKNAME);

   procedure Exec
     (Pathname : in POSIX.Pathname;
      Arg_List : in POSIX.POSIX_String_List
               := POSIX.Empty_String_List) is
      Pathname_With_NUL : POSIX_String := Pathname & NUL;
      Arg : String_List_Ptr := To_String_List_Ptr (Arg_List);
   begin
      if Arg = null then Arg := Null_String_List_Ptr;
      end if;
      Check (execv
        (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access,
         Arg.Char (1)'Unchecked_Access));
   end Exec;

   -------------------
   --  Exec_Search  --
   -------------------

   procedure Exec_Search
     (Filename : in POSIX.Filename;
      Arg_List : in POSIX.POSIX_String_List := POSIX.Empty_String_List;
      Env_List : in POSIX.Process_Environment.Environment) is
      Filename_With_NUL : POSIX_String := Filename & NUL;
      Arg : String_List_Ptr := To_String_List_Ptr (Arg_List);
      Env : String_List_Ptr := To_String_List_Ptr (Env_List);
   begin
      --  .... Change POSIX.5?
      --  There is no POSIX.1 function that takes an environment list
      --  and searches for a filename, apparently, so we have to simulate
      --  the effect here.
      if Arg = null then Arg := Null_String_List_Ptr;
      end if;
      if Env = null then Env := Null_String_List_Ptr;
      end if;
      for I in Filename'Range loop
         if Filename (I) = '/' then
            Check (execve
              (Filename_With_NUL (Filename_With_NUL'First)'Unchecked_Access,
               Arg.Char (1)'Unchecked_Access,
               Env.Char (1)'Unchecked_Access));
            return;
         end if;
      end loop;
      --  filename does not contain "/"
      declare
         Path : constant POSIX_String
              := POSIX.Process_Environment.Environment_Value_Of
                 ("PATH", "/bin:/usr/bin");
         Start : Positive;
         P : Positive;
         Err : Error_Code := No_Such_File_Or_Directory;
      begin
         P := Path'First;
         loop
            Start := P;
            while P <= Path'Last and then Path (P) /= ':' loop
               P := P + 1;
            end loop;
            declare
               Pathname : POSIX_String
                 := Make_Path_Name (Path (Start .. P - 1), Filename);
            begin
               Exec (Pathname, Arg_List, Env_List);
            exception
            when POSIX_Error => null;
            end;
            if Get_Error_Code /= No_Such_File_Or_Directory then
               Err := Get_Error_Code;
            end if;
            exit when P > Path'Last;
            P := P + 1; -- skip colon
         end loop;
         Raise_POSIX_Error (Err);
      end;
   end Exec_Search;

   -------------------
   --  Exec_Search  --
   -------------------

   function execvp
     (file : char_ptr;
      argv : char_ptr_ptr) return int;
   pragma Import (C, execvp, execvp_LINKNAME);

   procedure Exec_Search
     (Filename : in POSIX.Filename;
      Arg_List : in POSIX.POSIX_String_List
               := POSIX.Empty_String_List) is
      Filename_With_NUL : POSIX_String := Filename & NUL;
      Arg : String_List_Ptr := To_String_List_Ptr (Arg_List);
   begin
      if Arg = null then Arg := Null_String_List_Ptr;
      end if;
      Check (execvp
        (Filename_With_NUL (Filename_With_NUL'First)'Unchecked_Access,
         Arg.Char (1)'Unchecked_Access));
   end Exec_Search;

end POSIX.Unsafe_Process_Primitives;