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