From: simonmar <unknown>
Date: Thu, 24 Aug 2000 10:27:01 +0000 (+0000)
Subject: [project @ 2000-08-24 10:27:01 by simonmar]
X-Git-Tag: Approximately_9120_patches~3835
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=48a3adafb5bf642af16f13dfe54fb916ff13ccc7;p=ghc-hetmet.git

[project @ 2000-08-24 10:27:01 by simonmar]
Change implementation of Directory.getPermissions to use access(2)
rather than stat(2).  This is rather more sensible as the permissions
returned will be relevant to the current user rather than the owner of
the file.
---

diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs
index ffb75a0..009833d 100644
--- a/ghc/lib/std/Directory.lhs
+++ b/ghc/lib/std/Directory.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: Directory.lhs,v 1.19 2000/07/07 11:03:57 simonmar Exp $
+% $Id: Directory.lhs,v 1.20 2000/08/24 10:27:01 simonmar Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -447,8 +447,6 @@ doesFileExist name = do
    (getFileStatus name >>= \ st -> return (not (isDirectory st)))
    (\ _ -> return False)
 
-foreign import ccall "libHS_cbits" "const_F_OK" unsafe const_F_OK  :: Int
-
 #ifndef __HUGS__
 getModificationTime :: FilePath -> IO ClockTime
 getModificationTime name =
@@ -459,16 +457,16 @@ getModificationTime name =
 getPermissions :: FilePath -> IO Permissions
 getPermissions name = do
   st <- getFileStatus name
-  let
-   fm = fileMode st
-   isect v = intersectFileMode v fm == v
+  read  <- primAccess (primPackString name) readOK
+  write <- primAccess (primPackString name) writeOK
+  exec  <- primAccess (primPackString name) executeOK
 
   return (
     Permissions {
-      readable   = isect ownerReadMode,
-      writable   = isect ownerWriteMode,
-      executable = not (isDirectory st)   && isect ownerExecuteMode,
-      searchable = not (isRegularFile st) && isect ownerExecuteMode
+      readable   = read  == 0,
+      writable   = write == 0,
+      executable = not (isDirectory st)   && exec == 0,
+      searchable = not (isRegularFile st) && exec == 0
     }
    )
 
@@ -551,7 +549,14 @@ emptyFileMode     = intToWord 0
 unionFileMode     = orWord
 intersectFileMode = andWord
 #endif
+\end{code}
 
+\begin{code}
+type AccessMode = Word
+
+foreign import ccall "libHS_cbits" "const_R_OK" unsafe readOK       :: AccessMode
+foreign import ccall "libHS_cbits" "const_W_OK" unsafe writeOK      :: AccessMode
+foreign import ccall "libHS_cbits" "const_X_OK" unsafe executeOK    :: AccessMode
 \end{code}
 
 Some defns. to allow us to share code.
@@ -590,5 +595,8 @@ foreign import ccall "libHS_cbits" "getCurrentDirectory" unsafe primGetCurrentDi
 foreign import ccall "libc"        "free"                unsafe primFree                :: Addr -> IO ()
 foreign import ccall "libc"        "malloc"              unsafe primMalloc              :: Word -> IO Addr
 foreign import ccall "libc"        "chmod"               unsafe primChmod               :: CString -> Word -> IO Int
+
+foreign import ccall "libc" "access" unsafe 
+	primAccess :: CString -> Word -> IO Int
 \end{code}
 
diff --git a/ghc/lib/std/cbits/directoryAux.c b/ghc/lib/std/cbits/directoryAux.c
index 16d0af8..1aa52ac 100644
--- a/ghc/lib/std/cbits/directoryAux.c
+++ b/ghc/lib/std/cbits/directoryAux.c
@@ -1,7 +1,7 @@
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1998
  *
- * $Id: directoryAux.c,v 1.2 1998/12/02 13:27:17 simonm Exp $
+ * $Id: directoryAux.c,v 1.3 2000/08/24 10:27:01 simonmar Exp $
  *
  * Support functions for manipulating directories
  */
@@ -77,8 +77,6 @@ get_dirent_d_name(StgAddr d)
     return ((struct dirent*)d)->d_name;
 }
 
-StgInt const_F_OK( void ) { return F_OK; }
-
 StgInt sizeof_stat( void ) { return sizeof(struct stat); }
 
 StgInt  prim_stat(StgAddr x, StgAddr y)
@@ -123,3 +121,8 @@ prim_S_ISREG( StgWord x )
     return S_ISREG(x);
 }
 
+
+StgWord const_R_OK( void ) { return R_OK; }
+StgWord const_W_OK( void ) { return W_OK; }
+StgWord const_X_OK( void ) { return X_OK; }
+StgWord const_F_OK( void ) { return F_OK; }
diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h
index 6530eee..35a09fd 100644
--- a/ghc/lib/std/cbits/stgio.h
+++ b/ghc/lib/std/cbits/stgio.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: stgio.h,v 1.22 2000/06/19 13:28:35 simonmar Exp $
+ * $Id: stgio.h,v 1.23 2000/08/24 10:27:01 simonmar Exp $
  *
  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1999
  *
@@ -34,10 +34,13 @@ StgInt64 get_stat_st_mtime(StgAddr);
 void     set_stat_st_mtime(StgByteArray, StgByteArray);
 StgInt  sizeof_stat       (void);
 StgInt  prim_stat         (StgAddr,StgAddr);
-StgInt  const_F_OK        (void);
 StgWord const_S_IRUSR 	  (void);
 StgWord const_S_IWUSR 	  (void);
 StgWord const_S_IXUSR 	  (void);
+StgWord const_R_OK 	  (void);
+StgWord const_W_OK 	  (void);
+StgWord const_X_OK 	  (void);
+StgWord const_F_OK 	  (void);
 StgInt  prim_S_ISDIR  	  (StgWord);
 StgInt  prim_S_ISREG  	  (StgWord);