Commit 48a3adaf authored by simonmar's avatar simonmar

[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.
parent 657dfc15
% -----------------------------------------------------------------------------
% $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}
/*
* (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; }
/* -----------------------------------------------------------------------------
* $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);
......
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