File : posix-file_locking.adb


------------------------------------------------------------------------------
--                                                                          --
--            FLORIST (FSU Implementation of POSIX.5) COMPONENTS            --
--                                                                          --
--                    P O S I X . F I L E _ L O C K I N G                   --
--                                                                          --
--                                  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.1.1.1 $]

with POSIX.C,
     POSIX.Implementation,
     POSIX.IO,
     POSIX.Process_Identification,
     Unchecked_Conversion;
package body POSIX.File_Locking is

   use POSIX.C,
       POSIX.Implementation;

   function To_Process_ID is
     new Unchecked_Conversion (pid_t, POSIX.Process_Identification.Process_ID);

   C_Lock_Type : constant array (Lock_Kind) of short :=
     (Read_Lock => F_RDLCK,
      Write_Lock => F_WRLCK,
      Unlock => F_UNLCK);

   C_Whence : constant array (POSIX.IO.Position) of short :=
     (POSIX.IO.From_Beginning => SEEK_SET,
      POSIX.IO.From_End_Of_File => SEEK_END,
      POSIX.IO.From_Current_Position => SEEK_CUR);

   ----------------
   --  Get_Lock  --
   ----------------

   function fcntl
     (fd : int;
      cmd : int;
      arg : flock_ptr) return int;
   pragma Import (C, fcntl, fcntl_LINKNAME);

   procedure Get_Lock
     (File    : in POSIX.IO.File_Descriptor;
      Lock    : in File_Lock;
      Result  : out File_Lock;
      Process : out POSIX.Process_Identification.Process_ID) is
      T : aliased struct_flock;
      Res : File_Lock (False);
      --  temporary is needed in case Result.Whole_File = True
   begin
      T.l_type := C_Lock_Type (Lock.Lock);
      if Lock.Whole_File then
         T.l_whence := SEEK_SET;
         T.l_start := 0;
         T.l_len := off_t (POSIX.IO.File_Size (File));
      else
         T.l_whence := C_Whence (Lock.Starting_Point);
         T.l_start := off_t (Lock.Start);
         T.l_len := off_t (Lock.Length);
      end if;
      Check (fcntl (int (File), F_GETLK, T'Unchecked_Access));
      if T.l_type = F_UNLCK then
         Process := POSIX.Process_Identification.Null_Process_ID;
      else
         Process := To_Process_ID (T.l_pid);
         if T.l_type = F_RDLCK then Res.Lock := Read_Lock;
         elsif T.l_type = F_WRLCK then Res.Lock := Write_Lock;
         else Res.Lock := Unlock;
         end if;
         if T.l_whence = SEEK_SET then
            Res.Starting_Point := POSIX.IO.From_Beginning;
         elsif T.l_whence = SEEK_END then
            Res.Starting_Point := POSIX.IO.From_End_Of_File;
         else
            Res.Starting_Point := POSIX.IO.From_Current_Position;
         end if;
         Res.Start := POSIX.IO.IO_Offset (T.l_start);
         Res.Length := IO_Count (T.l_len);
         Result := Res;
      end if;
   end Get_Lock;

   ----------------
   --  Set_Lock  --
   ----------------

   procedure Set_Lock
     (File : in POSIX.IO.File_Descriptor;
      Lock : in File_Lock) is
      T : aliased struct_flock;
   begin
      T.l_type := C_Lock_Type (Lock.Lock);
      if Lock.Whole_File then
         T.l_whence := SEEK_SET;
         T.l_start := 0;
         T.l_len := off_t (POSIX.IO.File_Size (File));
      else
         T.l_whence := C_Whence (Lock.Starting_Point);
         T.l_start := off_t (Lock.Start);
         T.l_len := off_t (Lock.Length);
      end if;
      Check (fcntl (int (File), F_SETLK, T'Unchecked_Access));
   end Set_Lock;

   ------------------------
   --  Wait_To_Set_Lock  --
   ------------------------

   procedure Wait_To_Set_Lock
     (File           : in POSIX.IO.File_Descriptor;
      Lock           : in File_Lock;
      Masked_Signals : in POSIX.Signal_Masking := POSIX.RTS_Signals) is
      T : aliased struct_flock;
      Result : int;
      Old_Mask : aliased Signal_Mask;
   begin
      Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access);
      T.l_type := C_Lock_Type (Lock.Lock);
      if Lock.Whole_File then
         T.l_whence := SEEK_SET;
         T.l_start := 0;
         T.l_len := off_t (POSIX.IO.File_Size (File));
      else
         T.l_whence := C_Whence (Lock.Starting_Point);
         T.l_start := off_t (Lock.Start);
         T.l_len := off_t (Lock.Length);
      end if;
      Result := fcntl (int (File), F_SETLKW, T'Unchecked_Access);
      Check_NNeg_And_Restore_Signals
        (Result, Masked_Signals, Old_Mask'Unchecked_Access);
   end Wait_To_Set_Lock;

end POSIX.File_Locking;