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