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 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
 296 exists.
 297
 298 The operation may fail with:
 299
 300 * 'HardwareFault'
 301 A physical I\/O error has occurred.
 302 @[EIO]@
 303
 304 * 'InvalidArgument'
 305 Either operand is not a valid directory name.
 306 @[ENAMETOOLONG, ELOOP]@
 307
 308 * 'isDoesNotExistError' \/ 'NoSuchThing'
 309 The original directory does not exist, or there is no path to the target.
 310 @[ENOENT, ENOTDIR]@
 311
 312 * 'isPermissionError' \/ 'PermissionDenied'
 313 The process has insufficient privileges to perform the operation.
 314 @[EROFS, EACCES, EPERM]@
 315
 316 * 'ResourceExhausted'
 317 Insufficient resources are available to perform the operation.
 318 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 319
 320 * 'UnsatisfiedConstraints'
 321 Implementation-dependent constraints are not satisfied.
 322 @[EBUSY, ENOTEMPTY, EEXIST]@
 323
 324 * 'UnsupportedOperation'
 325 The implementation does not support renaming in this situation.
 326 @[EINVAL, EXDEV]@
 327
 328 * 'InappropriateType'
 329 Either path refers to an existing non-directory object.
 330 @[ENOTDIR, EISDIR]@
 331
 332 -}
 333
 334 renameDirectory :: FilePath -> FilePath -> IO ()
 335 renameDirectory opath npath =
 336    withFileStatus opath $ \st -> do
 337    is_dir <- isDirectory st
 338    if (not is_dir)
 339         then ioException (IOError Nothing InappropriateType "renameDirectory"
 340                             ("not a directory") (Just opath))
 341         else do
 342
 343    withCString opath $ \s1 ->
 344      withCString npath $ \s2 ->
 345         throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
 346
 347 {- |@'renameFile' old new@ changes the name of an existing file system
 348 object from /old/ to /new/.  If the /new/ object already
 349 exists, it is atomically replaced by the /old/ object.  Neither
 350 path may refer to an existing directory.  A conformant implementation
 351 need not support renaming files in all situations (e.g. renaming
 352 across different physical devices), but the constraints must be
 353 documented.
 354
 355 The operation may fail with:
 356
 357 * 'HardwareFault'
 358 A physical I\/O error has occurred.
 359 @[EIO]@
 360
 361 * 'InvalidArgument'
 362 Either operand is not a valid file name.
 363 @[ENAMETOOLONG, ELOOP]@
 364
 365 * 'isDoesNotExistError' \/ 'NoSuchThing'
 366 The original file does not exist, or there is no path to the target.
 367 @[ENOENT, ENOTDIR]@
 368
 369 * 'isPermissionError' \/ 'PermissionDenied'
 370 The process has insufficient privileges to perform the operation.
 371 @[EROFS, EACCES, EPERM]@
 372
 373 * 'ResourceExhausted'
 374 Insufficient resources are available to perform the operation.
 375 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 376
 377 * 'UnsatisfiedConstraints'
 378 Implementation-dependent constraints are not satisfied.
 379 @[EBUSY]@
 380
 381 * 'UnsupportedOperation'
 382 The implementation does not support renaming in this situation.
 383 @[EXDEV]@
 384
 385 * 'InappropriateType'
 386 Either path refers to an existing directory.
 387 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 388
 389 -}
 390
 391 renameFile :: FilePath -> FilePath -> IO ()
 392 renameFile opath npath =
 393    withFileOrSymlinkStatus opath $ \st -> do
 394    is_dir <- isDirectory st
 395    if is_dir
 396         then ioException (IOError Nothing InappropriateType "renameFile"
 397                            "is a directory" (Just opath))
 398         else do
 399
 400     withCString opath $ \s1 ->
 401       withCString npath $ \s2 ->
 402          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 403
 404 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 405 in /dir/.
 406
 407 The operation may fail with:
 408
 409 * 'HardwareFault'
 410 A physical I\/O error has occurred.
 411 @[EIO]@
 412
 413 * 'InvalidArgument'
 414 The operand is not a valid directory name.
 415 @[ENAMETOOLONG, ELOOP]@
 416
 417 * 'isDoesNotExistError' \/ 'NoSuchThing'
 418 The directory does not exist.
 419 @[ENOENT, ENOTDIR]@
 420
 421 * 'isPermissionError' \/ 'PermissionDenied'
 422 The process has insufficient privileges to perform the operation.
 423 @[EACCES]@
 424
 425 * 'ResourceExhausted'
 426 Insufficient resources are available to perform the operation.
 427 @[EMFILE, ENFILE]@
 428
 429 * 'InappropriateType'
 430 The path refers to an existing non-directory object.
 431 @[ENOTDIR]@
 432
 433 -}
 434
 435 getDirectoryContents :: FilePath -> IO [FilePath]
 436 getDirectoryContents path = do
 437   modifyIOError (`ioeSetFileName` path) $
 438    alloca $ \ ptr_dEnt ->
 439      bracket
 440         (withCString path $ \s ->
 441            throwErrnoIfNullRetry desc (c_opendir s))
 442         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 443         (\p -> loop ptr_dEnt p)
 444   where
 445     desc = "getDirectoryContents"
 446
 447     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 448     loop ptr_dEnt dir = do
 449       resetErrno
 450       r <- readdir dir ptr_dEnt
 451       if (r == 0)
 452          then do
 453                  dEnt    <- peek ptr_dEnt
 454                  if (dEnt == nullPtr)
 455                    then return []
 456                    else do
 457                     entry   <- (d_name dEnt >>= peekCString)
 458                     freeDirEnt dEnt
 459                     entries <- loop ptr_dEnt dir
 460                     return (entry:entries)
 461          else do errno <- getErrno
 462                  if (errno == eINTR) then loop ptr_dEnt dir else do
 463                  let (Errno eo) = errno
 464                  if (eo == end_of_dir)
 465                     then return []
 466                     else throwErrno desc
 467
 468
 469
 470 {- |If the operating system has a notion of current directories,
 471 'getCurrentDirectory' returns an absolute path to the
 472 current directory of the calling process.
 473
 474 The operation may fail with:
 475
 476 * 'HardwareFault'
 477 A physical I\/O error has occurred.
 478 @[EIO]@
 479
 480 * 'isDoesNotExistError' \/ 'NoSuchThing'
 481 There is no path referring to the current directory.
 482 @[EPERM, ENOENT, ESTALE...]@
 483
 484 * 'isPermissionError' \/ 'PermissionDenied'
 485 The process has insufficient privileges to perform the operation.
 486 @[EACCES]@
 487
 488 * 'ResourceExhausted'
 489 Insufficient resources are available to perform the operation.
 490
 491 * 'UnsupportedOperation'
 492 The operating system has no notion of current directory.
 493
 494 -}
 495
 496 getCurrentDirectory :: IO FilePath
 497 getCurrentDirectory = do
 498   p <- mallocBytes path_max
 499   go p path_max
 500   where go p bytes = do
 501           p' <- c_getcwd p (fromIntegral bytes)
 502           if p' /= nullPtr
 503              then do s <- peekCString p'
 504                      free p'
 505                      return s
 506              else do errno <- getErrno
 507                      if errno == eRANGE
 508                         then do let bytes' = bytes * 2
 509                                 p' <- reallocBytes p bytes'
 510                                 go p' bytes'
 511                         else throwErrno "getCurrentDirectory"
 512
 513 {- |If the operating system has a notion of current directories,
 514 @'setCurrentDirectory' dir@ changes the current
 515 directory of the calling process to /dir/.
 516
 517 The operation may fail with:
 518
 519 * 'HardwareFault'
 520 A physical I\/O error has occurred.
 521 @[EIO]@
 522
 523 * 'InvalidArgument'
 524 The operand is not a valid directory name.
 525 @[ENAMETOOLONG, ELOOP]@
 526
 527 * 'isDoesNotExistError' \/ 'NoSuchThing'
 528 The directory does not exist.
 529 @[ENOENT, ENOTDIR]@
 530
 531 * 'isPermissionError' \/ 'PermissionDenied'
 532 The process has insufficient privileges to perform the operation.
 533 @[EACCES]@
 534
 535 * 'UnsupportedOperation'
 536 The operating system has no notion of current directory, or the
 537 current directory cannot be dynamically changed.
 538
 539 * 'InappropriateType'
 540 The path refers to an existing non-directory object.
 541 @[ENOTDIR]@
 542
 543 -}
 544
 545 setCurrentDirectory :: FilePath -> IO ()
 546 setCurrentDirectory path = do
 547   modifyIOError (`ioeSetFileName` path) $
 548     withCString path $ \s ->
 549        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
 550         -- ToDo: add path to error
 551
 552 {- |To clarify, 'doesDirectoryExist' returns 'True' if a file system object
 553 exist, and it's a directory. 'doesFileExist' returns 'True' if the file
 554 system object exist, but it's not a directory (i.e., for every other
 555 file system object that is not a directory.)
 556 -}
 557
 558 doesDirectoryExist :: FilePath -> IO Bool
 559 doesDirectoryExist name =
 560  catch
 561    (withFileStatus name $ \st -> isDirectory st)
 562    (\ _ -> return False)
 563
 564 doesFileExist :: FilePath -> IO Bool
 565 doesFileExist name = do
 566  catch
 567    (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
 568    (\ _ -> return False)
 569
 570 getModificationTime :: FilePath -> IO ClockTime
 571 getModificationTime name =
 572  withFileStatus name $ \ st ->
 573  modificationTime st
 574
 575 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 576 withFileStatus name f = do
 577   modifyIOError (`ioeSetFileName` name) $
 578     allocaBytes sizeof_stat $ \p ->
 579       withCString (fileNameEndClean name) $ \s -> do
 580         throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
 581         f p
 582
 583 withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 584 withFileOrSymlinkStatus name f = do
 585   modifyIOError (`ioeSetFileName` name) $
 586     allocaBytes sizeof_stat $ \p ->
 587       withCString name $ \s -> do
 588         throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
 589         f p
 590
 591 modificationTime :: Ptr CStat -> IO ClockTime
 592 modificationTime stat = do
 593     mtime <- st_mtime stat
 594     return (TOD (toInteger (mtime :: CTime)) 0)
 595
 596 isDirectory :: Ptr CStat -> IO Bool
 597 isDirectory stat = do
 598   mode <- st_mode stat
 599   return (s_isdir mode)
 600
 601 fileNameEndClean :: String -> String
 602 fileNameEndClean name =
 603   if i >= 0 && (ec == '\\' || ec == '/') then
 604      fileNameEndClean (take i name)
 605    else
 606      name
 607   where
 608       i  = (length name) - 1
 609       ec = name !! i
 610
 611 emptyCMode     :: CMode
 612 emptyCMode     = 0
 613
 614 unionCMode     :: CMode -> CMode -> CMode
 615 unionCMode     = (+)
 616
 617
 618 foreign import ccall unsafe "__hscore_path_max"
 619   path_max :: Int
 620
 621 foreign import ccall unsafe "__hscore_readdir"
 622   readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
 623
 624 foreign import ccall unsafe "__hscore_free_dirent"
 625   freeDirEnt  :: Ptr CDirent -> IO ()
 626
 627 foreign import ccall unsafe "__hscore_end_of_dir"
 628   end_of_dir :: CInt
 629
 630 foreign import ccall unsafe "__hscore_d_name"
 631   d_name :: Ptr CDirent -> IO CString
 632
 633 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 634 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
 635 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
 636
 637 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 638 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 639 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 640
 641 #endif