diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs index ffb75a078e23c5cb51304c252819f7cada01b6de..009833d5f56c3b265319947702c1b7ba4afc8b80 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 16d0af877b0629f387a91996d824aec8886f33b1..1aa52aca6fb11f3bed221a5de98fcc7c51cc7568 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 6530eeeca852fd5678f991db57fc335752b1e0ee..35a09fd8b792aa87e6cc4b30aadff048960ee0b2 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);