ghc/lib/std/Directory.hsc

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