Commit 43540ec6 by Arnaud Charlet

adaint.c, [...]: Add support for the readable attribute.

2008-08-05  Pascal Obry  <obry@adacore.com>

	* adaint.c, adaint.h, s-os_lib.adb, s-os_lib.ads: Add support for the
	readable attribute.

From-SVN: r138709
parent 486fd7f5
2008-08-05 Pascal Obry <obry@adacore.com>
* adaint.c, adaint.h, s-os_lib.adb, s-os_lib.ads: Add support for the
readable attribute.
2008-08-05 Vincent Celier <celier@adacore.com>
* s-wchwts.adb:
(Wide_String_To_String): Returns a String with the same 'First as its
parameter S.
(Wide_Wide_String_To_String): Ditto
* s-wchwts.ads:
(Wide_String_To_String): Document that the lowest index of the returned
String is equal to S'First.
2008-08-05 Thomas Quinot <quinot@adacore.com>
* xoscons.adb, xutil.ads, xutil.adb, s-oscons-tmplt.c: New files.
......@@ -1760,33 +1760,20 @@ __gnat_set_OWNER_ACL
TCHAR username [100];
DWORD unsize = 100;
HANDLE file = CreateFile
(wname, READ_CONTROL | WRITE_DAC, 0, NULL,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (file == INVALID_HANDLE_VALUE)
return;
/* Get current user, he will act as the owner */
if (!GetUserName (username, &unsize))
return;
if (GetSecurityInfo
(file,
if (GetNamedSecurityInfo
(wname,
SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION,
NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
return;
ZeroMemory (&ea, sizeof (EXPLICIT_ACCESS));
ea.grfAccessMode = AccessMode;
ea.grfAccessPermissions = AccessPermissions;
ea.grfInheritance = CONTAINER_INHERIT_ACE | OBJECT_INHERIT_ACE;
ea.Trustee.TrusteeForm = TRUSTEE_IS_NAME;
ea.Trustee.TrusteeType = TRUSTEE_IS_USER;
ea.Trustee.ptstrName = username;
BuildExplicitAccessWithName
(&ea, username, AccessPermissions, AccessMode, NO_INHERITANCE);
if (AccessMode == SET_ACCESS)
{
......@@ -1799,14 +1786,13 @@ __gnat_set_OWNER_ACL
if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
return;
if (SetSecurityInfo
(file, SE_FILE_OBJECT,
if (SetNamedSecurityInfo
(wname, SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
return;
LocalFree (pSD);
LocalFree (pNewDACL);
CloseHandle (file);
}
#endif /* defined (_WIN32) && !defined (RTX) */
......@@ -1892,7 +1878,7 @@ __gnat_set_writable (char *name)
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, GENERIC_WRITE);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
SetFileAttributes
(wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
......@@ -1914,7 +1900,7 @@ __gnat_set_executable (char *name)
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, GENERIC_EXECUTE);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
struct stat statbuf;
......@@ -1934,17 +1920,55 @@ __gnat_set_non_writable (char *name)
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, REVOKE_ACCESS, GENERIC_WRITE);
__gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_WRITE);
SetFileAttributes
(wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
struct stat statbuf;
if (stat (name, &statbuf) == 0)
{
statbuf.st_mode = statbuf.st_mode & 07577;
chmod (name, statbuf.st_mode);
}
{
statbuf.st_mode = statbuf.st_mode & 07577;
chmod (name, statbuf.st_mode);
}
#endif
}
void
__gnat_set_readable (char *name)
{
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
#else
struct stat statbuf;
if (stat (name, &statbuf) == 0)
{
chmod (name, statbuf.st_mode | S_IREAD);
}
#endif
}
void
__gnat_set_non_readable (char *name)
{
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
#else
struct stat statbuf;
if (stat (name, &statbuf) == 0)
{
chmod (name, statbuf.st_mode & (~S_IREAD));
}
#endif
}
......
......@@ -105,6 +105,8 @@ extern int __gnat_is_executable_file (char *name);
extern void __gnat_set_non_writable (char *name);
extern void __gnat_set_writable (char *name);
extern void __gnat_set_executable (char *name);
extern void __gnat_set_readable (char *name);
extern void __gnat_set_non_readable (char *name);
extern int __gnat_is_symbolic_link (char *name);
extern int __gnat_portable_spawn (char *[]);
extern int __gnat_portable_no_block_spawn (char *[]);
......
......@@ -2268,20 +2268,6 @@ package body System.OS_Lib is
Rename_File (C_Old_Name'Address, C_New_Name'Address, Success);
end Rename_File;
----------------------
-- Set_Non_Writable --
----------------------
procedure Set_Non_Writable (Name : String) is
procedure C_Set_Non_Writable (Name : C_File_Name);
pragma Import (C, C_Set_Non_Writable, "__gnat_set_non_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_Non_Writable (C_Name (C_Name'First)'Address);
end Set_Non_Writable;
-----------------------
-- Set_Close_On_Exec --
-----------------------
......@@ -2313,6 +2299,48 @@ package body System.OS_Lib is
C_Set_Executable (C_Name (C_Name'First)'Address);
end Set_Executable;
----------------------
-- Set_Non_Readable --
----------------------
procedure Set_Non_Readable (Name : String) is
procedure C_Set_Non_Readable (Name : C_File_Name);
pragma Import (C, C_Set_Non_Readable, "__gnat_set_non_readable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
C_Set_Non_Readable (C_Name (C_Name'First)'Address);
end Set_Non_Readable;
----------------------
-- Set_Non_Writable --
----------------------
procedure Set_Non_Writable (Name : String) is
procedure C_Set_Non_Writable (Name : C_File_Name);
pragma Import (C, C_Set_Non_Writable, "__gnat_set_non_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_Non_Writable (C_Name (C_Name'First)'Address);
end Set_Non_Writable;
------------------
-- Set_Readable --
------------------
procedure Set_Readable (Name : String) is
procedure C_Set_Readable (Name : C_File_Name);
pragma Import (C, C_Set_Readable, "__gnat_set_readable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
C_Set_Readable (C_Name (C_Name'First)'Address);
end Set_Readable;
--------------------
-- Set_Writable --
--------------------
......
......@@ -511,6 +511,15 @@ package System.OS_Lib is
procedure Set_Executable (Name : String);
-- Change permissions on the named file to make it executable for its owner
procedure Set_Readable (Name : String);
-- Change permissions on the named file to make it readable for its
-- owner.
procedure Set_Non_Readable (Name : String);
-- Change permissions on the named file to make it non-readable for
-- its owner. The writable and executable permissions are not
-- modified.
function Locate_Exec_On_Path
(Exec_Name : String) return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the
......
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