ghc/lib/std/Directory.hsc

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