System/Directory.hsc

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