ghc/lib/std/Directory.hsc

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