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     -- * 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.Time             ( ClockTime(..) )
  67 import System.IO
  68 import System.IO.Error
  69 import Foreign
  70 import Foreign.C
  71
  72 #ifdef __GLASGOW_HASKELL__
  73 import System.Posix.Internals
  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     let
 165      read  = if r      then s_IRUSR else emptyCMode
 166      write = if w      then s_IWUSR else emptyCMode
 167      exec  = if e || s then s_IXUSR else emptyCMode
 168
 169      mode  = read `unionCMode` (write `unionCMode` exec)
 170
 171     withCString name $ \s ->
 172       throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
 173
 174 -----------------------------------------------------------------------------
 175 -- Implementation
 176
 177 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
 178 initially empty, or as near to empty as the operating system
 179 allows.
 180
 181 The operation may fail with:
 182
 183 * 'isPermissionError' \/ 'PermissionDenied'
 184 The process has insufficient privileges to perform the operation.
 185 @[EROFS, EACCES]@
 186
 187 * 'isAlreadyExistsError' \/ 'AlreadyExists'
 188 The operand refers to a directory that already exists.
 189 @ [EEXIST]@
 190
 191 * 'HardwareFault'
 192 A physical I\/O error has occurred.
 193 @[EIO]@
 194
 195 * 'InvalidArgument'
 196 The operand is not a valid directory name.
 197 @[ENAMETOOLONG, ELOOP]@
 198
 199 * 'NoSuchThing'
 200 There is no path to the directory.
 201 @[ENOENT, ENOTDIR]@
 202
 203 * 'ResourceExhausted'
 204 Insufficient resources (virtual memory, process file descriptors,
 205 physical disk space, etc.) are available to perform the operation.
 206 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 207
 208 * 'InappropriateType'
 209 The path refers to an existing non-directory object.
 210 @[EEXIST]@
 211
 212 -}
 213
 214 createDirectory :: FilePath -> IO ()
 215 createDirectory path = do
 216     withCString path $ \s -> do
 217       throwErrnoIfMinus1Retry_ "createDirectory" $
 218         mkdir s 0o777
 219
 220 {- | @'removeDirectory' dir@ removes an existing directory /dir/.  The
 221 implementation may specify additional constraints which must be
 222 satisfied before a directory can be removed (e.g. the directory has to
 223 be empty, or may not be in use by other processes).  It is not legal
 224 for an implementation to partially remove a directory unless the
 225 entire directory is removed. A conformant implementation need not
 226 support directory removal in all situations (e.g. removal of the root
 227 directory).
 228
 229 The operation may fail with:
 230
 231 * 'HardwareFault'
 232 A physical I\/O error has occurred.
 233 EIO
 234
 235 * 'InvalidArgument'
 236 The operand is not a valid directory name.
 237 [ENAMETOOLONG, ELOOP]
 238
 239 * 'isDoesNotExist'  'NoSuchThing'
 240 The directory does not exist.
 241 @[ENOENT, ENOTDIR]@
 242
 243 * 'isPermissionError' \/ 'PermissionDenied'
 244 The process has insufficient privileges to perform the operation.
 245 @[EROFS, EACCES, EPERM]@
 246
 247 * 'UnsatisfiedConstraints'
 248 Implementation-dependent constraints are not satisfied.
 249 @[EBUSY, ENOTEMPTY, EEXIST]@
 250
 251 * 'UnsupportedOperation'
 252 The implementation does not support removal in this situation.
 253 @[EINVAL]@
 254
 255 * 'InappropriateType'
 256 The operand refers to an existing non-directory object.
 257 @[ENOTDIR]@
 258
 259 -}
 260
 261 removeDirectory :: FilePath -> IO ()
 262 removeDirectory path = do
 263   modifyIOError (`ioeSetFileName` path) $
 264     withCString path $ \s ->
 265        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
 266
 267 {- |@'removefile' file@ removes the directory entry for an existing file
 268 /file/, where /file/ is not itself a directory. The
 269 implementation may specify additional constraints which must be
 270 satisfied before a file can be removed (e.g. the file may not be in
 271 use by other processes).
 272
 273 The operation may fail with:
 274
 275 * 'HardwareFault'
 276 A physical I\/O error has occurred.
 277 'EIO'
 278
 279 * 'InvalidArgument'
 280 The operand is not a valid file name.
 281 @[ENAMETOOLONG, ELOOP]@
 282
 283 * 'isDoesNotExist' \/ 'NoSuchThing'
 284 The file does not exist.
 285 @[ENOENT, ENOTDIR]@
 286
 287 * 'isPermissionError' \/ 'PermissionDenied'
 288 The process has insufficient privileges to perform the operation.
 289 @[EROFS, EACCES, EPERM]@
 290
 291 * 'UnsatisfiedConstraints'
 292 Implementation-dependent constraints are not satisfied.
 293 @[EBUSY]@
 294
 295 * 'InappropriateType'
 296 The operand refers to an existing directory.
 297 @[EPERM, EINVAL]@
 298
 299 -}
 300
 301 removeFile :: FilePath -> IO ()
 302 removeFile path = do
 303   modifyIOError (`ioeSetFileName` path) $
 304     withCString path $ \s ->
 305       throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
 306
 307 {- |@'renameDirectory' old new@ changes the name of an existing
 308 directory from /old/ to /new/.  If the /new/ directory
 309 already exists, it is atomically replaced by the /old/ directory.
 310 If the /new/ directory is neither the /old/ directory nor an
 311 alias of the /old/ directory, it is removed as if by
 312 'removeDirectory'.  A conformant implementation need not support
 313 renaming directories in all situations (e.g. renaming to an existing
 314 directory, or across different physical devices), but the constraints
 315 must be documented.
 316
 317 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
 318 exists.
 319
 320 The operation may fail with:
 321
 322 * 'HardwareFault'
 323 A physical I\/O error has occurred.
 324 @[EIO]@
 325
 326 * 'InvalidArgument'
 327 Either operand is not a valid directory name.
 328 @[ENAMETOOLONG, ELOOP]@
 329
 330 * 'isDoesNotExistError' \/ 'NoSuchThing'
 331 The original directory does not exist, or there is no path to the target.
 332 @[ENOENT, ENOTDIR]@
 333
 334 * 'isPermissionError' \/ 'PermissionDenied'
 335 The process has insufficient privileges to perform the operation.
 336 @[EROFS, EACCES, EPERM]@
 337
 338 * 'ResourceExhausted'
 339 Insufficient resources are available to perform the operation.
 340 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 341
 342 * 'UnsatisfiedConstraints'
 343 Implementation-dependent constraints are not satisfied.
 344 @[EBUSY, ENOTEMPTY, EEXIST]@
 345
 346 * 'UnsupportedOperation'
 347 The implementation does not support renaming in this situation.
 348 @[EINVAL, EXDEV]@
 349
 350 * 'InappropriateType'
 351 Either path refers to an existing non-directory object.
 352 @[ENOTDIR, EISDIR]@
 353
 354 -}
 355
 356 renameDirectory :: FilePath -> FilePath -> IO ()
 357 renameDirectory opath npath =
 358    withFileStatus "renameDirectory" opath $ \st -> do
 359    is_dir <- isDirectory st
 360    if (not is_dir)
 361         then ioException (IOError Nothing InappropriateType "renameDirectory"
 362                             ("not a directory") (Just opath))
 363         else do
 364
 365    withCString opath $ \s1 ->
 366      withCString npath $ \s2 ->
 367         throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
 368
 369 {- |@'renameFile' old new@ changes the name of an existing file system
 370 object from /old/ to /new/.  If the /new/ object already
 371 exists, it is atomically replaced by the /old/ object.  Neither
 372 path may refer to an existing directory.  A conformant implementation
 373 need not support renaming files in all situations (e.g. renaming
 374 across different physical devices), but the constraints must be
 375 documented.
 376
 377 The operation may fail with:
 378
 379 * 'HardwareFault'
 380 A physical I\/O error has occurred.
 381 @[EIO]@
 382
 383 * 'InvalidArgument'
 384 Either operand is not a valid file name.
 385 @[ENAMETOOLONG, ELOOP]@
 386
 387 * 'isDoesNotExistError' \/ 'NoSuchThing'
 388 The original file does not exist, or there is no path to the target.
 389 @[ENOENT, ENOTDIR]@
 390
 391 * 'isPermissionError' \/ 'PermissionDenied'
 392 The process has insufficient privileges to perform the operation.
 393 @[EROFS, EACCES, EPERM]@
 394
 395 * 'ResourceExhausted'
 396 Insufficient resources are available to perform the operation.
 397 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 398
 399 * 'UnsatisfiedConstraints'
 400 Implementation-dependent constraints are not satisfied.
 401 @[EBUSY]@
 402
 403 * 'UnsupportedOperation'
 404 The implementation does not support renaming in this situation.
 405 @[EXDEV]@
 406
 407 * 'InappropriateType'
 408 Either path refers to an existing directory.
 409 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 410
 411 -}
 412
 413 renameFile :: FilePath -> FilePath -> IO ()
 414 renameFile opath npath =
 415    withFileOrSymlinkStatus "renameFile" opath $ \st -> do
 416    is_dir <- isDirectory st
 417    if is_dir
 418         then ioException (IOError Nothing InappropriateType "renameFile"
 419                            "is a directory" (Just opath))
 420         else do
 421
 422     withCString opath $ \s1 ->
 423       withCString npath $ \s2 ->
 424          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 425
 426 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 427 in /dir/.
 428
 429 The operation may fail with:
 430
 431 * 'HardwareFault'
 432 A physical I\/O error has occurred.
 433 @[EIO]@
 434
 435 * 'InvalidArgument'
 436 The operand is not a valid directory name.
 437 @[ENAMETOOLONG, ELOOP]@
 438
 439 * 'isDoesNotExistError' \/ 'NoSuchThing'
 440 The directory does not exist.
 441 @[ENOENT, ENOTDIR]@
 442
 443 * 'isPermissionError' \/ 'PermissionDenied'
 444 The process has insufficient privileges to perform the operation.
 445 @[EACCES]@
 446
 447 * 'ResourceExhausted'
 448 Insufficient resources are available to perform the operation.
 449 @[EMFILE, ENFILE]@
 450
 451 * 'InappropriateType'
 452 The path refers to an existing non-directory object.
 453 @[ENOTDIR]@
 454
 455 -}
 456
 457 getDirectoryContents :: FilePath -> IO [FilePath]
 458 getDirectoryContents path = do
 459   modifyIOError (`ioeSetFileName` path) $
 460    alloca $ \ ptr_dEnt ->
 461      bracket
 462         (withCString path $ \s ->
 463            throwErrnoIfNullRetry desc (c_opendir s))
 464         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 465         (\p -> loop ptr_dEnt p)
 466   where
 467     desc = "getDirectoryContents"
 468
 469     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 470     loop ptr_dEnt dir = do
 471       resetErrno
 472       r <- readdir dir ptr_dEnt
 473       if (r == 0)
 474          then do
 475                  dEnt    <- peek ptr_dEnt
 476                  if (dEnt == nullPtr)
 477                    then return []
 478                    else do
 479                     entry   <- (d_name dEnt >>= peekCString)
 480                     freeDirEnt dEnt
 481                     entries <- loop ptr_dEnt dir
 482                     return (entry:entries)
 483          else do errno <- getErrno
 484                  if (errno == eINTR) then loop ptr_dEnt dir else do
 485                  let (Errno eo) = errno
 486                  if (eo == end_of_dir)
 487                     then return []
 488                     else throwErrno desc
 489
 490
 491
 492 {- |If the operating system has a notion of current directories,
 493 'getCurrentDirectory' returns an absolute path to the
 494 current directory of the calling process.
 495
 496 The operation may fail with:
 497
 498 * 'HardwareFault'
 499 A physical I\/O error has occurred.
 500 @[EIO]@
 501
 502 * 'isDoesNotExistError' \/ 'NoSuchThing'
 503 There is no path referring to the current directory.
 504 @[EPERM, ENOENT, ESTALE...]@
 505
 506 * 'isPermissionError' \/ 'PermissionDenied'
 507 The process has insufficient privileges to perform the operation.
 508 @[EACCES]@
 509
 510 * 'ResourceExhausted'
 511 Insufficient resources are available to perform the operation.
 512
 513 * 'UnsupportedOperation'
 514 The operating system has no notion of current directory.
 515
 516 -}
 517
 518 getCurrentDirectory :: IO FilePath
 519 getCurrentDirectory = do
 520   p <- mallocBytes path_max
 521   go p path_max
 522   where go p bytes = do
 523           p' <- c_getcwd p (fromIntegral bytes)
 524           if p' /= nullPtr
 525              then do s <- peekCString p'
 526                      free p'
 527                      return s
 528              else do errno <- getErrno
 529                      if errno == eRANGE
 530                         then do let bytes' = bytes * 2
 531                                 p' <- reallocBytes p bytes'
 532                                 go p' bytes'
 533                         else throwErrno "getCurrentDirectory"
 534
 535 {- |If the operating system has a notion of current directories,
 536 @'setCurrentDirectory' dir@ changes the current
 537 directory of the calling process to /dir/.
 538
 539 The operation may fail with:
 540
 541 * 'HardwareFault'
 542 A physical I\/O error has occurred.
 543 @[EIO]@
 544
 545 * 'InvalidArgument'
 546 The operand is not a valid directory name.
 547 @[ENAMETOOLONG, ELOOP]@
 548
 549 * 'isDoesNotExistError' \/ 'NoSuchThing'
 550 The directory does not exist.
 551 @[ENOENT, ENOTDIR]@
 552
 553 * 'isPermissionError' \/ 'PermissionDenied'
 554 The process has insufficient privileges to perform the operation.
 555 @[EACCES]@
 556
 557 * 'UnsupportedOperation'
 558 The operating system has no notion of current directory, or the
 559 current directory cannot be dynamically changed.
 560
 561 * 'InappropriateType'
 562 The path refers to an existing non-directory object.
 563 @[ENOTDIR]@
 564
 565 -}
 566
 567 setCurrentDirectory :: FilePath -> IO ()
 568 setCurrentDirectory path = do
 569   modifyIOError (`ioeSetFileName` path) $
 570     withCString path $ \s ->
 571        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
 572         -- ToDo: add path to error
 573
 574 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 575 exists and is a directory, and 'False' otherwise.
 576 -}
 577
 578 doesDirectoryExist :: FilePath -> IO Bool
 579 doesDirectoryExist name =
 580  catch
 581    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 582    (\ _ -> return False)
 583
 584 {- |The operation 'doesFileExist' returns 'True'
 585 if the argument file exists and is not a directory, and 'False' otherwise.
 586 -}
 587
 588 doesFileExist :: FilePath -> IO Bool
 589 doesFileExist name = do
 590  catch
 591    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 592    (\ _ -> return False)
 593
 594 {- |The 'getModificationTime' operation returns the
 595 clock time at which the file or directory was last modified.
 596
 597 The operation may fail with:
 598
 599 * 'isPermissionError' if the user is not permitted to access
 600   the modification time; or
 601
 602 * 'isDoesNotExistError' if the file or directory does not exist.
 603
 604 -}
 605
 606 getModificationTime :: FilePath -> IO ClockTime
 607 getModificationTime name =
 608  withFileStatus "getModificationTime" name $ \ st ->
 609  modificationTime st
 610
 611 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 612 withFileStatus loc name f = do
 613   modifyIOError (`ioeSetFileName` name) $
 614     allocaBytes sizeof_stat $ \p ->
 615       withCString (fileNameEndClean name) $ \s -> do
 616         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 617         f p
 618
 619 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 620 withFileOrSymlinkStatus loc name f = do
 621   modifyIOError (`ioeSetFileName` name) $
 622     allocaBytes sizeof_stat $ \p ->
 623       withCString name $ \s -> do
 624         throwErrnoIfMinus1Retry_ loc (lstat s p)
 625         f p
 626
 627 modificationTime :: Ptr CStat -> IO ClockTime
 628 modificationTime stat = do
 629     mtime <- st_mtime stat
 630     return (TOD (toInteger (mtime :: CTime)) 0)
 631
 632 isDirectory :: Ptr CStat -> IO Bool
 633 isDirectory stat = do
 634   mode <- st_mode stat
 635   return (s_isdir mode)
 636
 637 fileNameEndClean :: String -> String
 638 fileNameEndClean name =
 639   if i >= 0 && (ec == '\\' || ec == '/') then
 640      fileNameEndClean (take i name)
 641    else
 642      name
 643   where
 644       i  = (length name) - 1
 645       ec = name !! i
 646
 647 emptyCMode     :: CMode
 648 emptyCMode     = 0
 649
 650 unionCMode     :: CMode -> CMode -> CMode
 651 unionCMode     = (+)
 652
 653
 654 foreign import ccall unsafe "__hscore_path_max"
 655   path_max :: Int
 656
 657 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 658 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
 659 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
 660
 661 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 662 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 663 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 664
 665 #endif