System/Directory.hs

   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.hs,v 1.1 2002/02/05 17:32: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 -----------------------------------------------------------------------------
  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 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     withCString path $ \s -> do
 126       throwErrnoIfMinus1Retry_ "createDirectory" $
 127         mkdir s 0o777
 128
 129 {-
 130 @removeDirectory dir@ removes an existing directory {\em dir}.  The
 131 implementation may specify additional constraints which must be
 132 satisfied before a directory can be removed (e.g. the directory has to
 133 be empty, or may not be in use by other processes).  It is not legal
 134 for an implementation to partially remove a directory unless the
 135 entire directory is removed. A conformant implementation need not
 136 support directory removal in all situations (e.g. removal of the root
 137 directory).
 138
 139 The operation may fail with:
 140 \begin{itemize}
 141 \item @HardwareFault@
 142 A physical I/O error has occurred.
 143 [@EIO@]
 144 \item @InvalidArgument@
 145 The operand is not a valid directory name.
 146 @[ENAMETOOLONG, ELOOP]@
 147 \item @isDoesNotExist@ / @NoSuchThing@
 148 The directory does not exist.
 149 @[ENOENT, ENOTDIR]@
 150 \item @isPermissionError@ / @PermissionDenied@
 151 The process has insufficient privileges to perform the operation.
 152 @[EROFS, EACCES, EPERM]@
 153 \item @UnsatisfiedConstraints@
 154 Implementation-dependent constraints are not satisfied.
 155 @[EBUSY, ENOTEMPTY, EEXIST]@
 156 \item @UnsupportedOperation@
 157 The implementation does not support removal in this situation.
 158 @[EINVAL]@
 159 \item @InappropriateType@
 160 The operand refers to an existing non-directory object.
 161 @[ENOTDIR]@
 162 \end{itemize}
 163 -}
 164
 165 removeDirectory :: FilePath -> IO ()
 166 removeDirectory path = do
 167     withCString path $ \s ->
 168        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
 169
 170 {-
 171 @Removefile file@ removes the directory entry for an existing file
 172 {\em file}, where {\em file} is not itself a directory. The
 173 implementation may specify additional constraints which must be
 174 satisfied before a file can be removed (e.g. the file may not be in
 175 use by other processes).
 176
 177 The operation may fail with:
 178 \begin{itemize}
 179 \item @HardwareFault@
 180 A physical I/O error has occurred.
 181 @[EIO]@
 182 \item @InvalidArgument@
 183 The operand is not a valid file name.
 184 @[ENAMETOOLONG, ELOOP]@
 185 \item @isDoesNotExist@ / @NoSuchThing@
 186 The file does not exist.
 187 @[ENOENT, ENOTDIR]@
 188 \item @isPermissionError@ / @PermissionDenied@
 189 The process has insufficient privileges to perform the operation.
 190 @[EROFS, EACCES, EPERM]@
 191 \item @UnsatisfiedConstraints@
 192 Implementation-dependent constraints are not satisfied.
 193 @[EBUSY]@
 194 \item @InappropriateType@
 195 The operand refers to an existing directory.
 196 @[EPERM, EINVAL]@
 197 \end{itemize}
 198 -}
 199
 200 removeFile :: FilePath -> IO ()
 201 removeFile path = do
 202     withCString path $ \s ->
 203       throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
 204
 205 {-
 206 @renameDirectory@ {\em old} {\em new} changes the name of an existing
 207 directory from {\em old} to {\em new}.  If the {\em new} directory
 208 already exists, it is atomically replaced by the {\em old} directory.
 209 If the {\em new} directory is neither the {\em old} directory nor an
 210 alias of the {\em old} directory, it is removed as if by
 211 $removeDirectory$.  A conformant implementation need not support
 212 renaming directories in all situations (e.g. renaming to an existing
 213 directory, or across different physical devices), but the constraints
 214 must be documented.
 215
 216 The operation may fail with:
 217 \begin{itemize}
 218 \item @HardwareFault@
 219 A physical I/O error has occurred.
 220 @[EIO]@
 221 \item @InvalidArgument@
 222 Either operand is not a valid directory name.
 223 @[ENAMETOOLONG, ELOOP]@
 224 \item @isDoesNotExistError@ / @NoSuchThing@
 225 The original directory does not exist, or there is no path to the target.
 226 @[ENOENT, ENOTDIR]@
 227 \item @isPermissionError@ / @PermissionDenied@
 228 The process has insufficient privileges to perform the operation.
 229 @[EROFS, EACCES, EPERM]@
 230 \item @ResourceExhausted@
 231 Insufficient resources are available to perform the operation.
 232 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 233 \item @UnsatisfiedConstraints@
 234 Implementation-dependent constraints are not satisfied.
 235 @[EBUSY, ENOTEMPTY, EEXIST]@
 236 \item @UnsupportedOperation@
 237 The implementation does not support renaming in this situation.
 238 @[EINVAL, EXDEV]@
 239 \item @InappropriateType@
 240 Either path refers to an existing non-directory object.
 241 @[ENOTDIR, EISDIR]@
 242 \end{itemize}
 243 -}
 244
 245 renameDirectory :: FilePath -> FilePath -> IO ()
 246 renameDirectory opath npath =
 247    withFileStatus opath $ \st -> do
 248    is_dir <- isDirectory st
 249    if (not is_dir)
 250         then ioException (IOError Nothing InappropriateType "renameDirectory"
 251                             ("not a directory") (Just opath))
 252         else do
 253
 254    withCString opath $ \s1 ->
 255      withCString npath $ \s2 ->
 256         throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
 257
 258 {-
 259 @renameFile@ {\em old} {\em new} changes the name of an existing file system
 260 object from {\em old} to {\em new}.  If the {\em new} object already
 261 exists, it is atomically replaced by the {\em old} object.  Neither
 262 path may refer to an existing directory.  A conformant implementation
 263 need not support renaming files in all situations (e.g. renaming
 264 across different physical devices), but the constraints must be
 265 documented.
 266
 267 The operation may fail with:
 268 \begin{itemize}
 269 \item @HardwareFault@
 270 A physical I/O error has occurred.
 271 @[EIO]@
 272 \item @InvalidArgument@
 273 Either operand is not a valid file name.
 274 @[ENAMETOOLONG, ELOOP]@
 275 \item @isDoesNotExistError@ / @NoSuchThing@
 276 The original file does not exist, or there is no path to the target.
 277 @[ENOENT, ENOTDIR]@
 278 \item @isPermissionError@ / @PermissionDenied@
 279 The process has insufficient privileges to perform the operation.
 280 @[EROFS, EACCES, EPERM]@
 281 \item @ResourceExhausted@
 282 Insufficient resources are available to perform the operation.
 283 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 284 \item @UnsatisfiedConstraints@
 285 Implementation-dependent constraints are not satisfied.
 286 @[EBUSY]@
 287 \item @UnsupportedOperation@
 288 The implementation does not support renaming in this situation.
 289 @[EXDEV]@
 290 \item @InappropriateType@
 291 Either path refers to an existing directory.
 292 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 293 \end{itemize}
 294 -}
 295
 296 renameFile :: FilePath -> FilePath -> IO ()
 297 renameFile opath npath =
 298    withFileOrSymlinkStatus opath $ \st -> do
 299    is_dir <- isDirectory st
 300    if is_dir
 301         then ioException (IOError Nothing InappropriateType "renameFile"
 302                            "is a directory" (Just opath))
 303         else do
 304
 305     withCString opath $ \s1 ->
 306       withCString npath $ \s2 ->
 307          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 308
 309 {-
 310 @getDirectoryContents dir@ returns a list of {\em all} entries
 311 in {\em dir}.
 312
 313 The operation may fail with:
 314 \begin{itemize}
 315 \item @HardwareFault@
 316 A physical I/O error has occurred.
 317 @[EIO]@
 318 \item @InvalidArgument@
 319 The operand is not a valid directory name.
 320 @[ENAMETOOLONG, ELOOP]@
 321 \item @isDoesNotExistError@ / @NoSuchThing@
 322 The directory does not exist.
 323 @[ENOENT, ENOTDIR]@
 324 \item @isPermissionError@ / @PermissionDenied@
 325 The process has insufficient privileges to perform the operation.
 326 @[EACCES]@
 327 \item @ResourceExhausted@
 328 Insufficient resources are available to perform the operation.
 329 @[EMFILE, ENFILE]@
 330 \item @InappropriateType@
 331 The path refers to an existing non-directory object.
 332 @[ENOTDIR]@
 333 \end{itemize}
 334 -}
 335
 336 getDirectoryContents :: FilePath -> IO [FilePath]
 337 getDirectoryContents path = do
 338    alloca $ \ ptr_dEnt -> do
 339     p <- withCString path $ \s ->
 340           throwErrnoIfNullRetry "getDirectoryContents" (c_opendir s)
 341     loop ptr_dEnt p
 342   where
 343     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 344     loop ptr_dEnt dir = do
 345       resetErrno
 346       r <- readdir dir ptr_dEnt
 347       if (r == 0)
 348          then do
 349                  dEnt    <- peek ptr_dEnt
 350                  if (dEnt == nullPtr)
 351                    then return []
 352                    else do
 353                     entry   <- (d_name dEnt >>= peekCString)
 354                     freeDirEnt dEnt
 355                     entries <- loop ptr_dEnt dir
 356                     return (entry:entries)
 357          else do errno <- getErrno
 358                  if (errno == eINTR) then loop ptr_dEnt dir else do
 359                  throwErrnoIfMinus1_ "getDirectoryContents" $ c_closedir dir
 360                  let (Errno eo) = errno
 361                  if (eo == end_of_dir)
 362                     then return []
 363                     else throwErrno "getDirectoryContents"
 364
 365
 366
 367 {-
 368 If the operating system has a notion of current directories,
 369 @getCurrentDirectory@ returns an absolute path to the
 370 current directory of the calling process.
 371
 372 The operation may fail with:
 373 \begin{itemize}
 374 \item @HardwareFault@
 375 A physical I/O error has occurred.
 376 @[EIO]@
 377 \item @isDoesNotExistError@ / @NoSuchThing@
 378 There is no path referring to the current directory.
 379 @[EPERM, ENOENT, ESTALE...]@
 380 \item @isPermissionError@ / @PermissionDenied@
 381 The process has insufficient privileges to perform the operation.
 382 @[EACCES]@
 383 \item @ResourceExhausted@
 384 Insufficient resources are available to perform the operation.
 385 \item @UnsupportedOperation@
 386 The operating system has no notion of current directory.
 387 \end{itemize}
 388 -}
 389
 390 getCurrentDirectory :: IO FilePath
 391 getCurrentDirectory = do
 392   p <- mallocBytes path_max
 393   go p path_max
 394   where go p bytes = do
 395           p' <- c_getcwd p (fromIntegral bytes)
 396           if p' /= nullPtr
 397              then do s <- peekCString p'
 398                      free p'
 399                      return s
 400              else do errno <- getErrno
 401                      if errno == eRANGE
 402                         then do let bytes' = bytes * 2
 403                                 p' <- reallocBytes p bytes'
 404                                 go p' bytes'
 405                         else throwErrno "getCurrentDirectory"
 406
 407 {-
 408 If the operating system has a notion of current directories,
 409 @setCurrentDirectory dir@ changes the current
 410 directory of the calling process to {\em dir}.
 411
 412 The operation may fail with:
 413 \begin{itemize}
 414 \item @HardwareFault@
 415 A physical I/O error has occurred.
 416 @[EIO]@
 417 \item @InvalidArgument@
 418 The operand is not a valid directory name.
 419 @[ENAMETOOLONG, ELOOP]@
 420 \item @isDoesNotExistError@ / @NoSuchThing@
 421 The directory does not exist.
 422 @[ENOENT, ENOTDIR]@
 423 \item @isPermissionError@ / @PermissionDenied@
 424 The process has insufficient privileges to perform the operation.
 425 @[EACCES]@
 426 \item @UnsupportedOperation@
 427 The operating system has no notion of current directory, or the
 428 current directory cannot be dynamically changed.
 429 \item @InappropriateType@
 430 The path refers to an existing non-directory object.
 431 @[ENOTDIR]@
 432 \end{itemize}
 433 -}
 434
 435 setCurrentDirectory :: FilePath -> IO ()
 436 setCurrentDirectory path = do
 437     withCString path $ \s ->
 438        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
 439         -- ToDo: add path to error
 440
 441 {-
 442 To clarify, @doesDirectoryExist@ returns True if a file system object
 443 exist, and it's a directory. @doesFileExist@ returns True if the file
 444 system object exist, but it's not a directory (i.e., for every other
 445 file system object that is not a directory.)
 446 -}
 447
 448 doesDirectoryExist :: FilePath -> IO Bool
 449 doesDirectoryExist name =
 450  catch
 451    (withFileStatus name $ \st -> isDirectory st)
 452    (\ _ -> return False)
 453
 454 doesFileExist :: FilePath -> IO Bool
 455 doesFileExist name = do
 456  catch
 457    (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
 458    (\ _ -> return False)
 459
 460 getModificationTime :: FilePath -> IO ClockTime
 461 getModificationTime name =
 462  withFileStatus name $ \ st ->
 463  modificationTime st
 464
 465 getPermissions :: FilePath -> IO Permissions
 466 getPermissions name = do
 467   withCString name $ \s -> do
 468   read  <- c_access s r_OK
 469   write <- c_access s w_OK
 470   exec  <- c_access s x_OK
 471   withFileStatus name $ \st -> do
 472   is_dir <- isDirectory st
 473   is_reg <- isRegularFile st
 474   return (
 475     Permissions {
 476       readable   = read  == 0,
 477       writable   = write == 0,
 478       executable = not is_dir && exec == 0,
 479       searchable = not is_reg && exec == 0
 480     }
 481    )
 482
 483 setPermissions :: FilePath -> Permissions -> IO ()
 484 setPermissions name (Permissions r w e s) = do
 485     let
 486      read  = if r      then s_IRUSR else emptyCMode
 487      write = if w      then s_IWUSR else emptyCMode
 488      exec  = if e || s then s_IXUSR else emptyCMode
 489
 490      mode  = read `unionCMode` (write `unionCMode` exec)
 491
 492     withCString name $ \s ->
 493       throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
 494
 495 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 496 withFileStatus name f = do
 497     allocaBytes sizeof_stat $ \p ->
 498       withCString name $ \s -> do
 499         throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
 500         f p
 501
 502 withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 503 withFileOrSymlinkStatus name f = do
 504     allocaBytes sizeof_stat $ \p ->
 505       withCString name $ \s -> do
 506         throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
 507         f p
 508
 509 modificationTime :: Ptr CStat -> IO ClockTime
 510 modificationTime stat = do
 511     mtime <- st_mtime stat
 512     return (TOD (toInteger (mtime :: CTime)) 0)
 513
 514 isDirectory :: Ptr CStat -> IO Bool
 515 isDirectory stat = do
 516   mode <- st_mode stat
 517   return (s_isdir mode)
 518
 519 isRegularFile :: Ptr CStat -> IO Bool
 520 isRegularFile stat = do
 521   mode <- st_mode stat
 522   return (s_isreg mode)
 523
 524 emptyCMode     :: CMode
 525 emptyCMode     = 0
 526
 527 unionCMode     :: CMode -> CMode -> CMode
 528 unionCMode     = (+)
 529
 530
 531 foreign import ccall unsafe "__hscore_path_max"
 532   path_max :: Int
 533
 534 foreign import ccall unsafe "__hscore_readdir"
 535   readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
 536
 537 foreign import ccall unsafe "__hscore_free_dirent"
 538   freeDirEnt  :: Ptr CDirent -> IO ()
 539
 540 foreign import ccall unsafe "__hscore_end_of_dir"
 541   end_of_dir :: CInt
 542
 543 foreign import ccall unsafe "__hscore_d_name"
 544   d_name :: Ptr CDirent -> IO CString
 545
 546 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 547 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
 548 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
 549
 550 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 551 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 552 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode