-- -- -------------------------------------------------------------------------------- -- -- OSI_Files -- -- This package provides routines to manipulate regular files -- and directories. -- -- -- -- -- Gerardo A. Colon -- 11 July 1990 -- -- Science Applications International Corporation --

311 Park Place Boulevard, Suite 360 --

Clearwater, Florida 34619 -- -- Developed for the STARS program under task S40. -- -- -- -- Gerardo A. Colon -- Added type File_Descriptor and the functions -- Is_A_Terminal_Device and Get_Terminal_Device_Name. -- Defined Standard_Input, Standard_Output, and -- Standard_Error file descriptors. -- August 21, 1990 -- -- -- -- -- Dependencies => -- ( Operating_System => AIX , -- Compiler => None , -- Device => None ) ; -- -- -------------------------------------------------------------------------------- with C_String_Utilities ; with Interface_Definitions ; with OSI_Error_Handler ; with OSI_Exceptions ; with Runtime_Support_Library ; with System ; use Interface_Definitions ; use Runtime_Support_Library ; pragma Elaborate ( C_String_Utilities ) ; pragma Elaborate ( Interface_Definitions ) ; pragma Elaborate ( OSI_Error_Handler ) ; pragma Elaborate ( OSI_Exceptions ) ; pragma Elaborate ( Runtime_Support_Library ) ; pragma Page ; -------------------------------------------------------------------------------- -- package OSI_Files (body). -------------------------------------------------------------------------------- package body OSI_Files is type File_Type is ( Regular_File , Directory ) ; -- -- This type identifies the two different types of files that are manipulated -- by this package. -- type Set_Of_Modes is array ( Access_Modes ) of Interface_Definitions.Interface_Integer ; The_File_Modes : constant Set_Of_Modes := ( Read_Ok => R_OK , Write_OK => W_OK , Execute_Ok => X_OK ) ; -- -- This constant contains the values that specify the different accesses -- to a file. -- type Byte is range 0 .. ( 2 ** System.Storage_Unit - 1 ) ; -- -- This type defines the range of possible values for the system's storage unit. -- Block_Size : constant := 512 ; -- -- This constant defines the size of a block of data. -- type Block is array ( 1 .. Block_Size ) of Byte ; -- -- This type is used as a buffer for reading/writing from/to files. -- Null_Address : System.Address ; -- -- This object defines a null address. -- -------------------------------------------------------------------------------- -- Local Subprograms. -------------------------------------------------------------------------------- procedure Assert ( The_Filename : in OSI_String ) is -------------------------------------------------------------------------------- -- -- Assert -- -- This procedure asserts that the filename given by the -- parameter The_Filename is a correct filename. -- -- Filename_Syntax_Error => -- The_Filename contains one or more characters not supported -- by the implementation for a filename. -- Filename_Too_Long => -- The length of The_Filename exceeds its maximum. -- -- -------------------------------------------------------------------------------- begin -- Assert -- Check that the length is not greater the its limit. if The_Filename'Length > Portable_Pathname_Limit then raise OSI_Exceptions.Filename_Too_Long ; end if ; -- for The_Index in The_Filename'Range loop case The_Filename ( The_Index ) is when 'a' .. 'z' => null ; when 'A' .. 'Z' => null ; when '0' .. '9' => null ; when '-' => if The_Index = The_Filename'First then raise OSI_Exceptions.Filename_Syntax_Error ; end if ; when '.' | '_' | '/' => null ; when others => raise OSI_Exceptions.Filename_Syntax_Error ; end case ; end loop ; end Assert ; function Assert ( The_File : in OSI_String ; The_Type : in File_Type ) return Boolean is -------------------------------------------------------------------------------- -- -- Assert -- -- This function returns True if the file identified by the -- The_File is of the type given by The_Type. -- -- None. -- -- -------------------------------------------------------------------------------- Return_Value : Interface_Definitions.Interface_Integer ; The_File_String : constant String := To_String ( The_File ) & ASCII.Nul ; The_Stat_Buffer : Stat_Structure ; begin -- Assert -- Get the information regarding the file. Return_Value := Stat ( Path => The_File_String'Address , Buf => The_Stat_Buffer'Address ) ; -- if Return_Value < 0 then -- An error occurred. OSI_Error_Handler.Map_Last_Error ; end if ; -- case The_Type is when Regular_File => return ( Is_Regular ( The_Stat_Buffer.St_Mode ) /= 0 ) ; when Directory => return ( Is_Dir ( The_Stat_Buffer.St_Mode ) /= 0 ) ; end case ; end Assert ; procedure Assert_Successful ( The_Status : in Interface_Definitions.Interface_Integer ) is -------------------------------------------------------------------------------- -- -- Assert_Successful -- -- This procedure checks to see if the value given by the -- parameter The_Status indicates a successful one. An -- unsuccessful value is determined with The_Status having -- the value of -1. If The_Status has an unsuccessful value, -- the procedure will invoke OSI_Error_Handler.Map_Last_Error. -- -- None. -- -- -------------------------------------------------------------------------------- use Interface_Definitions ; begin -- Assert_Successful if The_Status < 0 then OSI_Error_Handler.Map_Last_Error ; end if ; end Assert_Successful ; function Mode_Of ( The_Permissions : in Access_Mode_Set ) return Interface_Definitions.Interface_Integer is -------------------------------------------------------------------------------- -- -- Mode_Of -- -- This function returns an integer which represents the -- file permissions given by the parameter The_Permissions. -- -- None. -- -- -------------------------------------------------------------------------------- The_Modes : Interface_Definitions.Interface_Integer := 0 ; begin -- Mode_Of for The_Index in The_Permissions'Range loop if The_Permissions ( The_Index ) then The_Modes := The_Modes + The_File_Modes ( The_Index ) ; end if ; end loop ; -- return The_Modes ; end Mode_Of ; -------------------------------------------------------------------------------- -- External Subprograms. -------------------------------------------------------------------------------- procedure Create_Directory ( Directory_Name : in OSI_String ) is -------------------------------------------------------------------------------- -- -- Create_Directory -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- Return_Status : Interface_Definitions.Interface_Integer ; The_Directory_String : constant String := To_String ( Directory_Name ) & ASCII.Nul ; begin -- Create_Directory -- Assert a good filename. Assert ( The_Filename => Directory_Name ) ; -- Create the new directory. Return_Status := Mkdir ( Path => The_Directory_String'Address , Mode => All_Permissions ) ; -- Check for a successful operation. Assert_Successful ( The_Status => Return_Status ) ; end Create_Directory ; procedure Unlink ( File_Name : in OSI_String ) is -------------------------------------------------------------------------------- -- -- Unlink -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- Return_Status : Interface_Definitions.Interface_Integer ; The_Name_String : constant String := To_String ( File_Name ) & ASCII.Nul ; begin -- Unlink -- Assert a good filename. Assert ( The_Filename => File_Name ) ; -- Remove the link. Return_Status := Unlink ( Path => The_Name_String'Address ) ; -- Check for a successful operation. Assert_Successful ( The_Status => Return_Status ) ; end Unlink ; procedure Remove_Directory ( File_Name : in OSI_String ) is -------------------------------------------------------------------------------- -- -- Remove_Directory -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- Return_Status : Interface_Definitions.Interface_Integer ; The_Name_String : constant String := To_String ( File_Name ) & ASCII.Nul ; begin -- Remove_Directory -- Assert a good filename. Assert ( The_Filename => File_Name ) ; -- Remove the directory. Return_Status := Rmdir ( Path => The_Name_String'Address ) ; -- Check for a successful operation. Assert_Successful ( The_Status => Return_Status ) ; end Remove_Directory ; procedure Rename ( File_Name : in OSI_String ; New_File_Name : in OSI_String ) is -------------------------------------------------------------------------------- -- -- Rename -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- Return_Status : Interface_Definitions.Interface_Integer ; The_Source_Name : constant String := To_String ( File_Name ) & ASCII.Nul ; The_Target_Name : constant String := To_String ( New_File_Name ) & ASCII.Nul ; begin -- Rename -- Assert good filenames. Assert ( The_Filename => File_Name ) ; Assert ( The_Filename => New_File_Name ) ; -- Rename the file. Return_Status := Rename ( Frompath => The_Source_Name'Address , Topath => The_Target_Name'Address ) ; -- Check for a successful operation. Assert_Successful ( The_Status => Return_Status ) ; end Rename ; procedure Copy_File ( File_Name : in OSI_String ; New_File_Name : in OSI_String ) is -------------------------------------------------------------------------------- -- -- Copy_File -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- Bytes_Read : Interface_Definitions.Interface_Integer ; Bytes_Written : Interface_Definitions.Interface_Integer ; Dummy_Mode : constant Interface_Definitions.Interface_Integer := 0 ; The_Source_File_String : constant String := To_String ( File_Name ) & ASCII.Nul ; The_Target_File_String : constant String := To_String ( New_File_Name ) & ASCII.Nul ; The_Source_Descriptor : Interface_Definitions.Interface_Integer ; The_Target_Descriptor : Interface_Definitions.Interface_Integer ; The_Buffer : Block ; begin -- Copy_File -- Assert good filenames. Assert ( The_Filename => File_Name ) ; Assert ( The_Filename => New_File_Name ) ; -- Open the source file. The_Source_Descriptor := Open ( Path => The_Source_File_String'Address , Oflag => O_RDONLY , Mode => Dummy_Mode ) ; -- Check for a successful operation. Assert_Successful ( The_Status => The_Source_Descriptor ) ; -- Open the target file. The_Target_Descriptor := Open ( Path => The_Target_File_String'Address , Oflag => O_WRONLY + O_CREAT + O_TRUNC , Mode => All_Permissions ) ; -- Check for a successful operation. Assert_Successful ( The_Status => The_Target_Descriptor ) ; -- Copy the source file into the target file. loop -- Read from the source file into the buffer. Bytes_Read := Read ( D => The_Source_Descriptor , Buf => The_Buffer'Address , Nbyte => The_Buffer'Length ) ; -- if Bytes_Read < 0 then -- An error occurred while reading from the source file. OSI_Error_Handler.Map_Last_Error ; elsif Bytes_Read = 0 then -- Reached the end of file. exit ; else -- Write buffer into the target file. Bytes_Written := Write ( D => The_Target_Descriptor , Buf => The_Buffer'Address , Nbytes => Interface_Unsigned ( Bytes_Read ) ) ; -- if Bytes_Written < 0 then -- An error occurred while writing to the target file. OSI_Error_Handler.Map_Last_Error ; end if ; end if ; end loop ; -- Close both files. if Close ( Fildes => The_Source_Descriptor ) < 0 or else Close ( Fildes => The_Target_Descriptor ) < 0 then -- An error occurred while closing the files. OSI_Error_Handler.Map_Last_Error ; end if ; end Copy_File ; function Is_File ( File_Name : in OSI_String ) return Boolean is -------------------------------------------------------------------------------- -- -- Is_File -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- begin -- Is_File -- Assert a good filename. Assert ( The_Filename => File_Name ) ; -- return Assert ( The_File => File_Name , The_Type => Regular_File ) ; end Is_File ; function Is_Directory ( File_Name : in OSI_String ) return Boolean is -------------------------------------------------------------------------------- -- -- Is_Directory -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- begin -- Is_Directory -- Assert a good filename. Assert ( The_Filename => File_Name ) ; -- return Assert ( The_File => File_Name , The_Type => Directory ) ; end Is_Directory ; procedure Directory_Reader ( Directory_Name : in OSI_String ) is -------------------------------------------------------------------------------- -- -- Directory_Reader -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- The_Directory : Dir_Link ; The_Dir_Entry : Directory_Entry_Link ; The_Name_String : constant String := To_String ( Directory_Name ) & ASCII.Nul ; function "=" ( Left , Right : System.Address ) return Boolean renames System."=" ; begin -- Directory_Reader -- Assert a good file name. Assert ( The_Filename => Directory_Name ) ; -- Open the directory. The_Directory := Opendir ( Dirname => The_Name_String'Address ) ; -- if ( The_Directory = Null_Address ) then OSI_Error_Handler.Map_Last_Error ; end if ; -- Iterate through the directory entries performing the given Action. declare The_Directory_Record : Dir ; for The_Directory_Record use at The_Directory ; begin loop -- Read next directory entry. The_Dir_Entry := Readdir ( Dirp => The_Directory_Record ) ; -- exit when no more directory entries. if ( The_Dir_Entry = Null_Address ) then -- End of directory. exit ; else declare The_Dir_Entry_Record : Directory_Entry ; for The_Dir_Entry_Record use at The_Dir_Entry ; begin -- Perform the Action on the directory entry. Action ( File_Name => To_OSI_String ( String ( The_Dir_Entry_Record.D_Name ( 1 .. Integer ( The_Dir_Entry_Record.D_Namlen ) ) ) ) ) ; end ; end if ; end loop ; end ; -- Close the directory. if Closedir ( Dirp => The_Directory ) < 0 then -- The file could not be closed. OSI_Error_Handler.Map_Last_Error ; end if ; end Directory_Reader ; procedure Accessible ( File_Name : in OSI_String ; Permissions : in Access_Mode_Set ) is -------------------------------------------------------------------------------- -- -- Accessible -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- The_Name_String : constant String := To_String ( File_Name ) & ASCII.Nul ; begin -- Accessible -- Assert a good filename. Assert ( The_Filename => File_Name ) ; -- if File_Access ( Path => The_Name_String'Address , Amode => Mode_Of ( Permissions ) ) < 0 then -- An error occurred. OSI_Error_Handler.Map_Last_Error ; end if ; end Accessible ; function Host_Name_Of ( File_Name : in OSI_String ) return String is -------------------------------------------------------------------------------- -- -- Host_Name_Of -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- begin -- Host_Name_Of -- Assert a good filename. Assert ( The_Filename => File_Name ) ; -- return OSI_Standard.To_String ( File_Name ) ; end Host_Name_Of ; function Is_A_Terminal_Device ( File : in File_Descriptor ) return Boolean is -------------------------------------------------------------------------------- -- -- Is_A_Terminal_Device -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- begin -- Is_A_Terminal_Device return ( Isatty ( Fildes => Interface_Definitions.Interface_Integer ( File ) ) = 1 ) ; end Is_A_Terminal_Device ; function Get_Terminal_Device_Name ( File : in File_Descriptor ) return OSI_String is -------------------------------------------------------------------------------- -- -- Get_Terminal_Device_Name -- -- For a complete description of this subprogram see the -- specification of this package. -- -- For a complete description of the exceptions raised by this -- subprogram see the specification of this package. -- -- -------------------------------------------------------------------------------- begin -- Get_Terminal_Device_Name return OSI_Standard.To_OSI_String ( C_String_Utilities.String_Of ( Ttyname ( Fildes => Interface_Definitions.Interface_Integer ( File ) ) ) ) ; end Get_Terminal_Device_Name ; end OSI_Files ; --