System/IO/Directory.hsc

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Module      :  System.IO.Directory
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  provisional
   9 -- Portability :  portable
  10 --
  11 -- $Id: Directory.hsc,v 1.2 2001/07/03 11:37:51 simonmar Exp $
  12 --
  13 -- System-independent interface to directory manipulation.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 {-
  18 A directory contains a series of entries, each of which is a named
  19 reference to a file system object (file, directory etc.).  Some
  20 entries may be hidden, inaccessible, or have some administrative
  21 function (e.g. "." or ".." under POSIX), but in this standard all such
  22 entries are considered to form part of the directory contents.
  23 Entries in sub-directories are not, however, considered to form part
  24 of the directory contents.
  25
  26 Each file system object is referenced by a {\em path}.  There is
  27 normally at least one absolute path to each file system object.  In
  28 some operating systems, it may also be possible to have paths which
  29 are relative to the current directory.
  30 -}
  31
  32 module System.IO.Directory
  33    (
  34       Permissions(
  35         Permissions,
  36         readable,               -- :: Permissions -> Bool
  37         writable,               -- :: Permissions -> Bool
  38         executable,             -- :: Permissions -> Bool
  39         searchable              -- :: Permissions -> Bool
  40      ),
  41
  42     , createDirectory           -- :: FilePath -> IO ()
  43     , removeDirectory           -- :: FilePath -> IO ()
  44     , renameDirectory           -- :: FilePath -> FilePath -> IO ()
  45
  46     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
  47     , getCurrentDirectory       -- :: IO FilePath
  48     , setCurrentDirectory       -- :: FilePath -> IO ()
  49
  50     , removeFile                -- :: FilePath -> IO ()
  51     , renameFile                -- :: FilePath -> FilePath -> IO ()
  52
  53     , doesFileExist             -- :: FilePath -> IO Bool
  54     , doesDirectoryExist        -- :: FilePath -> IO Bool
  55
  56     , getPermissions            -- :: FilePath -> IO Permissions
  57     , setPermissions            -- :: FilePath -> Permissions -> IO ()
  58
  59     , getModificationTime       -- :: FilePath -> IO ClockTime
  60    ) where
  61
  62 import Prelude
  63
  64 import System.Time             ( ClockTime(..) )
  65 import System.IO
  66 import Foreign
  67 import Foreign.C
  68
  69 #ifdef __GLASGOW_HASKELL__
  70 import GHC.Posix
  71 import GHC.IOBase       ( IOException(..), IOErrorType(..), ioException )
  72 #endif
  73
  74 -- to get config.h
  75 #include "HsCore.h"
  76
  77 #include <sys/stat.h>
  78 #include <dirent.h>
  79 #include <limits.h>
  80 #include <errno.h>
  81 #include <unistd.h>
  82
  83 -----------------------------------------------------------------------------
  84 -- Permissions
  85
  86 -- The Permissions type is used to record whether certain
  87 -- operations are permissible on a file/directory:
  88 -- [to whom? - presumably the "current user"]
  89
  90 data Permissions
  91  = Permissions {
  92     readable,   writable,
  93     executable, searchable :: Bool
  94    } deriving (Eq, Ord, Read, Show)
  95
  96 -----------------------------------------------------------------------------
  97 -- Implementation
  98
  99 -- `createDirectory dir' creates a new directory dir which is
 100 -- initially empty, or as near to empty as the operating system
 101 -- allows.
 102
 103 -- The operation may fail with:
 104
 105 {-
 106 \begin{itemize}
 107 \item @isPermissionError@ / @PermissionDenied@
 108 The process has insufficient privileges to perform the operation.
 109 @[EROFS, EACCES]@
 110 \item @isAlreadyExistsError@ / @AlreadyExists@
 111 The operand refers to a directory that already exists.
 112 @ [EEXIST]@
 113 \item @HardwareFault@
 114 A physical I/O error has occurred.
 115 @ [EIO]@
 116 \item @InvalidArgument@
 117 The operand is not a valid directory name.
 118 @[ENAMETOOLONG, ELOOP]@
 119 \item @NoSuchThing@
 120 There is no path to the directory.
 121 @[ENOENT, ENOTDIR]@
 122 \item @ResourceExhausted@
 123 Insufficient resources (virtual memory, process file descriptors,
 124 physical disk space, etc.) are available to perform the operation.
 125 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 126 \item @InappropriateType@
 127 The path refers to an existing non-directory object.
 128 @[EEXIST]@
 129 \end{itemize}
 130 -}
 131
 132 createDirectory :: FilePath -> IO ()
 133 createDirectory path = do
 134     withUnsafeCString path $ \s -> do
 135       throwErrnoIfMinus1Retry_ "createDirectory" $
 136 #if defined(mingw32_TARGET_OS)
 137         mkdir s
 138 #else
 139         mkdir s 0o777
 140 #endif
 141
 142 {-
 143 @removeDirectory dir@ removes an existing directory {\em dir}.  The
 144 implementation may specify additional constraints which must be
 145 satisfied before a directory can be removed (e.g. the directory has to
 146 be empty, or may not be in use by other processes).  It is not legal
 147 for an implementation to partially remove a directory unless the
 148 entire directory is removed. A conformant implementation need not
 149 support directory removal in all situations (e.g. removal of the root
 150 directory).
 151
 152 The operation may fail with:
 153 \begin{itemize}
 154 \item @HardwareFault@
 155 A physical I/O error has occurred.
 156 [@EIO@]
 157 \item @InvalidArgument@
 158 The operand is not a valid directory name.
 159 @[ENAMETOOLONG, ELOOP]@
 160 \item @isDoesNotExist@ / @NoSuchThing@
 161 The directory does not exist.
 162 @[ENOENT, ENOTDIR]@
 163 \item @isPermissionError@ / @PermissionDenied@
 164 The process has insufficient privileges to perform the operation.
 165 @[EROFS, EACCES, EPERM]@
 166 \item @UnsatisfiedConstraints@
 167 Implementation-dependent constraints are not satisfied.
 168 @[EBUSY, ENOTEMPTY, EEXIST]@
 169 \item @UnsupportedOperation@
 170 The implementation does not support removal in this situation.
 171 @[EINVAL]@
 172 \item @InappropriateType@
 173 The operand refers to an existing non-directory object.
 174 @[ENOTDIR]@
 175 \end{itemize}
 176 -}
 177
 178 removeDirectory :: FilePath -> IO ()
 179 removeDirectory path = do
 180     withUnsafeCString path $ \s ->
 181        throwErrnoIfMinus1Retry_ "removeDirectory" (rmdir s)
 182
 183 {-
 184 @Removefile file@ removes the directory entry for an existing file
 185 {\em file}, where {\em file} is not itself a directory. The
 186 implementation may specify additional constraints which must be
 187 satisfied before a file can be removed (e.g. the file may not be in
 188 use by other processes).
 189
 190 The operation may fail with:
 191 \begin{itemize}
 192 \item @HardwareFault@
 193 A physical I/O error has occurred.
 194 @[EIO]@
 195 \item @InvalidArgument@
 196 The operand is not a valid file name.
 197 @[ENAMETOOLONG, ELOOP]@
 198 \item @isDoesNotExist@ / @NoSuchThing@
 199 The file does not exist.
 200 @[ENOENT, ENOTDIR]@
 201 \item @isPermissionError@ / @PermissionDenied@
 202 The process has insufficient privileges to perform the operation.
 203 @[EROFS, EACCES, EPERM]@
 204 \item @UnsatisfiedConstraints@
 205 Implementation-dependent constraints are not satisfied.
 206 @[EBUSY]@
 207 \item @InappropriateType@
 208 The operand refers to an existing directory.
 209 @[EPERM, EINVAL]@
 210 \end{itemize}
 211 -}
 212
 213 removeFile :: FilePath -> IO ()
 214 removeFile path = do
 215     withUnsafeCString path $ \s ->
 216       throwErrnoIfMinus1Retry_ "removeFile" (unlink s)
 217
 218 {-
 219 @renameDirectory@ {\em old} {\em new} changes the name of an existing
 220 directory from {\em old} to {\em new}.  If the {\em new} directory
 221 already exists, it is atomically replaced by the {\em old} directory.
 222 If the {\em new} directory is neither the {\em old} directory nor an
 223 alias of the {\em old} directory, it is removed as if by
 224 $removeDirectory$.  A conformant implementation need not support
 225 renaming directories in all situations (e.g. renaming to an existing
 226 directory, or across different physical devices), but the constraints
 227 must be documented.
 228
 229 The operation may fail with:
 230 \begin{itemize}
 231 \item @HardwareFault@
 232 A physical I/O error has occurred.
 233 @[EIO]@
 234 \item @InvalidArgument@
 235 Either operand is not a valid directory name.
 236 @[ENAMETOOLONG, ELOOP]@
 237 \item @isDoesNotExistError@ / @NoSuchThing@
 238 The original directory does not exist, or there is no path to the target.
 239 @[ENOENT, ENOTDIR]@
 240 \item @isPermissionError@ / @PermissionDenied@
 241 The process has insufficient privileges to perform the operation.
 242 @[EROFS, EACCES, EPERM]@
 243 \item @ResourceExhausted@
 244 Insufficient resources are available to perform the operation.
 245 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 246 \item @UnsatisfiedConstraints@
 247 Implementation-dependent constraints are not satisfied.
 248 @[EBUSY, ENOTEMPTY, EEXIST]@
 249 \item @UnsupportedOperation@
 250 The implementation does not support renaming in this situation.
 251 @[EINVAL, EXDEV]@
 252 \item @InappropriateType@
 253 Either path refers to an existing non-directory object.
 254 @[ENOTDIR, EISDIR]@
 255 \end{itemize}
 256 -}
 257
 258 renameDirectory :: FilePath -> FilePath -> IO ()
 259 renameDirectory opath npath =
 260    withFileStatus opath $ \st -> do
 261    is_dir <- isDirectory st
 262    if (not is_dir)
 263         then ioException (IOError Nothing InappropriateType "renameDirectory"
 264                             ("not a directory") (Just opath))
 265         else do
 266
 267    withUnsafeCString opath $ \s1 ->
 268      withUnsafeCString npath $ \s2 ->
 269         throwErrnoIfMinus1Retry_ "renameDirectory" (rename s1 s2)
 270
 271 {-
 272 @renameFile@ {\em old} {\em new} changes the name of an existing file system
 273 object from {\em old} to {\em new}.  If the {\em new} object already
 274 exists, it is atomically replaced by the {\em old} object.  Neither
 275 path may refer to an existing directory.  A conformant implementation
 276 need not support renaming files in all situations (e.g. renaming
 277 across different physical devices), but the constraints must be
 278 documented.
 279
 280 The operation may fail with:
 281 \begin{itemize}
 282 \item @HardwareFault@
 283 A physical I/O error has occurred.
 284 @[EIO]@
 285 \item @InvalidArgument@
 286 Either operand is not a valid file name.
 287 @[ENAMETOOLONG, ELOOP]@
 288 \item @isDoesNotExistError@ / @NoSuchThing@
 289 The original file does not exist, or there is no path to the target.
 290 @[ENOENT, ENOTDIR]@
 291 \item @isPermissionError@ / @PermissionDenied@
 292 The process has insufficient privileges to perform the operation.
 293 @[EROFS, EACCES, EPERM]@
 294 \item @ResourceExhausted@
 295 Insufficient resources are available to perform the operation.
 296 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 297 \item @UnsatisfiedConstraints@
 298 Implementation-dependent constraints are not satisfied.
 299 @[EBUSY]@
 300 \item @UnsupportedOperation@
 301 The implementation does not support renaming in this situation.
 302 @[EXDEV]@
 303 \item @InappropriateType@
 304 Either path refers to an existing directory.
 305 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 306 \end{itemize}
 307 -}
 308
 309 renameFile :: FilePath -> FilePath -> IO ()
 310 renameFile opath npath =
 311    withFileStatus opath $ \st -> do
 312    is_dir <- isDirectory st
 313    if is_dir
 314         then ioException (IOError Nothing InappropriateType "renameFile"
 315                            "is a directory" (Just opath))
 316         else do
 317
 318     withUnsafeCString opath $ \s1 ->
 319       withUnsafeCString npath $ \s2 ->
 320          throwErrnoIfMinus1Retry_ "renameFile" (rename s1 s2)
 321
 322 {-
 323 @getDirectoryContents dir@ returns a list of {\em all} entries
 324 in {\em dir}.
 325
 326 The operation may fail with:
 327 \begin{itemize}
 328 \item @HardwareFault@
 329 A physical I/O error has occurred.
 330 @[EIO]@
 331 \item @InvalidArgument@
 332 The operand is not a valid directory name.
 333 @[ENAMETOOLONG, ELOOP]@
 334 \item @isDoesNotExistError@ / @NoSuchThing@
 335 The directory does not exist.
 336 @[ENOENT, ENOTDIR]@
 337 \item @isPermissionError@ / @PermissionDenied@
 338 The process has insufficient privileges to perform the operation.
 339 @[EACCES]@
 340 \item @ResourceExhausted@
 341 Insufficient resources are available to perform the operation.
 342 @[EMFILE, ENFILE]@
 343 \item @InappropriateType@
 344 The path refers to an existing non-directory object.
 345 @[ENOTDIR]@
 346 \end{itemize}
 347 -}
 348
 349 getDirectoryContents :: FilePath -> IO [FilePath]
 350 getDirectoryContents path = do
 351    p <- withUnsafeCString path $ \s ->
 352           throwErrnoIfNullRetry "getDirectoryContents" (opendir s)
 353    loop p
 354   where
 355     loop :: Ptr CDir -> IO [String]
 356     loop dir = do
 357       resetErrno
 358       p <- readdir dir
 359       if (p /= nullPtr)
 360          then do
 361 #ifdef mingw32_TARGET_OS
 362                  entryp <- (#peek struct dirent,d_name) p
 363                  entry <- peekCString entryp -- on mingwin it's a char *, not a char []
 364 #else
 365                  entry <- peekCString ((#ptr struct dirent,d_name) p)
 366 #endif
 367                  entries <- loop dir
 368                  return (entry:entries)
 369          else do errno <- getErrno
 370                  if (errno == eINTR) then loop dir else do
 371                  throwErrnoIfMinus1_ "getDirectoryContents" $ closedir dir
 372 #ifdef mingw32_TARGET_OS
 373                  if (errno == eNOENT) -- mingwin (20001111) cunningly sets errno to ENOENT when it runs out of files
 374 #else
 375                  if (errno == eOK)
 376 #endif
 377                     then return []
 378                     else throwErrno "getDirectoryContents"
 379
 380 {-
 381 If the operating system has a notion of current directories,
 382 @getCurrentDirectory@ returns an absolute path to the
 383 current directory of the calling process.
 384
 385 The operation may fail with:
 386 \begin{itemize}
 387 \item @HardwareFault@
 388 A physical I/O error has occurred.
 389 @[EIO]@
 390 \item @isDoesNotExistError@ / @NoSuchThing@
 391 There is no path referring to the current directory.
 392 @[EPERM, ENOENT, ESTALE...]@
 393 \item @isPermissionError@ / @PermissionDenied@
 394 The process has insufficient privileges to perform the operation.
 395 @[EACCES]@
 396 \item @ResourceExhausted@
 397 Insufficient resources are available to perform the operation.
 398 \item @UnsupportedOperation@
 399 The operating system has no notion of current directory.
 400 \end{itemize}
 401 -}
 402
 403 getCurrentDirectory :: IO FilePath
 404 getCurrentDirectory = do
 405   p <- mallocBytes (#const PATH_MAX)
 406   go p (#const PATH_MAX)
 407   where go p bytes = do
 408           p' <- getcwd p (fromIntegral bytes)
 409           if p' /= nullPtr
 410              then do s <- peekCString p'
 411                      free p'
 412                      return s
 413              else do errno <- getErrno
 414                      if errno == eRANGE
 415                         then do let bytes' = bytes * 2
 416                                 p' <- reallocBytes p bytes'
 417                                 go p' bytes'
 418                         else throwErrno "getCurrentDirectory"
 419
 420 {-
 421 If the operating system has a notion of current directories,
 422 @setCurrentDirectory dir@ changes the current
 423 directory of the calling process to {\em dir}.
 424
 425 The operation may fail with:
 426 \begin{itemize}
 427 \item @HardwareFault@
 428 A physical I/O error has occurred.
 429 @[EIO]@
 430 \item @InvalidArgument@
 431 The operand is not a valid directory name.
 432 @[ENAMETOOLONG, ELOOP]@
 433 \item @isDoesNotExistError@ / @NoSuchThing@
 434 The directory does not exist.
 435 @[ENOENT, ENOTDIR]@
 436 \item @isPermissionError@ / @PermissionDenied@
 437 The process has insufficient privileges to perform the operation.
 438 @[EACCES]@
 439 \item @UnsupportedOperation@
 440 The operating system has no notion of current directory, or the
 441 current directory cannot be dynamically changed.
 442 \item @InappropriateType@
 443 The path refers to an existing non-directory object.
 444 @[ENOTDIR]@
 445 \end{itemize}
 446 -}
 447
 448 setCurrentDirectory :: FilePath -> IO ()
 449 setCurrentDirectory path = do
 450     withUnsafeCString path $ \s ->
 451        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (chdir s)
 452         -- ToDo: add path to error
 453
 454 {-
 455 To clarify, @doesDirectoryExist@ returns True if a file system object
 456 exist, and it's a directory. @doesFileExist@ returns True if the file
 457 system object exist, but it's not a directory (i.e., for every other
 458 file system object that is not a directory.)
 459 -}
 460
 461 doesDirectoryExist :: FilePath -> IO Bool
 462 doesDirectoryExist name =
 463  catch
 464    (withFileStatus name $ \st -> isDirectory st)
 465    (\ _ -> return False)
 466
 467 doesFileExist :: FilePath -> IO Bool
 468 doesFileExist name = do
 469  catch
 470    (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
 471    (\ _ -> return False)
 472
 473 getModificationTime :: FilePath -> IO ClockTime
 474 getModificationTime name =
 475  withFileStatus name $ \ st ->
 476  modificationTime st
 477
 478 getPermissions :: FilePath -> IO Permissions
 479 getPermissions name = do
 480   withUnsafeCString name $ \s -> do
 481   read  <- access s (#const R_OK)
 482   write <- access s (#const W_OK)
 483   exec  <- access s (#const X_OK)
 484   withFileStatus name $ \st -> do
 485   is_dir <- isDirectory st
 486   is_reg <- isRegularFile st
 487   return (
 488     Permissions {
 489       readable   = read  == 0,
 490       writable   = write == 0,
 491       executable = not is_dir && exec == 0,
 492       searchable = not is_reg && exec == 0
 493     }
 494    )
 495
 496 setPermissions :: FilePath -> Permissions -> IO ()
 497 setPermissions name (Permissions r w e s) = do
 498     let
 499      read  = if r      then (#const S_IRUSR) else emptyCMode
 500      write = if w      then (#const S_IWUSR) else emptyCMode
 501      exec  = if e || s then (#const S_IXUSR) else emptyCMode
 502
 503      mode  = read `unionCMode` (write `unionCMode` exec)
 504
 505     withUnsafeCString name $ \s ->
 506       throwErrnoIfMinus1_ "setPermissions" $ chmod s mode
 507
 508 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 509 withFileStatus name f = do
 510     allocaBytes (#const sizeof(struct stat)) $ \p ->
 511       withUnsafeCString name $ \s -> do
 512         throwErrnoIfMinus1Retry_ "withFileStatus" (stat s p)
 513         f p
 514
 515 modificationTime :: Ptr CStat -> IO ClockTime
 516 modificationTime stat = do
 517     mtime <- (#peek struct stat, st_mtime) stat
 518     return (TOD (toInteger (mtime :: CTime)) 0)
 519
 520 isDirectory :: Ptr CStat -> IO Bool
 521 isDirectory stat = do
 522   mode <- (#peek struct stat, st_mode) stat
 523   return (s_ISDIR mode /= 0)
 524
 525 isRegularFile :: Ptr CStat -> IO Bool
 526 isRegularFile stat = do
 527   mode <- (#peek struct stat, st_mode) stat
 528   return (s_ISREG mode /= 0)
 529
 530 foreign import ccall unsafe s_ISDIR :: CMode -> Int
 531 #def inline HsInt s_ISDIR(m) {return S_ISDIR(m);}
 532
 533 foreign import ccall unsafe s_ISREG :: CMode -> Int
 534 #def inline HsInt s_ISREG(m) {return S_ISREG(m);}
 535
 536 emptyCMode     :: CMode
 537 emptyCMode     = 0
 538
 539 unionCMode     :: CMode -> CMode -> CMode
 540 unionCMode     = (+)
 541
 542 type UCString = UnsafeCString
 543
 544 #if defined(mingw32_TARGET_OS)
 545 foreign import ccall unsafe mkdir    :: UCString -> IO CInt
 546 #else
 547 foreign import ccall unsafe mkdir    :: UCString -> CInt -> IO CInt
 548 #endif
 549
 550 foreign import ccall unsafe chmod    :: UCString -> CMode -> IO CInt
 551 foreign import ccall unsafe access   :: UCString -> CMode -> IO CInt
 552 foreign import ccall unsafe rmdir    :: UCString -> IO CInt
 553 foreign import ccall unsafe chdir    :: UCString -> IO CInt
 554 foreign import ccall unsafe getcwd   :: Ptr CChar -> CInt -> IO (Ptr CChar)
 555 foreign import ccall unsafe unlink   :: UCString -> IO CInt
 556 foreign import ccall unsafe rename   :: UCString -> UCString -> IO CInt
 557
 558 foreign import ccall unsafe opendir  :: UCString  -> IO (Ptr CDir)
 559 foreign import ccall unsafe readdir  :: Ptr CDir -> IO (Ptr CDirent)
 560 foreign import ccall unsafe closedir :: Ptr CDir -> IO CInt
 561
 562 foreign import ccall unsafe stat     :: UCString -> Ptr CStat -> IO CInt
 563
 564 type CDirent = ()