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

5 files changed, 120 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2894171..d83538f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+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.
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index c1afe1e..242b82b 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -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
 }
 
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 423c7ec..3c8abc5 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -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 *[]);
diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb
index fbea2a3..0e1c6c7 100755
--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -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 --
    --------------------
diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads
index 07fd3d9..8364d16 100755
--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -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