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