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