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