[project @ 2001-04-11 10:41:46 by sewardj]
[ghc-hetmet.git] / ghc / lib / std / Directory.hsc
1 -- -----------------------------------------------------------------------------
2 -- $Id: Directory.hsc,v 1.10 2001/04/02 16:10:32 rrt Exp $
3 --
4 -- (c) The University of Glasgow, 1994-2000
5 --
6
7 -- The Directory Interface
8
9 {-
10 A directory contains a series of entries, each of which is a named
11 reference to a file system object (file, directory etc.).  Some
12 entries may be hidden, inaccessible, or have some administrative
13 function (e.g. "." or ".." under POSIX), but in this standard all such
14 entries are considered to form part of the directory contents.
15 Entries in sub-directories are not, however, considered to form part
16 of the directory contents.
17
18 Each file system object is referenced by a {\em path}.  There is
19 normally at least one absolute path to each file system object.  In
20 some operating systems, it may also be possible to have paths which
21 are relative to the current directory.
22 -}
23
24 module Directory 
25    ( 
26       Permissions               -- abstract
27       
28     , readable                  -- :: Permissions -> Bool
29     , writable                  -- :: Permissions -> Bool
30     , executable                -- :: Permissions -> Bool
31     , searchable                -- :: Permissions -> Bool
32
33     , createDirectory           -- :: FilePath -> IO ()
34     , removeDirectory           -- :: FilePath -> IO ()
35     , renameDirectory           -- :: FilePath -> FilePath -> IO ()
36
37     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
38     , getCurrentDirectory       -- :: IO FilePath
39     , setCurrentDirectory       -- :: FilePath -> IO ()
40
41     , removeFile                -- :: FilePath -> IO ()
42     , renameFile                -- :: FilePath -> FilePath -> IO ()
43
44     , doesFileExist             -- :: FilePath -> IO Bool
45     , doesDirectoryExist        -- :: FilePath -> IO Bool
46
47     , getPermissions            -- :: FilePath -> IO Permissions
48     , setPermissions            -- :: FilePath -> Permissions -> IO ()
49
50     , getModificationTime       -- :: FilePath -> IO ClockTime
51    ) where
52
53 import Prelude          -- Just to get it in the dependencies
54
55 import Time             ( ClockTime(..) )
56
57 import PrelStorable
58 import PrelCString
59 import PrelMarshalAlloc
60 import PrelCTypesISO
61 import PrelCTypes
62 import PrelPosixTypes
63 import PrelCError
64 import PrelPtr
65 import PrelIOBase
66 import PrelBase
67
68 -- Fix mingw stat problem
69 #include "../includes/config.h"
70 #include <sys/stat.h>
71 #include <dirent.h>
72 #include <limits.h>
73 #include <errno.h>
74 #include <unistd.h>
75
76 -----------------------------------------------------------------------------
77 -- Permissions
78
79 -- The @Permissions@ type is used to record whether certain
80 -- operations are permissible on a file/directory:
81 -- [to whom? - presumably the "current user"]
82
83 data Permissions
84  = Permissions {
85     readable,   writable, 
86     executable, searchable :: Bool 
87    } deriving (Eq, Ord, Read, Show)
88
89 -----------------------------------------------------------------------------
90 -- Implementation
91
92 -- @createDirectory dir@ creates a new directory {\em dir} which is
93 -- initially empty, or as near to empty as the operating system
94 -- allows.
95
96 -- The operation may fail with:
97
98 {-
99 \begin{itemize}
100 \item @isPermissionError@ / @PermissionDenied@
101 The process has insufficient privileges to perform the operation.
102 @[EROFS, EACCES]@
103 \item @isAlreadyExistsError@ / @AlreadyExists@
104 The operand refers to a directory that already exists.  
105 @ [EEXIST]@
106 \item @HardwareFault@
107 A physical I/O error has occurred.
108 @ [EIO]@
109 \item @InvalidArgument@
110 The operand is not a valid directory name.
111 @[ENAMETOOLONG, ELOOP]@
112 \item @NoSuchThing@
113 There is no path to the directory. 
114 @[ENOENT, ENOTDIR]@
115 \item @ResourceExhausted@
116 Insufficient resources (virtual memory, process file descriptors,
117 physical disk space, etc.) are available to perform the operation.
118 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
119 \item @InappropriateType@
120 The path refers to an existing non-directory object.
121 @[EEXIST]@
122 \end{itemize}
123 -}
124
125 createDirectory :: FilePath -> IO ()
126 createDirectory path = do
127     withUnsafeCString path $ \s -> do
128       throwErrnoIfMinus1Retry_ "createDirectory" $
129 #if defined(mingw32_TARGET_OS)
130         mkdir s
131 #else
132         mkdir s 0o777
133 #endif
134
135 {-
136 @removeDirectory dir@ removes an existing directory {\em dir}.  The
137 implementation may specify additional constraints which must be
138 satisfied before a directory can be removed (e.g. the directory has to
139 be empty, or may not be in use by other processes).  It is not legal
140 for an implementation to partially remove a directory unless the
141 entire directory is removed. A conformant implementation need not
142 support directory removal in all situations (e.g. removal of the root
143 directory).
144
145 The operation may fail with:
146 \begin{itemize}
147 \item @HardwareFault@
148 A physical I/O error has occurred.
149 [@EIO@]
150 \item @InvalidArgument@
151 The operand is not a valid directory name.
152 @[ENAMETOOLONG, ELOOP]@
153 \item @isDoesNotExist@ / @NoSuchThing@
154 The directory does not exist. 
155 @[ENOENT, ENOTDIR]@
156 \item @isPermissionError@ / @PermissionDenied@
157 The process has insufficient privileges to perform the operation.
158 @[EROFS, EACCES, EPERM]@
159 \item @UnsatisfiedConstraints@
160 Implementation-dependent constraints are not satisfied.  
161 @[EBUSY, ENOTEMPTY, EEXIST]@
162 \item @UnsupportedOperation@
163 The implementation does not support removal in this situation.
164 @[EINVAL]@
165 \item @InappropriateType@
166 The operand refers to an existing non-directory object.
167 @[ENOTDIR]@
168 \end{itemize}
169 -}
170
171 removeDirectory :: FilePath -> IO ()
172 removeDirectory path = do
173     withUnsafeCString path $ \s ->
174        throwErrnoIfMinus1Retry_ "removeDirectory" (rmdir s)
175
176 {-
177 @Removefile file@ removes the directory entry for an existing file
178 {\em file}, where {\em file} is not itself a directory. The
179 implementation may specify additional constraints which must be
180 satisfied before a file can be removed (e.g. the file may not be in
181 use by other processes).
182
183 The operation may fail with:
184 \begin{itemize}
185 \item @HardwareFault@
186 A physical I/O error has occurred.
187 @[EIO]@
188 \item @InvalidArgument@
189 The operand is not a valid file name.
190 @[ENAMETOOLONG, ELOOP]@
191 \item @isDoesNotExist@ / @NoSuchThing@
192 The file does not exist. 
193 @[ENOENT, ENOTDIR]@
194 \item @isPermissionError@ / @PermissionDenied@
195 The process has insufficient privileges to perform the operation.
196 @[EROFS, EACCES, EPERM]@
197 \item @UnsatisfiedConstraints@
198 Implementation-dependent constraints are not satisfied.  
199 @[EBUSY]@
200 \item @InappropriateType@
201 The operand refers to an existing directory.
202 @[EPERM, EINVAL]@
203 \end{itemize}
204 -}
205
206 removeFile :: FilePath -> IO ()
207 removeFile path = do
208     withUnsafeCString path $ \s ->
209       throwErrnoIfMinus1Retry_ "removeFile" (unlink s)
210
211 {-
212 @renameDirectory@ {\em old} {\em new} changes the name of an existing
213 directory from {\em old} to {\em new}.  If the {\em new} directory
214 already exists, it is atomically replaced by the {\em old} directory.
215 If the {\em new} directory is neither the {\em old} directory nor an
216 alias of the {\em old} directory, it is removed as if by
217 $removeDirectory$.  A conformant implementation need not support
218 renaming directories in all situations (e.g. renaming to an existing
219 directory, or across different physical devices), but the constraints
220 must be documented.
221
222 The operation may fail with:
223 \begin{itemize}
224 \item @HardwareFault@
225 A physical I/O error has occurred.
226 @[EIO]@
227 \item @InvalidArgument@
228 Either operand is not a valid directory name.
229 @[ENAMETOOLONG, ELOOP]@
230 \item @isDoesNotExistError@ / @NoSuchThing@
231 The original directory does not exist, or there is no path to the target.
232 @[ENOENT, ENOTDIR]@
233 \item @isPermissionError@ / @PermissionDenied@
234 The process has insufficient privileges to perform the operation.
235 @[EROFS, EACCES, EPERM]@
236 \item @ResourceExhausted@
237 Insufficient resources are available to perform the operation.  
238 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
239 \item @UnsatisfiedConstraints@
240 Implementation-dependent constraints are not satisfied.
241 @[EBUSY, ENOTEMPTY, EEXIST]@
242 \item @UnsupportedOperation@
243 The implementation does not support renaming in this situation.
244 @[EINVAL, EXDEV]@
245 \item @InappropriateType@
246 Either path refers to an existing non-directory object.
247 @[ENOTDIR, EISDIR]@
248 \end{itemize}
249 -}
250
251 renameDirectory :: FilePath -> FilePath -> IO ()
252 renameDirectory opath npath =
253    withFileStatus opath $ \st -> do
254    is_dir <- isDirectory st
255    if (not is_dir)
256         then ioException (IOError Nothing InappropriateType "renameDirectory"
257                             ("not a directory") (Just opath))
258         else do
259
260    withUnsafeCString opath $ \s1 ->
261      withUnsafeCString npath $ \s2 ->
262         throwErrnoIfMinus1Retry_ "renameDirectory" (rename s1 s2)
263
264 {-
265 @renameFile@ {\em old} {\em new} changes the name of an existing file system
266 object from {\em old} to {\em new}.  If the {\em new} object already
267 exists, it is atomically replaced by the {\em old} object.  Neither
268 path may refer to an existing directory.  A conformant implementation
269 need not support renaming files in all situations (e.g. renaming
270 across different physical devices), but the constraints must be
271 documented.
272
273 The operation may fail with:
274 \begin{itemize}
275 \item @HardwareFault@
276 A physical I/O error has occurred.
277 @[EIO]@
278 \item @InvalidArgument@
279 Either operand is not a valid file name.
280 @[ENAMETOOLONG, ELOOP]@
281 \item @isDoesNotExistError@ / @NoSuchThing@
282 The original file does not exist, or there is no path to the target.
283 @[ENOENT, ENOTDIR]@
284 \item @isPermissionError@ / @PermissionDenied@
285 The process has insufficient privileges to perform the operation.
286 @[EROFS, EACCES, EPERM]@
287 \item @ResourceExhausted@
288 Insufficient resources are available to perform the operation.  
289 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
290 \item @UnsatisfiedConstraints@
291 Implementation-dependent constraints are not satisfied.
292 @[EBUSY]@
293 \item @UnsupportedOperation@
294 The implementation does not support renaming in this situation.
295 @[EXDEV]@
296 \item @InappropriateType@
297 Either path refers to an existing directory.
298 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
299 \end{itemize}
300 -}
301
302 renameFile :: FilePath -> FilePath -> IO ()
303 renameFile opath npath =
304    withFileStatus opath $ \st -> do
305    is_dir <- isDirectory st
306    if is_dir
307         then ioException (IOError Nothing InappropriateType "renameFile"
308                            "is a directory" (Just opath))
309         else do
310
311     withUnsafeCString opath $ \s1 ->
312       withUnsafeCString npath $ \s2 ->
313          throwErrnoIfMinus1Retry_ "renameFile" (rename s1 s2)
314
315 {-
316 @getDirectoryContents dir@ returns a list of {\em all} entries
317 in {\em dir}. 
318
319 The operation may fail with:
320 \begin{itemize}
321 \item @HardwareFault@
322 A physical I/O error has occurred.
323 @[EIO]@
324 \item @InvalidArgument@
325 The operand is not a valid directory name.
326 @[ENAMETOOLONG, ELOOP]@
327 \item @isDoesNotExistError@ / @NoSuchThing@
328 The directory does not exist.
329 @[ENOENT, ENOTDIR]@
330 \item @isPermissionError@ / @PermissionDenied@
331 The process has insufficient privileges to perform the operation.
332 @[EACCES]@
333 \item @ResourceExhausted@
334 Insufficient resources are available to perform the operation.
335 @[EMFILE, ENFILE]@
336 \item @InappropriateType@
337 The path refers to an existing non-directory object.
338 @[ENOTDIR]@
339 \end{itemize}
340 -}
341
342 getDirectoryContents :: FilePath -> IO [FilePath]
343 getDirectoryContents path = do
344    p <- withUnsafeCString path $ \s ->
345           throwErrnoIfNullRetry "getDirectoryContents" (opendir s)
346    loop p
347   where
348     loop :: Ptr CDir -> IO [String]
349     loop dir = do
350       resetErrno
351       p <- readdir dir
352       if (p /= nullPtr)
353          then do
354 #ifndef mingw32_TARGET_OS
355                  entry <- peekCString ((#ptr struct dirent,d_name) p)
356 #else
357                  entryp <- (#peek struct dirent,d_name) p
358                  entry <- peekCString entryp -- on mingwin it's a char *, not a char []
359 #endif
360                  entries <- loop dir
361                  return (entry:entries)
362          else do errno <- getErrno
363                  if (errno == eINTR) then loop dir else do
364                  throwErrnoIfMinus1_ "getDirectoryContents" $ closedir dir
365 #ifndef mingw32_TARGET_OS
366                  if (errno == eOK)
367 #else
368                  if (errno == eNOENT) -- mingwin (20001111) cunningly sets errno to ENOENT when it runs out of files
369 #endif
370                     then return []
371                     else throwErrno "getDirectoryContents"
372
373 {-
374 If the operating system has a notion of current directories,
375 @getCurrentDirectory@ returns an absolute path to the
376 current directory of the calling process.
377
378 The operation may fail with:
379 \begin{itemize}
380 \item @HardwareFault@
381 A physical I/O error has occurred.
382 @[EIO]@
383 \item @isDoesNotExistError@ / @NoSuchThing@
384 There is no path referring to the current directory.
385 @[EPERM, ENOENT, ESTALE...]@
386 \item @isPermissionError@ / @PermissionDenied@
387 The process has insufficient privileges to perform the operation.
388 @[EACCES]@
389 \item @ResourceExhausted@
390 Insufficient resources are available to perform the operation.
391 \item @UnsupportedOperation@
392 The operating system has no notion of current directory.
393 \end{itemize}
394 -}
395
396 getCurrentDirectory :: IO FilePath
397 getCurrentDirectory = do
398   p <- mallocBytes (#const PATH_MAX)
399   go p (#const PATH_MAX)
400   where go p bytes = do
401           p' <- getcwd p (fromIntegral bytes)
402           if p' /= nullPtr 
403              then do s <- peekCString p'
404                      free p'
405                      return s
406              else do errno <- getErrno
407                      if errno == eRANGE
408                         then do let bytes' = bytes * 2
409                                 p' <- reallocBytes p bytes'
410                                 go p' bytes'
411                         else throwErrno "getCurrentDirectory"
412
413 {-
414 If the operating system has a notion of current directories,
415 @setCurrentDirectory dir@ changes the current
416 directory of the calling process to {\em dir}.
417
418 The operation may fail with:
419 \begin{itemize}
420 \item @HardwareFault@
421 A physical I/O error has occurred.
422 @[EIO]@
423 \item @InvalidArgument@
424 The operand is not a valid directory name.
425 @[ENAMETOOLONG, ELOOP]@
426 \item @isDoesNotExistError@ / @NoSuchThing@
427 The directory does not exist.
428 @[ENOENT, ENOTDIR]@
429 \item @isPermissionError@ / @PermissionDenied@
430 The process has insufficient privileges to perform the operation.
431 @[EACCES]@
432 \item @UnsupportedOperation@
433 The operating system has no notion of current directory, or the
434 current directory cannot be dynamically changed.
435 \item @InappropriateType@
436 The path refers to an existing non-directory object.
437 @[ENOTDIR]@
438 \end{itemize}
439 -}
440
441 setCurrentDirectory :: FilePath -> IO ()
442 setCurrentDirectory path = do
443     withUnsafeCString path $ \s -> 
444        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (chdir s)
445         -- ToDo: add path to error
446
447 {-
448 To clarify, @doesDirectoryExist@ returns True if a file system object
449 exist, and it's a directory. @doesFileExist@ returns True if the file
450 system object exist, but it's not a directory (i.e., for every other 
451 file system object that is not a directory.) 
452 -}
453
454 doesDirectoryExist :: FilePath -> IO Bool
455 doesDirectoryExist name = 
456  catch
457    (withFileStatus name $ \st -> isDirectory st)
458    (\ _ -> return False)
459
460 doesFileExist :: FilePath -> IO Bool
461 doesFileExist name = do 
462  catch
463    (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
464    (\ _ -> return False)
465
466 getModificationTime :: FilePath -> IO ClockTime
467 getModificationTime name =
468  withFileStatus name $ \ st ->
469  modificationTime st
470
471 getPermissions :: FilePath -> IO Permissions
472 getPermissions name = do
473   withUnsafeCString name $ \s -> do
474   read  <- access s (#const R_OK)
475   write <- access s (#const W_OK)
476   exec  <- access s (#const X_OK)
477   withFileStatus name $ \st -> do
478   is_dir <- isDirectory st
479   is_reg <- isRegularFile st
480   return (
481     Permissions {
482       readable   = read  == 0,
483       writable   = write == 0,
484       executable = not is_dir && exec == 0,
485       searchable = not is_reg && exec == 0
486     }
487    )
488
489 setPermissions :: FilePath -> Permissions -> IO ()
490 setPermissions name (Permissions r w e s) = do
491     let
492      read  = if r      then (#const S_IRUSR) else emptyCMode
493      write = if w      then (#const S_IWUSR) else emptyCMode
494      exec  = if e || s then (#const S_IXUSR) else emptyCMode
495
496      mode  = read `unionCMode` (write `unionCMode` exec)
497
498     withUnsafeCString name $ \s ->
499       throwErrnoIfMinus1_ "setPermissions" $ chmod s mode
500
501 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
502 withFileStatus name f = do
503     allocaBytes (#const sizeof(struct stat)) $ \p ->
504       withUnsafeCString name $ \s -> do
505         throwErrnoIfMinus1Retry_ "withFileStatus" (stat s p)
506         f p
507
508 modificationTime :: Ptr CStat -> IO ClockTime
509 modificationTime stat = do
510     mtime <- (#peek struct stat, st_mtime) stat
511     return (TOD (toInteger (mtime :: CTime)) 0)
512
513 isDirectory :: Ptr CStat -> IO Bool
514 isDirectory stat = do
515   mode <- (#peek struct stat, st_mode) stat
516   return (s_ISDIR mode /= 0)
517
518 isRegularFile :: Ptr CStat -> IO Bool
519 isRegularFile stat = do
520   mode <- (#peek struct stat, st_mode) stat
521   return (s_ISREG mode /= 0)
522
523 foreign import ccall unsafe s_ISDIR :: CMode -> Int
524 #def inline HsInt s_ISDIR(m) {return S_ISDIR(m);}
525
526 foreign import ccall unsafe s_ISREG :: CMode -> Int
527 #def inline HsInt s_ISREG(m) {return S_ISREG(m);}
528
529 emptyCMode     :: CMode
530 emptyCMode     = 0
531
532 unionCMode     :: CMode -> CMode -> CMode
533 unionCMode     = (+)
534
535 type UCString = UnsafeCString
536
537 #if defined(mingw32_TARGET_OS)
538 foreign import ccall unsafe mkdir    :: UCString -> IO CInt
539 #else
540 foreign import ccall unsafe mkdir    :: UCString -> CInt -> IO CInt
541 #endif
542
543 foreign import ccall unsafe chmod    :: UCString -> CMode -> IO CInt
544 foreign import ccall unsafe access   :: UCString -> CMode -> IO CInt
545 foreign import ccall unsafe rmdir    :: UCString -> IO CInt
546 foreign import ccall unsafe chdir    :: UCString -> IO CInt
547 foreign import ccall unsafe getcwd   :: Ptr CChar -> CInt -> IO (Ptr CChar)
548 foreign import ccall unsafe unlink   :: UCString -> IO CInt
549 foreign import ccall unsafe rename   :: UCString -> UCString -> IO CInt
550                      
551 foreign import ccall unsafe opendir  :: UCString  -> IO (Ptr CDir)
552 foreign import ccall unsafe readdir  :: Ptr CDir -> IO (Ptr CDirent)
553 foreign import ccall unsafe closedir :: Ptr CDir -> IO CInt
554
555 foreign import ccall unsafe stat     :: UCString -> Ptr CStat -> IO CInt
556
557 type CDirent = ()
558 type CStat   = ()