X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Frequired%2FDirectory.lhs;h=69c81f3a17f1d4c3e96f44c13c94c61ebc034a15;hb=2919aad039406a0ff60807cef076e8609f2ab83b;hp=3f8b365d35b59d643b9ffe6965fdd6b96c1c4245;hpb=bb521c6bba76f19474f12195b990b29eda66a4e8;p=ghc-hetmet.git diff --git a/ghc/lib/required/Directory.lhs b/ghc/lib/required/Directory.lhs index 3f8b365..69c81f3 100644 --- a/ghc/lib/required/Directory.lhs +++ b/ghc/lib/required/Directory.lhs @@ -1,8 +1,7 @@ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The AQUA Project, Glasgow University, 1994-1997 % - -\section[Directory]{Module @Directory@} +\section[Directory]{Directory interface} A directory contains a series of entries, each of which is a named reference to a file system object (file, directory etc.). Some @@ -18,16 +17,37 @@ some operating systems, it may also be possible to have paths which are relative to the current directory. \begin{code} -module Directory ( - createDirectory, removeDirectory, removeFile, - renameDirectory, renameFile, getDirectoryContents, - getCurrentDirectory, setCurrentDirectory - ) where - +{-# OPTIONS -#include #-} +module Directory + ( + Permissions(Permissions), + + createDirectory, + removeDirectory, + renameDirectory, + getDirectoryContents, + getCurrentDirectory, + setCurrentDirectory, + + removeFile, + renameFile, + + doesFileExist, + doesDirectoryExist, + getPermissions, + setPermissions, + getModificationTime + ) where + +import PrelBase import Foreign import IOBase -import STBase ( PrimIO ) -import PackedString ( packCBytesST, unpackPS ) +import STBase +import UnsafeST ( unsafePerformPrimIO ) +import ArrBase +import PackBase ( unpackNBytesST ) +import Time ( ClockTime(..) ) + \end{code} %********************************************************* @@ -45,44 +65,67 @@ renameFile :: FilePath -> FilePath -> IO () getDirectoryContents :: FilePath -> IO [FilePath] getCurrentDirectory :: IO FilePath setCurrentDirectory :: FilePath -> IO () +doesFileExist :: FilePath -> IO Bool +doesDirectoryExist :: FilePath -> IO Bool +getPermissions :: FilePath -> IO Permissions +setPermissions :: FilePath -> Permissions -> IO () +getModificationTime :: FilePath -> IO ClockTime \end{code} %********************************************************* %* * -\subsection{Signatures} +\subsection{Permissions} %* * %********************************************************* -$createDirectory dir$ creates a new directory -{\em dir} which is initially empty, or as near to empty as the -operating system allows. +The @Permissions@ type is used to record whether certain +operations are permissible on a file/directory: +[to whom? - owner/group/world - the Report don't say much] + +\begin{code} +data Permissions + = Permissions { + readable, writeable, + executable, searchable :: Bool + } deriving (Eq, Ord, Read, Show) +\end{code} + +%********************************************************* +%* * +\subsection{Implementation} +%* * +%********************************************************* + +@createDirectory dir@ creates a new directory {\em dir} which is +initially empty, or as near to empty as the operating system +allows. The operation may fail with: + \begin{itemize} -\item $AlreadyExists$ +\item @isPermissionError@ / @PermissionDenied@ +The process has insufficient privileges to perform the operation. +@[EROFS, EACCES]@ +\item @isAlreadyExistsError@ / @AlreadyExists@ The operand refers to a directory that already exists. -[$EEXIST$] -\item $HardwareFault$ +@ [EEXIST]@ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $InvalidArgument$ +@ [EIO]@ +\item @InvalidArgument@ The operand is not a valid directory name. -[$ENAMETOOLONG$, $ELOOP$] -\item $NoSuchThing$ +@[ENAMETOOLONG, ELOOP]@ +\item @NoSuchThing@ There is no path to the directory. -[$ENOENT$, $ENOTDIR$] -\item $PermissionDenied$ -The process has insufficient privileges to perform the operation. -[$EROFS$, $EACCES$] -\item $ResourceExhausted$ +@[ENOENT, ENOTDIR]@ +\item @ResourceExhausted@ Insufficient resources (virtual memory, process file descriptors, physical disk space, etc.) are available to perform the operation. -[$EDQUOT$, $ENOSPC$, $ENOMEM$, -$EMLINK$] -\item $InappropriateType$ +@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ +\item @InappropriateType@ The path refers to an existing non-directory object. -[$EEXIST$] +@[EEXIST]@ \end{itemize} \begin{code} @@ -94,7 +137,7 @@ createDirectory path = constructErrorAndFail "createDirectory" \end{code} -$removeDirectory dir$ removes an existing directory {\em dir}. The +@removeDirectory dir@ removes an existing directory {\em dir}. The implementation may specify additional constraints which must be satisfied before a directory can be removed (e.g. the directory has to be empty, or may not be in use by other processes). It is not legal @@ -105,27 +148,27 @@ directory). The operation may fail with: \begin{itemize} -\item $HardwareFault$ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $InvalidArgument$ +[@EIO@] +\item @InvalidArgument@ The operand is not a valid directory name. -[$ENAMETOOLONG$, $ELOOP$] -\item $NoSuchThing$ +@[ENAMETOOLONG, ELOOP]@ +\item @isDoesNotExist@ / @NoSuchThing@ The directory does not exist. -[$ENOENT$, $ENOTDIR$] -\item $PermissionDenied$ +@[ENOENT, ENOTDIR]@ +\item @isPermissionError@ / @PermissionDenied@ The process has insufficient privileges to perform the operation. -[$EROFS$, $EACCES$, $EPERM$] -\item $UnsatisfiedConstraints$ +@[EROFS, EACCES, EPERM]@ +\item @UnsatisfiedConstraints@ Implementation-dependent constraints are not satisfied. -[$EBUSY$, $ENOTEMPTY$, $EEXIST$] -\item $UnsupportedOperation$ +@[EBUSY, ENOTEMPTY, EEXIST]@ +\item @UnsupportedOperation@ The implementation does not support removal in this situation. -[$EINVAL$] -\item $InappropriateType$ +@[EINVAL]@ +\item @InappropriateType@ The operand refers to an existing non-directory object. -[$ENOTDIR$] +@[ENOTDIR]@ \end{itemize} \begin{code} @@ -137,7 +180,7 @@ removeDirectory path = constructErrorAndFail "removeDirectory" \end{code} -$removeFile file$ removes the directory entry for an existing file +@removeFile file@ removes the directory entry for an existing file {\em file}, where {\em file} is not itself a directory. The implementation may specify additional constraints which must be satisfied before a file can be removed (e.g. the file may not be in @@ -145,24 +188,24 @@ use by other processes). The operation may fail with: \begin{itemize} -\item $HardwareFault$ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $InvalidArgument$ +@[EIO]@ +\item @InvalidArgument@ The operand is not a valid file name. -[$ENAMETOOLONG$, $ELOOP$] -\item $NoSuchThing$ +@[ENAMETOOLONG, ELOOP]@ +\item @isDoesNotExist@ / @NoSuchThing@ The file does not exist. -[$ENOENT$, $ENOTDIR$] -\item $PermissionDenied$ +@[ENOENT, ENOTDIR]@ +\item @isPermissionError@ / @PermissionDenied@ The process has insufficient privileges to perform the operation. -[$EROFS$, $EACCES$, $EPERM$] -\item $UnsatisfiedConstraints$ +@[EROFS, EACCES, EPERM]@ +\item @UnsatisfiedConstraints@ Implementation-dependent constraints are not satisfied. -[$EBUSY$] -\item $InappropriateType$ +@[EBUSY]@ +\item @InappropriateType@ The operand refers to an existing directory. -[$EPERM$, $EINVAL$] +@[EPERM, EINVAL]@ \end{itemize} \begin{code} @@ -174,7 +217,7 @@ removeFile path = constructErrorAndFail "removeFile" \end{code} -$renameDirectory old$ {\em new} changes the name of an existing +@renameDirectory old@ {\em new} changes the name of an existing directory from {\em old} to {\em new}. If the {\em new} directory already exists, it is atomically replaced by the {\em old} directory. If the {\em new} directory is neither the {\em old} directory nor an @@ -186,31 +229,30 @@ must be documented. The operation may fail with: \begin{itemize} -\item $HardwareFault$ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $InvalidArgument$ +@[EIO]@ +\item @InvalidArgument@ Either operand is not a valid directory name. -[$ENAMETOOLONG$, $ELOOP$] -\item $NoSuchThing$ +@[ENAMETOOLONG, ELOOP]@ +\item @isDoesNotExistError@ / @NoSuchThing@ The original directory does not exist, or there is no path to the target. -[$ENOENT$, $ENOTDIR$] -\item $PermissionDenied$ +@[ENOENT, ENOTDIR]@ +\item @isPermissionError@ / @PermissionDenied@ The process has insufficient privileges to perform the operation. -[$EROFS$, $EACCES$, $EPERM$] -\item $ResourceExhausted$ +@[EROFS, EACCES, EPERM]@ +\item @ResourceExhausted@ Insufficient resources are available to perform the operation. -[$EDQUOT$, $ENOSPC$, $ENOMEM$, -$EMLINK$] -\item $UnsatisfiedConstraints$ +@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ +\item @UnsatisfiedConstraints@ Implementation-dependent constraints are not satisfied. -[$EBUSY$, $ENOTEMPTY$, $EEXIST$] -\item $UnsupportedOperation$ +@[EBUSY, ENOTEMPTY, EEXIST]@ +\item @UnsupportedOperation@ The implementation does not support renaming in this situation. -[$EINVAL$, $EXDEV$] -\item $InappropriateType$ +@[EINVAL, EXDEV]@ +\item @InappropriateType@ Either path refers to an existing non-directory object. -[$ENOTDIR$, $EISDIR$] +@[ENOTDIR, EISDIR]@ \end{itemize} \begin{code} @@ -222,7 +264,7 @@ renameDirectory opath npath = constructErrorAndFail "renameDirectory" \end{code} -$renameFile old$ {\em new} changes the name of an existing file system +@renameFile old@ {\em new} changes the name of an existing file system object from {\em old} to {\em new}. If the {\em new} object already exists, it is atomically replaced by the {\em old} object. Neither path may refer to an existing directory. A conformant implementation @@ -232,32 +274,30 @@ documented. The operation may fail with: \begin{itemize} -\item $HardwareFault$ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $InvalidArgument$ +@[EIO]@ +\item @InvalidArgument@ Either operand is not a valid file name. -[$ENAMETOOLONG$, $ELOOP$] -\item $NoSuchThing$ +@[ENAMETOOLONG, ELOOP]@ +\item @isDoesNotExistError@ / @NoSuchThing@ The original file does not exist, or there is no path to the target. -[$ENOENT$, $ENOTDIR$] -\item $PermissionDenied$ +@[ENOENT, ENOTDIR]@ +\item @isPermissionError@ / @PermissionDenied@ The process has insufficient privileges to perform the operation. -[$EROFS$, $EACCES$, $EPERM$] -\item $ResourceExhausted$ +@[EROFS, EACCES, EPERM]@ +\item @ResourceExhausted@ Insufficient resources are available to perform the operation. -[$EDQUOT$, $ENOSPC$, $ENOMEM$, -$EMLINK$] -\item $UnsatisfiedConstraints$ +@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ +\item @UnsatisfiedConstraints@ Implementation-dependent constraints are not satisfied. -[$EBUSY$] -\item $UnsupportedOperation$ +@[EBUSY]@ +\item @UnsupportedOperation@ The implementation does not support renaming in this situation. -[$EXDEV$] -\item $InappropriateType$ +@[EXDEV]@ +\item @InappropriateType@ Either path refers to an existing directory. -[$ENOTDIR$, $EISDIR$, $EINVAL$, -$EEXIST$, $ENOTEMPTY$] +@[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@ \end{itemize} \begin{code} @@ -269,29 +309,29 @@ renameFile opath npath = constructErrorAndFail "renameFile" \end{code} -$getDirectoryContents dir$ returns a list of -all entries in {\em dir}. +@getDirectoryContents dir@ returns a list of {\em all} entries +in {\em dir}. The operation may fail with: \begin{itemize} -\item $HardwareFault$ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $InvalidArgument$ +@[EIO]@ +\item @InvalidArgument@ The operand is not a valid directory name. -[$ENAMETOOLONG$, $ELOOP$] -\item $NoSuchThing$ +@[ENAMETOOLONG, ELOOP]@ +\item @isDoesNotExistError@ / @NoSuchThing@ The directory does not exist. -[$ENOENT$, $ENOTDIR$] -\item $PermissionDenied$ +@[ENOENT, ENOTDIR]@ +\item @isPermissionError@ / @PermissionDenied@ The process has insufficient privileges to perform the operation. -[$EACCES$] -\item $ResourceExhausted$ +@[EACCES]@ +\item @ResourceExhausted@ Insufficient resources are available to perform the operation. -[$EMFILE$, $ENFILE$] -\item $InappropriateType$ +@[EMFILE, ENFILE]@ +\item @InappropriateType@ The path refers to an existing non-directory object. -[$ENOTDIR$] +@[ENOTDIR]@ \end{itemize} \begin{code} @@ -311,30 +351,30 @@ getDirectoryContents path = return [] else _ccall_ strlen str >>= \ len -> - packCBytesST len str >>= \ entry -> + unpackNBytesST str len >>= \ entry -> _ccall_ free str >>= \ () -> getEntries ptr (n+1) >>= \ entries -> - return (unpackPS entry : entries) + return (entry : entries) \end{code} If the operating system has a notion of current directories, -$getCurrentDirectory$ returns an absolute path to the +@getCurrentDirectory@ returns an absolute path to the current directory of the calling process. The operation may fail with: \begin{itemize} -\item $HardwareFault$ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $NoSuchThing$ +@[EIO]@ +\item @isDoesNotExistError@ / @NoSuchThing@ There is no path referring to the current directory. -[$EPERM$, $ENOENT$, $ESTALE$...] -\item $PermissionDenied$ +@[EPERM, ENOENT, ESTALE...]@ +\item @isPermissionError@ / @PermissionDenied@ The process has insufficient privileges to perform the operation. -[$EACCES$] -\item $ResourceExhausted$ +@[EACCES]@ +\item @ResourceExhausted@ Insufficient resources are available to perform the operation. -\item $UnsupportedOperation$ +\item @UnsupportedOperation@ The operating system has no notion of current directory. \end{itemize} @@ -343,37 +383,37 @@ getCurrentDirectory = _ccall_ getCurrentDirectory `thenIO_Prim` \ str -> if str /= ``NULL'' then _ccall_ strlen str `thenIO_Prim` \ len -> - stToIO (packCBytesST len str) >>= \ pwd -> + stToIO (unpackNBytesST len str) >>= \ pwd -> _ccall_ free str `thenIO_Prim` \ () -> - return (unpackPS pwd) + return pwd else constructErrorAndFail "getCurrentDirectory" \end{code} If the operating system has a notion of current directories, -$setCurrentDirectory dir$ changes the current +@setCurrentDirectory dir@ changes the current directory of the calling process to {\em dir}. The operation may fail with: \begin{itemize} -\item $HardwareFault$ +\item @HardwareFault@ A physical I/O error has occurred. -[$EIO$] -\item $InvalidArgument$ +@[EIO]@ +\item @InvalidArgument@ The operand is not a valid directory name. -[$ENAMETOOLONG$, $ELOOP$] -\item $NoSuchThing$ +@[ENAMETOOLONG, ELOOP]@ +\item @isDoesNotExistError@ / @NoSuchThing@ The directory does not exist. -[$ENOENT$, $ENOTDIR$] -\item $PermissionDenied$ +@[ENOENT, ENOTDIR]@ +\item @isPermissionError@ / @PermissionDenied@ The process has insufficient privileges to perform the operation. -[$EACCES$] -\item $UnsupportedOperation$ +@[EACCES]@ +\item @UnsupportedOperation@ The operating system has no notion of current directory, or the current directory cannot be dynamically changed. -\item $InappropriateType$ +\item @InappropriateType@ The path refers to an existing non-directory object. -[$ENOTDIR$] +@[ENOTDIR]@ \end{itemize} \begin{code} @@ -386,3 +426,130 @@ setCurrentDirectory path = \end{code} + +\begin{code} +--doesFileExist :: FilePath -> IO Bool +doesFileExist name = + _ccall_ access name (``F_OK''::Int) `thenIO_Prim` \ rc -> + return (rc == 0) + +--doesDirectoryExist :: FilePath -> IO Bool +doesDirectoryExist name = + (getFileStatus name >>= \ st -> return (isDirectory st)) + `catch` + (\ _ -> return False) + +--getModificationTime :: FilePath -> IO ClockTime +getModificationTime name = + getFileStatus name >>= \ st -> + modificationTime st + +--getPermissions :: FilePath -> IO Permissions +getPermissions name = + getFileStatus name >>= \ st -> + let + fm = fileMode st + isect v = intersectFileMode v fm == v + in + return ( + Permissions { + readable = isect ownerReadMode, + writeable = isect ownerWriteMode, + executable = not (isDirectory st) && isect ownerExecuteMode, + searchable = not (isRegularFile st) && isect ownerExecuteMode + } + ) + +--setPermissions :: FilePath -> Permissions -> IO () +setPermissions name (Permissions r w e s) = + let + read# = case (if r then ownerReadMode else ``0'') of { W# x# -> x# } + write# = case (if w then ownerWriteMode else ``0'') of { W# x# -> x# } + exec# = case (if e || s then ownerExecuteMode else ``0'') of { W# x# -> x# } + + mode = I# (word2Int# (read# `or#` write# `or#` exec#)) + in + _ccall_ chmod name mode `thenIO_Prim` \ rc -> + if rc == 0 then + return () + else + fail (IOError Nothing SystemError "Directory.setPermissions") + +\end{code} + + +(Sigh)..copied from Posix.Files to avoid dep. on posix library + +\begin{code} +type FileStatus = ByteArray Int + +getFileStatus :: FilePath -> IO FileStatus +getFileStatus name = + newCharArray (0,``sizeof(struct stat)'') `thenIO_Prim` \ bytes -> + _casm_ ``%r = stat(%0,(struct stat *)%1);'' name bytes + `thenIO_Prim` \ rc -> + if rc == 0 then + unsafeFreezeByteArray bytes `thenIO_Prim` \ stat -> + return stat + else + fail (IOError Nothing SystemError "Directory.getFileStatus") + +modificationTime :: FileStatus -> IO ClockTime +modificationTime stat = + malloc1 `thenIO_Prim` \ i1 -> + _casm_ ``((unsigned long *)%1)[0] = ((struct stat *)%0)->st_mtime;'' stat i1 `thenIO_Prim` \ () -> + cvtUnsigned i1 `thenIO_Prim` \ secs -> + return (TOD secs 0) + where + malloc1 = ST $ \ (S# s#) -> + case newIntArray# 1# s# of + StateAndMutableByteArray# s2# barr# -> (MutableByteArray bnds barr#, S# s2#) + + bnds = (0,1) + -- The C routine fills in an unsigned word. We don't have `unsigned2Integer#,' + -- so we freeze the data bits and use them for an MP_INT structure. Note that + -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably + -- acceptable to gmp. + + cvtUnsigned (MutableByteArray _ arr#) = ST $ \ (S# s#) -> + case readIntArray# arr# 0# s# of + StateAndInt# s2# r# -> + if r# ==# 0# then + (0, S# s2#) + else + case unsafeFreezeByteArray# arr# s2# of + StateAndByteArray# s3# frozen# -> (J# 1# 1# frozen#, S# s3#) + +isDirectory :: FileStatus -> Bool +isDirectory stat = unsafePerformPrimIO $ + _casm_ ``%r = S_ISDIR(((struct stat *)%0)->st_mode);'' stat >>= \ rc -> + return (rc /= 0) + +isRegularFile :: FileStatus -> Bool +isRegularFile stat = unsafePerformPrimIO $ + _casm_ ``%r = S_ISREG(((struct stat *)%0)->st_mode);'' stat >>= \ rc -> + return (rc /= 0) + + +\end{code} + +\begin{code} +type FileMode = Word +ownerReadMode :: FileMode +ownerReadMode = ``S_IRUSR'' + +ownerWriteMode :: FileMode +ownerWriteMode = ``S_IWUSR'' + +ownerExecuteMode :: FileMode +ownerExecuteMode = ``S_IXUSR'' + +intersectFileMode :: FileMode -> FileMode -> FileMode +intersectFileMode (W# m1#) (W# m2#) = W# (m1# `and#` m2#) + +fileMode :: FileStatus -> FileMode +fileMode stat = unsafePerformPrimIO $ + _casm_ ``%r = ((struct stat *)%0)->st_mode;'' stat >>= \ mode -> + return mode + +\end{code}