File : posix-files.adb
------------------------------------------------------------------------------
-- --
-- FLORIST (FSU Implementation of POSIX.5) COMPONENTS --
-- --
-- P O S I X . F I L 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.1.1.1 $]
with POSIX.C,
POSIX.Calendar,
POSIX.Implementation,
POSIX.File_Status,
POSIX.Permissions,
POSIX.Permissions.Implementation,
System,
Unchecked_Conversion;
package body POSIX.Files is
use POSIX,
POSIX.C,
POSIX.Implementation,
POSIX.Permissions.Implementation;
-------------------------
-- Local Subprograms --
-------------------------
function To_D_Int is
new Unchecked_Conversion (POSIX.Calendar.POSIX_Time, D_Int);
function To_time_t (Time : POSIX.Calendar.POSIX_Time) return time_t;
function To_time_t (Time : POSIX.Calendar.POSIX_Time) return time_t is
begin
return time_t (To_Duration (To_D_Int (Time) / NS_per_S) * NS_per_S);
end To_time_t;
function c_access
(path : char_ptr;
amode : int) return int;
pragma Import (C, c_access, access_LINKNAME);
function Form_C_access
(Modes : POSIX.Files.Access_Mode_Set) return int;
function Form_C_access
(Modes : POSIX.Files.Access_Mode_Set) return int is
c_access : Bits := 0;
begin
if Modes (Read_Ok) then
c_access := c_access or R_OK;
end if;
if Modes (Write_Ok) then
c_access := c_access or W_OK;
end if;
if Modes (Execute_Ok) then
c_access := c_access or X_OK;
end if;
return int (c_access);
end Form_C_access;
------------------------
-- Create_Directory --
------------------------
function mkdir
(path : char_ptr;
mode : mode_t) return int;
pragma Import (C, mkdir, mkdir_LINKNAME);
procedure Create_Directory
(Pathname : in POSIX.Pathname;
Permission : in POSIX.Permissions.Permission_Set) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
Check (mkdir (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access,
(Form_C_Permission (Permission))));
end Create_Directory;
-------------------
-- Create_FIFO --
-------------------
function mkfifo
(path : char_ptr;
mode : mode_t) return int;
pragma Import (C, mkfifo, mkfifo_LINKNAME);
procedure Create_FIFO
(Pathname : in POSIX.Pathname;
Permission : in POSIX.Permissions.Permission_Set) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
Check (mkfifo (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access,
(Form_C_Permission (Permission))));
end Create_FIFO;
--------------
-- Unlink --
--------------
function unlink (path : char_ptr) return int;
pragma Import (C, unlink, unlink_LINKNAME);
procedure Unlink (Pathname : in POSIX.Pathname) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
Check (unlink (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access));
end Unlink;
------------------------
-- Remove_Directory --
------------------------
function rmdir (path : char_ptr) return int;
pragma Import (C, rmdir, rmdir_LINKNAME);
procedure Remove_Directory (Pathname : in POSIX.Pathname) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
Check (rmdir (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access));
end Remove_Directory;
------------------------
-- Is_Symbolic_Link --
------------------------
function Is_Symbolic_Link (Pathname : POSIX.Pathname) return Boolean is
stat : POSIX.File_Status.Status;
begin
stat := POSIX.File_Status.Get_File_Status (Pathname);
return (POSIX.File_Status.Is_Symbolic_Link (stat));
exception
when POSIX_Error => return False;
end Is_Symbolic_Link;
---------------
-- Is_File --
---------------
function Is_File (Pathname : POSIX.Pathname) return Boolean is
stat : POSIX.File_Status.Status;
begin
stat := POSIX.File_Status.Get_File_Status (Pathname);
return (POSIX.File_Status.Is_Regular_File (stat));
exception
when POSIX_Error => return False;
end Is_File;
-----------------
-- Is_Socket --
-----------------
function Is_Socket (Pathname : POSIX.Pathname) return Boolean is
stat : POSIX.File_Status.Status;
begin
stat := POSIX.File_Status.Get_File_Status (Pathname);
return (POSIX.File_Status.Is_Socket (stat));
exception
when POSIX_Error => return False;
end Is_Socket;
--------------------
-- Is_Directory --
--------------------
function Is_Directory (Pathname : POSIX.Pathname) return Boolean is
stat : POSIX.File_Status.Status;
begin
stat := POSIX.File_Status.Get_File_Status (Pathname);
return (POSIX.File_Status.Is_Directory (stat));
exception
when POSIX_Error => return False;
end Is_Directory;
---------------
-- Is_FIFO --
---------------
function Is_FIFO (Pathname : POSIX.Pathname) return Boolean is
stat : POSIX.File_Status.Status;
begin
stat := POSIX.File_Status.Get_File_Status (Pathname);
return (POSIX.File_Status.Is_FIFO (stat));
exception
when POSIX_Error => return False;
end Is_FIFO;
---------------------------------
-- Is_Character_Special_File --
---------------------------------
function Is_Character_Special_File
(Pathname : POSIX.Pathname) return Boolean is
stat : POSIX.File_Status.Status;
begin
stat := POSIX.File_Status.Get_File_Status (Pathname);
return (POSIX.File_Status.Is_Character_Special_File (stat));
exception
when POSIX_Error => return False;
end Is_Character_Special_File;
-----------------------------
-- Is_Block_Special_File --
-----------------------------
function Is_Block_Special_File
(Pathname : POSIX.Pathname) return Boolean is
stat : POSIX.File_Status.Status;
begin
stat := POSIX.File_Status.Get_File_Status (Pathname);
return (POSIX.File_Status.Is_Block_Special_File (stat));
exception
when POSIX_Error => return False;
end Is_Block_Special_File;
------------
-- Link --
------------
function link
(existing : char_ptr;
new_name : char_ptr) return int;
pragma Import (C, link, link_LINKNAME);
procedure Link
(Old_Pathname : in Pathname;
New_Pathname : in Pathname) is
Old_Pathname_With_NUL : POSIX_String := Old_Pathname & NUL;
New_Pathname_With_NUL : POSIX_String := New_Pathname & NUL;
begin
Check (link (Old_Pathname_With_NUL
(Old_Pathname_With_NUL'First)'Unchecked_Access,
New_Pathname_With_NUL (New_Pathname_With_NUL'First)'Unchecked_Access));
end Link;
--------------
-- Rename --
--------------
function rename
(old_name : char_ptr;
new_name : char_ptr) return int;
pragma Import (C, rename, rename_LINKNAME);
procedure Rename
(Old_Pathname : in Pathname;
New_Pathname : in Pathname) is
Old_Pathname_With_NUL : POSIX_String := Old_Pathname & NUL;
New_Pathname_With_NUL : POSIX_String := New_Pathname & NUL;
begin
Check (rename (Old_Pathname_With_NUL
(Old_Pathname_With_NUL'First)'Unchecked_Access,
New_Pathname_With_NUL (New_Pathname_With_NUL'First)'Unchecked_Access));
end Rename;
-------------------
-- Filename_Of --
-------------------
function To_char_ptr is
new Unchecked_Conversion (System.Address, char_ptr);
function Filename_Of (D_Entry : Directory_Entry)
return Filename is
begin
return Form_POSIX_String
(To_char_ptr (D_Entry.d_name (1)'Address));
end Filename_Of;
---------------------------------
-- For_Every_Directory_Entry --
---------------------------------
function opendir (dirname : char_ptr) return DIR_ptr;
pragma Import (C, opendir, opendir_LINKNAME);
function readdir (dirp : DIR_ptr) return dirent_ptr;
pragma Import (C, readdir, readdir_LINKNAME);
function closedir (dirp : DIR_ptr) return int;
pragma Import (C, closedir, closedir_LINKNAME);
-- ?????
-- The following needs to be made safe for use in a multitasking
-- environment.
-- Clearly, readdir is a problem, since it returns a pointer to a
-- structure that must be allocated somewhere. Thus, POSIX provides
-- readdir_r. We should probably add conditional compilation code to
-- Florist posix-files.adb to make use of readdir_r if that is
-- supported.
-- Note that we are not required to support safe concurrent use of
-- multiple iterators on the same directory. A non-normative note
-- has been placed in 3.3.5 on lines 19-22 to make this clear. It
-- says:
-- The requirement for tasking safety does not imply any greater
-- degree of safety for concurrent use than is requird of the
-- standard Ada libraries by the Ada RM. That is, unless it is so
-- specified elsewhere in this standard, operations are [missin "not"
-- here, which is a typo] necessarily atomic and are not necessarily
-- safe to execute concurrently on the same data object.
-- Thus, the thing is to cover the case where readdir is the only
-- thing available, and it is not safe for concurrent use (even on
-- different directories).
procedure For_Every_Directory_Entry (Pathname : in POSIX.Pathname) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
dirp : DIR_ptr;
dirent : dirent_ptr;
Quit : Boolean := False;
begin
dirp := opendir (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access);
if dirp = null then Raise_POSIX_Error;
end if;
loop
dirent := readdir (dirp);
exit when dirent = null;
Action (Directory_Entry (dirent), Quit);
exit when Quit;
end loop;
Check (closedir (dirp));
end For_Every_Directory_Entry;
------------------------------
-- Change_Owner_And_Group --
------------------------------
function chown
(path : char_ptr;
owner : uid_t;
group : gid_t) return int;
pragma Import (C, chown, chown_LINKNAME);
function To_uid_t is new Unchecked_Conversion
(POSIX.Process_Identification.User_ID, uid_t);
function To_gid_t is new Unchecked_Conversion
(POSIX.Process_Identification.Group_ID, gid_t);
procedure Change_Owner_And_Group
(Pathname : in POSIX.Pathname;
Owner : in POSIX.Process_Identification.User_ID;
Group : in POSIX.Process_Identification.Group_ID) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
Check (chown (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access,
To_uid_t (Owner), To_gid_t (Group)));
end Change_Owner_And_Group;
--------------------------
-- Change_Permissions --
--------------------------
function chmod
(path : char_ptr;
mode : mode_t) return int;
pragma Import (C, chmod, chmod_LINKNAME);
procedure Change_Permissions
(Pathname : in POSIX.Pathname;
Permission : in POSIX.Permissions.Permission_Set) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
Check (chmod (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access,
Form_C_Permission (Permission)));
end Change_Permissions;
----------------------
-- Set_File_Times --
----------------------
-- There is a problem in the difference between POSIX.1c and POSIX.5
-- definition of file related times. POSIX.1c requires the accuracy be
-- in seconds while POSIX.5 requires it to be in POSIX_Time.
-- To avoid inconsistency, we have implemented POSIX_Time so that
-- all time values are truncated to the nearest second.
function utime
(path : char_ptr;
actime : utimbuf_ptr) return int;
pragma Import (C, utime, utime_LINKNAME);
procedure Set_File_Times
(Pathname : in POSIX.Pathname;
Access_Time : in POSIX.Calendar.POSIX_Time;
Modification_Time : in POSIX.Calendar.POSIX_Time) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
Times : aliased struct_utimbuf;
begin
Times.actime := To_time_t (Access_Time);
Times.modtime := To_time_t (Modification_Time);
Check (utime (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access,
Times'Unchecked_Access));
end Set_File_Times;
----------------------
-- Set_File_Times --
----------------------
procedure Set_File_Times (Pathname : in POSIX.Pathname) is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
Check (utime (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access, null));
end Set_File_Times;
---------------------
-- Is_Accessible --
---------------------
function Is_Accessible
(Pathname : POSIX.Pathname;
Access_Modes : Access_Mode_Set) return Boolean is
begin
return Accessibility (Pathname, Access_Modes) = No_Error;
end Is_Accessible;
-----------------------
-- Accessibilitity --
-----------------------
function Accessibility
(Pathname : POSIX.Pathname;
Access_Modes : Access_Mode_Set) return Error_Code is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
if c_access
(Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access,
Form_C_access (Access_Modes)) = 0
then return No_Error;
else return Fetch_Errno;
end if;
end Accessibility;
-----------------------
-- Is_File_Present --
-----------------------
function Is_File_Present
(Pathname : POSIX.Pathname) return Boolean is
Pathname_With_NUL : POSIX_String := Pathname & NUL;
begin
return c_access (Pathname_With_NUL
(Pathname_With_NUL'First)'Unchecked_Access, 0) = 0;
end Is_File_Present;
-----------------
-- Existence --
-----------------
function Existence
(Pathname : POSIX.Pathname) return Error_Code is
begin
if Is_File_Present (Pathname) then return No_Error;
else return Fetch_Errno;
end if;
end Existence;
end POSIX.Files;