From 48a3adafb5bf642af16f13dfe54fb916ff13ccc7 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Thu, 24 Aug 2000 10:27:01 +0000
Subject: [PATCH] [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.
---
ghc/lib/std/Directory.lhs | 28 ++++++++++++++++++----------
ghc/lib/std/cbits/directoryAux.c | 9 ++++++---
ghc/lib/std/cbits/stgio.h | 7 +++++--
3 files changed, 29 insertions(+), 15 deletions(-)
diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs
index ffb75a078e23..009833d5f56c 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 16d0af877b06..1aa52aca6fb1 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 6530eeeca852..35a09fd8b792 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);
--
GitLab