d3245df0b0a07cb1f6f57bb2b6c122a6610ced07
[packages/random.git] / System / Directory.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : System.Directory
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
10 --
11 -- System-independent interface to directory manipulation.
12 --
13 -----------------------------------------------------------------------------
14
15 module System.Directory
16 (
17 -- $intro
18
19 -- * Permissions
20
21 -- $permissions
22
23 Permissions(
24 Permissions,
25 readable, -- :: Permissions -> Bool
26 writable, -- :: Permissions -> Bool
27 executable, -- :: Permissions -> Bool
28 searchable -- :: Permissions -> Bool
29 )
30
31 -- * Actions on directories
32 , createDirectory -- :: FilePath -> IO ()
33 , removeDirectory -- :: FilePath -> IO ()
34 , renameDirectory -- :: FilePath -> FilePath -> IO ()
35
36 , getDirectoryContents -- :: FilePath -> IO [FilePath]
37 , getCurrentDirectory -- :: IO FilePath
38 , setCurrentDirectory -- :: FilePath -> IO ()
39
40 -- * Actions on files
41 , removeFile -- :: FilePath -> IO ()
42 , renameFile -- :: FilePath -> FilePath -> IO ()
43
44 -- * Existence tests
45 , doesFileExist -- :: FilePath -> IO Bool
46 , doesDirectoryExist -- :: FilePath -> IO Bool
47
48 -- * Setting and retrieving permissions
49
50 , getPermissions -- :: FilePath -> IO Permissions
51 , setPermissions -- :: FilePath -> Permissions -> IO ()
52
53 -- * Timestamps
54
55 , getModificationTime -- :: FilePath -> IO ClockTime
56 ) where
57
58 import Prelude
59
60 import Control.Exception ( bracket )
61 import System.Posix.Types
62 import System.Time ( ClockTime(..) )
63 import System.IO
64 import Foreign
65 import Foreign.C
66
67 #ifdef __GLASGOW_HASKELL__
68 import GHC.Posix
69 import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
70 #endif
71
72 {- $intro
73 A directory contains a series of entries, each of which is a named
74 reference to a file system object (file, directory etc.). Some
75 entries may be hidden, inaccessible, or have some administrative
76 function (e.g. `.' or `..' under POSIX
77 <http://www.opengroup.org/onlinepubs/007904975/toc.htm>), but in
78 this standard all such entries are considered to form part of the
79 directory contents. Entries in sub-directories are not, however,
80 considered to form part of the directory contents.
81
82 Each file system object is referenced by a /path/. There is
83 normally at least one absolute path to each file system object. In
84 some operating systems, it may also be possible to have paths which
85 are relative to the current directory.
86 -}
87
88 -----------------------------------------------------------------------------
89 -- Permissions
90
91 {- $permissions
92
93 The 'Permissions' type is used to record whether certain operations are
94 permissible on a file\/directory. 'getPermissions' and 'setPermissions'
95 get and set these permissions, respectively. Permissions apply both to
96 files and directories. For directories, the executable field will be
97 'False', and for files the searchable field will be 'False'. Note that
98 directories may be searchable without being readable, if permission has
99 been given to use them as part of a path, but not to examine the
100 directory contents.
101
102 Note that to change some, but not all permissions, a construct on the following lines must be used.
103
104 > makeReadable f = do
105 > p <- getPermissions f
106 > setPermissions f (p {readable = True})
107
108 -}
109
110 data Permissions
111 = Permissions {
112 readable, writable,
113 executable, searchable :: Bool
114 } deriving (Eq, Ord, Read, Show)
115
116 getPermissions :: FilePath -> IO Permissions
117 getPermissions name = do
118 withCString name $ \s -> do
119 read <- c_access s r_OK
120 write <- c_access s w_OK
121 exec <- c_access s x_OK
122 withFileStatus name $ \st -> do
123 is_dir <- isDirectory st
124 return (
125 Permissions {
126 readable = read == 0,
127 writable = write == 0,
128 executable = not is_dir && exec == 0,
129 searchable = is_dir && exec == 0
130 }
131 )
132
133 setPermissions :: FilePath -> Permissions -> IO ()
134 setPermissions name (Permissions r w e s) = do
135 let
136 read = if r then s_IRUSR else emptyCMode
137 write = if w then s_IWUSR else emptyCMode
138 exec = if e || s then s_IXUSR else emptyCMode
139
140 mode = read `unionCMode` (write `unionCMode` exec)
141
142 withCString name $ \s ->
143 throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
144
145 -----------------------------------------------------------------------------
146 -- Implementation
147
148 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
149 initially empty, or as near to empty as the operating system
150 allows.
151
152 The operation may fail with:
153
154 * 'isPermissionError' \/ 'PermissionDenied'
155 The process has insufficient privileges to perform the operation.
156 @[EROFS, EACCES]@
157
158 * 'isAlreadyExistsError' \/ 'AlreadyExists'
159 The operand refers to a directory that already exists.
160 @ [EEXIST]@
161
162 * 'HardwareFault'
163 A physical I\/O error has occurred.
164 @[EIO]@
165
166 * 'InvalidArgument'
167 The operand is not a valid directory name.
168 @[ENAMETOOLONG, ELOOP]@
169
170 * 'NoSuchThing'
171 There is no path to the directory.
172 @[ENOENT, ENOTDIR]@
173
174 * 'ResourceExhausted'
175 Insufficient resources (virtual memory, process file descriptors,
176 physical disk space, etc.) are available to perform the operation.
177 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
178
179 * 'InappropriateType'
180 The path refers to an existing non-directory object.
181 @[EEXIST]@
182
183 -}
184
185 createDirectory :: FilePath -> IO ()
186 createDirectory path = do
187 withCString path $ \s -> do
188 throwErrnoIfMinus1Retry_ "createDirectory" $
189 mkdir s 0o777
190
191 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
192 implementation may specify additional constraints which must be
193 satisfied before a directory can be removed (e.g. the directory has to
194 be empty, or may not be in use by other processes). It is not legal
195 for an implementation to partially remove a directory unless the
196 entire directory is removed. A conformant implementation need not
197 support directory removal in all situations (e.g. removal of the root
198 directory).
199
200 The operation may fail with:
201
202 * 'HardwareFault'
203 A physical I\/O error has occurred.
204 EIO
205
206 * 'InvalidArgument'
207 The operand is not a valid directory name.
208 [ENAMETOOLONG, ELOOP]
209
210 * 'isDoesNotExist' 'NoSuchThing'
211 The directory does not exist.
212 @[ENOENT, ENOTDIR]@
213
214 * 'isPermissionError' \/ 'PermissionDenied'
215 The process has insufficient privileges to perform the operation.
216 @[EROFS, EACCES, EPERM]@
217
218 * 'UnsatisfiedConstraints'
219 Implementation-dependent constraints are not satisfied.
220 @[EBUSY, ENOTEMPTY, EEXIST]@
221
222 * 'UnsupportedOperation'
223 The implementation does not support removal in this situation.
224 @[EINVAL]@
225
226 * 'InappropriateType'
227 The operand refers to an existing non-directory object.
228 @[ENOTDIR]@
229
230 -}
231
232 removeDirectory :: FilePath -> IO ()
233 removeDirectory path = do
234 withCString path $ \s ->
235 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
236
237 {- |@'removefile' file@ removes the directory entry for an existing file
238 /file/, where /file/ is not itself a directory. The
239 implementation may specify additional constraints which must be
240 satisfied before a file can be removed (e.g. the file may not be in
241 use by other processes).
242
243 The operation may fail with:
244
245 * 'HardwareFault'
246 A physical I\/O error has occurred.
247 'EIO'
248
249 * 'InvalidArgument'
250 The operand is not a valid file name.
251 @[ENAMETOOLONG, ELOOP]@
252
253 * 'isDoesNotExist' \/ 'NoSuchThing'
254 The file does not exist.
255 @[ENOENT, ENOTDIR]@
256
257 * 'isPermissionError' \/ 'PermissionDenied'
258 The process has insufficient privileges to perform the operation.
259 @[EROFS, EACCES, EPERM]@
260
261 * 'UnsatisfiedConstraints'
262 Implementation-dependent constraints are not satisfied.
263 @[EBUSY]@
264
265 * 'InappropriateType'
266 The operand refers to an existing directory.
267 @[EPERM, EINVAL]@
268
269 -}
270
271 removeFile :: FilePath -> IO ()
272 removeFile path = do
273 withCString path $ \s ->
274 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
275
276 {- |@'renameDirectory' old new@ changes the name of an existing
277 directory from /old/ to /new/. If the /new/ directory
278 already exists, it is atomically replaced by the /old/ directory.
279 If the /new/ directory is neither the /old/ directory nor an
280 alias of the /old/ directory, it is removed as if by
281 'removeDirectory'. A conformant implementation need not support
282 renaming directories in all situations (e.g. renaming to an existing
283 directory, or across different physical devices), but the constraints
284 must be documented.
285
286 The operation may fail with:
287
288 * 'HardwareFault'
289 A physical I\/O error has occurred.
290 @[EIO]@
291
292 * 'InvalidArgument'
293 Either operand is not a valid directory name.
294 @[ENAMETOOLONG, ELOOP]@
295
296 * 'isDoesNotExistError' \/ 'NoSuchThing'
297 The original directory does not exist, or there is no path to the target.
298 @[ENOENT, ENOTDIR]@
299
300 * 'isPermissionError' \/ 'PermissionDenied'
301 The process has insufficient privileges to perform the operation.
302 @[EROFS, EACCES, EPERM]@
303
304 * 'ResourceExhausted'
305 Insufficient resources are available to perform the operation.
306 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
307
308 * 'UnsatisfiedConstraints'
309 Implementation-dependent constraints are not satisfied.
310 @[EBUSY, ENOTEMPTY, EEXIST]@
311
312 * 'UnsupportedOperation'
313 The implementation does not support renaming in this situation.
314 @[EINVAL, EXDEV]@
315
316 * 'InappropriateType'
317 Either path refers to an existing non-directory object.
318 @[ENOTDIR, EISDIR]@
319
320 -}
321
322 renameDirectory :: FilePath -> FilePath -> IO ()
323 renameDirectory opath npath =
324 withFileStatus opath $ \st -> do
325 is_dir <- isDirectory st
326 if (not is_dir)
327 then ioException (IOError Nothing InappropriateType "renameDirectory"
328 ("not a directory") (Just opath))
329 else do
330
331 withCString opath $ \s1 ->
332 withCString npath $ \s2 ->
333 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
334
335 {- |@'renameFile' old new@ changes the name of an existing file system
336 object from /old/ to /new/. If the /new/ object already
337 exists, it is atomically replaced by the /old/ object. Neither
338 path may refer to an existing directory. A conformant implementation
339 need not support renaming files in all situations (e.g. renaming
340 across different physical devices), but the constraints must be
341 documented.
342
343 The operation may fail with:
344
345 * 'HardwareFault'
346 A physical I\/O error has occurred.
347 @[EIO]@
348
349 * 'InvalidArgument'
350 Either operand is not a valid file name.
351 @[ENAMETOOLONG, ELOOP]@
352
353 * 'isDoesNotExistError' \/ 'NoSuchThing'
354 The original file does not exist, or there is no path to the target.
355 @[ENOENT, ENOTDIR]@
356
357 * 'isPermissionError' \/ 'PermissionDenied'
358 The process has insufficient privileges to perform the operation.
359 @[EROFS, EACCES, EPERM]@
360
361 * 'ResourceExhausted'
362 Insufficient resources are available to perform the operation.
363 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
364
365 * 'UnsatisfiedConstraints'
366 Implementation-dependent constraints are not satisfied.
367 @[EBUSY]@
368
369 * 'UnsupportedOperation'
370 The implementation does not support renaming in this situation.
371 @[EXDEV]@
372
373 * 'InappropriateType'
374 Either path refers to an existing directory.
375 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
376
377 -}
378
379 renameFile :: FilePath -> FilePath -> IO ()
380 renameFile opath npath =
381 withFileOrSymlinkStatus opath $ \st -> do
382 is_dir <- isDirectory st
383 if is_dir
384 then ioException (IOError Nothing InappropriateType "renameFile"
385 "is a directory" (Just opath))
386 else do
387
388 withCString opath $ \s1 ->
389 withCString npath $ \s2 ->
390 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
391
392 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
393 in /dir/.
394
395 The operation may fail with:
396
397 * 'HardwareFault'
398 A physical I\/O error has occurred.
399 @[EIO]@
400
401 * 'InvalidArgument'
402 The operand is not a valid directory name.
403 @[ENAMETOOLONG, ELOOP]@
404
405 * 'isDoesNotExistError' \/ 'NoSuchThing'
406 The directory does not exist.
407 @[ENOENT, ENOTDIR]@
408
409 * 'isPermissionError' \/ 'PermissionDenied'
410 The process has insufficient privileges to perform the operation.
411 @[EACCES]@
412
413 * 'ResourceExhausted'
414 Insufficient resources are available to perform the operation.
415 @[EMFILE, ENFILE]@
416
417 * 'InappropriateType'
418 The path refers to an existing non-directory object.
419 @[ENOTDIR]@
420
421 -}
422
423 getDirectoryContents :: FilePath -> IO [FilePath]
424 getDirectoryContents path = do
425 alloca $ \ ptr_dEnt ->
426 bracket
427 (withCString path $ \s ->
428 throwErrnoIfNullRetry desc (c_opendir s))
429 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
430 (\p -> loop ptr_dEnt p)
431 where
432 desc = "getDirectoryContents"
433
434 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
435 loop ptr_dEnt dir = do
436 resetErrno
437 r <- readdir dir ptr_dEnt
438 if (r == 0)
439 then do
440 dEnt <- peek ptr_dEnt
441 if (dEnt == nullPtr)
442 then return []
443 else do
444 entry <- (d_name dEnt >>= peekCString)
445 freeDirEnt dEnt
446 entries <- loop ptr_dEnt dir
447 return (entry:entries)
448 else do errno <- getErrno
449 if (errno == eINTR) then loop ptr_dEnt dir else do
450 let (Errno eo) = errno
451 if (eo == end_of_dir)
452 then return []
453 else throwErrno desc
454
455
456
457 {- |If the operating system has a notion of current directories,
458 'getCurrentDirectory' returns an absolute path to the
459 current directory of the calling process.
460
461 The operation may fail with:
462
463 * 'HardwareFault'
464 A physical I\/O error has occurred.
465 @[EIO]@
466
467 * 'isDoesNotExistError' \/ 'NoSuchThing'
468 There is no path referring to the current directory.
469 @[EPERM, ENOENT, ESTALE...]@
470
471 * 'isPermissionError' \/ 'PermissionDenied'
472 The process has insufficient privileges to perform the operation.
473 @[EACCES]@
474
475 * 'ResourceExhausted'
476 Insufficient resources are available to perform the operation.
477
478 * 'UnsupportedOperation'
479 The operating system has no notion of current directory.
480
481 -}
482
483 getCurrentDirectory :: IO FilePath
484 getCurrentDirectory = do
485 p <- mallocBytes path_max
486 go p path_max
487 where go p bytes = do
488 p' <- c_getcwd p (fromIntegral bytes)
489 if p' /= nullPtr
490 then do s <- peekCString p'
491 free p'
492 return s
493 else do errno <- getErrno
494 if errno == eRANGE
495 then do let bytes' = bytes * 2
496 p' <- reallocBytes p bytes'
497 go p' bytes'
498 else throwErrno "getCurrentDirectory"
499
500 {- |If the operating system has a notion of current directories,
501 @'setCurrentDirectory' dir@ changes the current
502 directory of the calling process to /dir/.
503
504 The operation may fail with:
505
506 * 'HardwareFault'
507 A physical I\/O error has occurred.
508 @[EIO]@
509
510 * 'InvalidArgument'
511 The operand is not a valid directory name.
512 @[ENAMETOOLONG, ELOOP]@
513
514 * 'isDoesNotExistError' \/ 'NoSuchThing'
515 The directory does not exist.
516 @[ENOENT, ENOTDIR]@
517
518 * 'isPermissionError' \/ 'PermissionDenied'
519 The process has insufficient privileges to perform the operation.
520 @[EACCES]@
521
522 * 'UnsupportedOperation'
523 The operating system has no notion of current directory, or the
524 current directory cannot be dynamically changed.
525
526 * 'InappropriateType'
527 The path refers to an existing non-directory object.
528 @[ENOTDIR]@
529
530 -}
531
532 setCurrentDirectory :: FilePath -> IO ()
533 setCurrentDirectory path = do
534 withCString path $ \s ->
535 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
536 -- ToDo: add path to error
537
538 {- |To clarify, 'doesDirectoryExist' returns 'True' if a file system object
539 exist, and it's a directory. 'doesFileExist' returns 'True' if the file
540 system object exist, but it's not a directory (i.e., for every other
541 file system object that is not a directory.)
542 -}
543
544 doesDirectoryExist :: FilePath -> IO Bool
545 doesDirectoryExist name =
546 catch
547 (withFileStatus name $ \st -> isDirectory st)
548 (\ _ -> return False)
549
550 doesFileExist :: FilePath -> IO Bool
551 doesFileExist name = do
552 catch
553 (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
554 (\ _ -> return False)
555
556 getModificationTime :: FilePath -> IO ClockTime
557 getModificationTime name =
558 withFileStatus name $ \ st ->
559 modificationTime st
560
561 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
562 withFileStatus name f = do
563 allocaBytes sizeof_stat $ \p ->
564 withCString (fileNameEndClean name) $ \s -> do
565 throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
566 f p
567
568 withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
569 withFileOrSymlinkStatus name f = do
570 allocaBytes sizeof_stat $ \p ->
571 withCString name $ \s -> do
572 throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
573 f p
574
575 modificationTime :: Ptr CStat -> IO ClockTime
576 modificationTime stat = do
577 mtime <- st_mtime stat
578 return (TOD (toInteger (mtime :: CTime)) 0)
579
580 isDirectory :: Ptr CStat -> IO Bool
581 isDirectory stat = do
582 mode <- st_mode stat
583 return (s_isdir mode)
584
585 fileNameEndClean :: String -> String
586 fileNameEndClean name =
587 if i >= 0 && (ec == '\\' || ec == '/') then
588 fileNameEndClean (take i name)
589 else
590 name
591 where
592 i = (length name) - 1
593 ec = name !! i
594
595 emptyCMode :: CMode
596 emptyCMode = 0
597
598 unionCMode :: CMode -> CMode -> CMode
599 unionCMode = (+)
600
601
602 foreign import ccall unsafe "__hscore_path_max"
603 path_max :: Int
604
605 foreign import ccall unsafe "__hscore_readdir"
606 readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
607
608 foreign import ccall unsafe "__hscore_free_dirent"
609 freeDirEnt :: Ptr CDirent -> IO ()
610
611 foreign import ccall unsafe "__hscore_end_of_dir"
612 end_of_dir :: CInt
613
614 foreign import ccall unsafe "__hscore_d_name"
615 d_name :: Ptr CDirent -> IO CString
616
617 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
618 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
619 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
620
621 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
622 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
623 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode