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