Commit 9cc29fc6 by Thomas Quinot Committed by Arnaud Charlet

g-os_lib.ads, [...] (Set_Executable, [...]): New subprograms.

2004-10-26  Thomas Quinot  <quinot@act-europe.fr>

	* g-os_lib.ads, g-os_lib.adb (Set_Executable, Set_Writable,
	Set_Read_Only): New subprograms.
	These new routines allow the user to set or unset the Owner execute
	and Owner write permission flags on a file.

	* makegpr.adb, mlib.adb, mlib-prj.adb: Use
	GNAT.OS_Lib.Set_Executable instead of rolling our own.

From-SVN: r89654
parent 427024ae
...@@ -2056,6 +2056,48 @@ package body GNAT.OS_Lib is ...@@ -2056,6 +2056,48 @@ package body GNAT.OS_Lib is
Rename_File (C_Old_Name'Address, C_New_Name'Address, Success); Rename_File (C_Old_Name'Address, C_New_Name'Address, Success);
end Rename_File; end Rename_File;
--------------------
-- Set_Executable --
--------------------
procedure Set_Executable (Name : String) is
procedure C_Set_Executable (Name : C_File_Name);
pragma Import (C, C_Set_Executable, "__gnat_set_executable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
C_Set_Executable (C_Name (C_Name'First)'Address);
end Set_Executable;
--------------------
-- Set_Read_Only --
--------------------
procedure Set_Read_Only (Name : String) is
procedure C_Set_Read_Only (Name : C_File_Name);
pragma Import (C, C_Set_Read_Only, "__gnat_set_readonly");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
C_Set_Read_Only (C_Name (C_Name'First)'Address);
end Set_Read_Only;
--------------------
-- Set_Writable --
--------------------
procedure Set_Writable (Name : String) is
procedure C_Set_Writable (Name : C_File_Name);
pragma Import (C, C_Set_Writable, "__gnat_set_writable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
C_Set_Writable (C_Name (C_Name'First)'Address);
end Set_Writable;
------------ ------------
-- Setenv -- -- Setenv --
------------ ------------
......
...@@ -470,6 +470,18 @@ pragma Elaborate_Body (OS_Lib); ...@@ -470,6 +470,18 @@ pragma Elaborate_Body (OS_Lib);
-- contains the name of the file to which it is linked. Symbolic links may -- contains the name of the file to which it is linked. Symbolic links may
-- span file systems and may refer to directories. -- span file systems and may refer to directories.
procedure Set_Writable (Name : String);
-- Change the permissions on the named file to make it writable
-- for its owner.
procedure Set_Read_Only (Name : String);
-- Change the permissions on the named file to make it non-writable
-- for its owner.
procedure Set_Executable (Name : String);
-- Change the permissions on the named file to make it executable
-- for its owner.
function Locate_Exec_On_Path function Locate_Exec_On_Path
(Exec_Name : String) return String_Access; (Exec_Name : String) return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the -- Try to locate an executable whose name is given by Exec_Name in the
...@@ -562,9 +574,7 @@ pragma Elaborate_Body (OS_Lib); ...@@ -562,9 +574,7 @@ pragma Elaborate_Body (OS_Lib);
-- Returns Invalid_Time is Name doesn't correspond to an existing file. -- Returns Invalid_Time is Name doesn't correspond to an existing file.
function Is_Regular_File (Name : C_File_Name) return Boolean; function Is_Regular_File (Name : C_File_Name) return Boolean;
function Is_Directory (Name : C_File_Name) return Boolean; function Is_Directory (Name : C_File_Name) return Boolean;
function Is_Readable_File (Name : C_File_Name) return Boolean; function Is_Readable_File (Name : C_File_Name) return Boolean;
function Is_Writable_File (Name : C_File_Name) return Boolean; function Is_Writable_File (Name : C_File_Name) return Boolean;
function Is_Symbolic_Link (Name : C_File_Name) return Boolean; function Is_Symbolic_Link (Name : C_File_Name) return Boolean;
......
...@@ -3315,12 +3315,6 @@ package body Makegpr is ...@@ -3315,12 +3315,6 @@ package body Makegpr is
Change_Dir (Object_Dir); Change_Dir (Object_Dir);
declare declare
procedure Set_Executable (Name : System.Address);
pragma Import
(C, Set_Executable, "__gnat_set_executable");
Name : constant String := Cpp_Linker & ASCII.NUL;
File : Ada.Text_IO.File_Type; File : Ada.Text_IO.File_Type;
use Ada.Text_IO; use Ada.Text_IO;
...@@ -3336,7 +3330,7 @@ package body Makegpr is ...@@ -3336,7 +3330,7 @@ package body Makegpr is
" $* ${LIBGCC}"); " $* ${LIBGCC}");
Close (File); Close (File);
Set_Executable (Name (Name'First)'Address); Set_Executable (Cpp_Linker);
end; end;
end if; end if;
end Choose_C_Plus_Plus_Link_Process; end Choose_C_Plus_Plus_Link_Process;
......
...@@ -1638,9 +1638,6 @@ package body MLib.Prj is ...@@ -1638,9 +1638,6 @@ package body MLib.Prj is
Disregard : Boolean; Disregard : Boolean;
procedure Set_Writable (Name : System.Address);
pragma Import (C, Set_Writable, "__gnat_set_writable");
begin begin
Get_Name_String (Directory); Get_Name_String (Directory);
...@@ -1667,8 +1664,7 @@ package body MLib.Prj is ...@@ -1667,8 +1664,7 @@ package body MLib.Prj is
exit when Last = 0; exit when Last = 0;
if Is_Regular_File (Name (1 .. Last)) then if Is_Regular_File (Name (1 .. Last)) then
Name (Last + 1) := ASCII.NUL; Set_Writable (Name (1 .. Last));
Set_Writable (Name (1)'Address);
Delete_File (Name (1 .. Last), Disregard); Delete_File (Name (1 .. Last), Disregard);
end if; end if;
end loop; end loop;
......
...@@ -37,8 +37,6 @@ with MLib.Utl; use MLib.Utl; ...@@ -37,8 +37,6 @@ with MLib.Utl; use MLib.Utl;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
with System;
package body MLib is package body MLib is
------------------- -------------------
...@@ -107,9 +105,6 @@ package body MLib is ...@@ -107,9 +105,6 @@ package body MLib is
To_Dir : constant String := Get_Name_String (To); To_Dir : constant String := Get_Name_String (To);
Interface : Boolean := False; Interface : Boolean := False;
procedure Set_Readonly (Name : System.Address);
pragma Import (C, Set_Readonly, "__gnat_set_readonly");
procedure Verbose_Copy (Index : Positive); procedure Verbose_Copy (Index : Positive);
-- In verbose mode, output a message that the indexed file is copied -- In verbose mode, output a message that the indexed file is copied
-- to the destination directory. -- to the destination directory.
...@@ -264,7 +259,8 @@ package body MLib is ...@@ -264,7 +259,8 @@ package body MLib is
Success := Status and Actual_Len = Len + 3; Success := Status and Actual_Len = Len + 3;
if Success then if Success then
Set_Readonly (Name_Buffer'Address); Set_Read_Only (
Name_Buffer (1 .. Name_Len - 1));
end if; end if;
end if; end if;
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment