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