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