ghc/lib/std/Directory.hsc

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