ghc/lib/posix/PosixFiles.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
   3 %
   4 \section[PosixFiles]{Haskell 1.3 POSIX File and Directory Operations}
   5
   6 \begin{code}
   7 module PosixFiles (
   8
   9     -- Directory streams
  10     DirStream,
  11     openDirStream, closeDirStream,
  12     readDirStream, rewindDirStream,
  13
  14     -- set/get process' working directory.
  15     getWorkingDirectory, changeWorkingDirectory,
  16
  17     -- File modes/permissions
  18     FileMode,
  19     nullFileMode,
  20     ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
  21     groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
  22     otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
  23     setUserIDMode, setGroupIDMode,
  24     stdFileMode,   accessModes,
  25
  26     unionFileModes, intersectFileModes,
  27
  28     -- File operations on descriptors
  29     stdInput, stdOutput, stdError,
  30     OpenMode(..),
  31     OpenFileFlags(..), defaultFileFlags,
  32     openFd, createFile,
  33
  34     -- other file&directory operations
  35     setFileCreationMask,
  36     createLink, removeLink,
  37     createDirectory, removeDirectory,
  38     createNamedPipe,
  39     rename,
  40
  41     -- FileStatus
  42     FileStatus,
  43     getFileStatus, getFdStatus,
  44     fileExist,
  45     fileAccess,
  46     setFileMode,
  47
  48     fileMode,
  49     fileID,         FileID,
  50     deviceID,       DeviceID,
  51     linkCount,
  52     fileOwner, fileGroup,
  53     fileSize,
  54     accessTime,     modificationTime, statusChangeTime,
  55     isDirectory,    isCharacterDevice,
  56     isBlockDevice,  isRegularFile,
  57     isNamedPipe,
  58
  59     setOwnerAndGroup,  -- chown (might be restricted)
  60     setFileTimes,      -- set access and modification time
  61     touchFile,         -- set access and modification time to current time.
  62
  63     -- run-time limit & POSIX feature testing
  64     PathVar(..),
  65     getPathVar,
  66     getFileVar
  67
  68     ) where
  69
  70 import PrelST
  71 import ST
  72 import PrelIOBase
  73 import IO
  74 import IOExts       ( unsafePerformIO )
  75 import CString      ( packStringIO, allocChars,
  76                       freeze, strcpy
  77                     )
  78 import Addr
  79 import CCall
  80 import PrelBase
  81 import ByteArray
  82
  83 import PosixErr
  84 import PosixUtil
  85 import Directory        ( removeDirectory,  -- re-use its code
  86                           getCurrentDirectory,
  87                           setCurrentDirectory
  88                         )
  89
  90 \end{code}
  91
  92 %************************************************************
  93 %*                                                          *
  94 \subsection[DirStream]{POSIX Directory streams}
  95 %*                                                          *
  96 %************************************************************
  97
  98 Accessing directories is done in POSIX via @DIR@ streams, with
  99 operations for opening, closing, reading and rewinding the current
 100 pointer in a directory.
 101
 102 {\bf Note:} The standard interface @Directory@ provides the
 103 operation @getDirectoryContents@ which returns the directory contents of a
 104 specified file path, which supplants some of the raw @DirStream@ operations
 105 defined here.
 106
 107 \begin{code}
 108
 109 data DirStream = DirStream# Addr#
 110 instance CCallable   DirStream
 111 instance CReturnable DirStream
 112
 113 openDirStream :: FilePath -> IO DirStream
 114 openDirStream name =
 115     packStringIO name >>= \dir ->
 116     _ccall_ opendir dir >>= \dirp@(A# dirp#) ->
 117     if dirp /= nullAddr
 118        then return (DirStream# dirp#)
 119        else syserr "openDirStream"
 120
 121 readDirStream :: DirStream -> IO String
 122 readDirStream dirp = do
 123     setErrorCode noError
 124     dirent <- _ccall_ readdir dirp
 125     if dirent /= nullAddr
 126        then do
 127             str <- _casm_ ``%r = ((struct dirent *)%0)->d_name;'' dirent
 128             name <- strcpy str
 129             return name
 130        else do
 131              errno <- getErrorCode
 132              if errno == noError
 133                 then ioError (IOError Nothing EOF "readDirStream" "EOF")
 134                 else syserr "readDirStream"
 135
 136 rewindDirStream :: DirStream -> IO ()
 137 rewindDirStream dirp = do
 138     _ccall_ rewinddir dirp
 139     return ()
 140
 141 closeDirStream :: DirStream -> IO ()
 142 closeDirStream dirp = do
 143     rc <- _ccall_ closedir dirp
 144     if rc == (0::Int)
 145        then return ()
 146        else syserr "closeDirStream"
 147
 148 {-
 149  Renamings of functionality provided via Directory interface,
 150  kept around for b.wards compatibility and for having more POSIXy
 151  names
 152 -}
 153 getWorkingDirectory :: IO FilePath
 154 getWorkingDirectory = getCurrentDirectory
 155
 156 changeWorkingDirectory :: FilePath -> IO ()
 157 changeWorkingDirectory name = setCurrentDirectory name
 158 \end{code}
 159
 160 %************************************************************
 161 %*                                                          *
 162 \subsection[FileMode]{POSIX File modes}
 163 %*                                                          *
 164 %************************************************************
 165
 166 The abstract type @FileMode@ and constants and operators for manipulating the
 167 file modes defined by POSIX.
 168
 169 \begin{code}
 170
 171 data FileMode = FileMode# Word#
 172 instance CCallable FileMode
 173 instance CReturnable FileMode
 174
 175 nullFileMode :: FileMode
 176 nullFileMode = FileMode# (case ``0'' of { W# x -> x})
 177
 178 ownerReadMode :: FileMode
 179 ownerReadMode = FileMode# (case ``S_IRUSR'' of { W# x -> x})
 180
 181 ownerWriteMode :: FileMode
 182 ownerWriteMode = FileMode# (case ``S_IWUSR'' of { W# x -> x})
 183
 184 ownerExecuteMode :: FileMode
 185 ownerExecuteMode = FileMode# (case ``S_IXUSR'' of { W# x -> x})
 186
 187 groupReadMode :: FileMode
 188 groupReadMode = FileMode# (case ``S_IRGRP'' of { W# x -> x})
 189
 190 groupWriteMode :: FileMode
 191 groupWriteMode = FileMode# (case ``S_IWGRP'' of { W# x -> x})
 192
 193 groupExecuteMode :: FileMode
 194 groupExecuteMode = FileMode# (case ``S_IXGRP'' of { W# x -> x})
 195
 196 otherReadMode :: FileMode
 197 otherReadMode = FileMode# (case ``S_IROTH'' of { W# x -> x})
 198
 199 otherWriteMode :: FileMode
 200 otherWriteMode = FileMode# (case ``S_IWOTH'' of { W# x -> x})
 201
 202 otherExecuteMode :: FileMode
 203 otherExecuteMode = FileMode# (case ``S_IXOTH'' of { W# x -> x})
 204
 205 setUserIDMode :: FileMode
 206 setUserIDMode = FileMode# (case ``S_ISUID'' of { W# x -> x})
 207
 208 setGroupIDMode :: FileMode
 209 setGroupIDMode = FileMode# (case ``S_ISGID'' of { W# x -> x})
 210
 211 stdFileMode :: FileMode
 212 stdFileMode = FileMode# (case ``(S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP|S_IROTH|S_IWOTH)'' of { W# x -> x})
 213
 214 ownerModes :: FileMode
 215 ownerModes = FileMode# (case ``S_IRWXU'' of { W# x -> x})
 216
 217 groupModes :: FileMode
 218 groupModes = FileMode# (case ``S_IRWXG'' of { W# x -> x})
 219
 220 otherModes :: FileMode
 221 otherModes = FileMode# (case ``S_IRWXO'' of { W# x -> x})
 222
 223 accessModes :: FileMode
 224 accessModes = FileMode# (case ``(S_IRWXU|S_IRWXG|S_IRWXO)'' of { W# x -> x})
 225
 226 unionFileModes :: FileMode -> FileMode -> FileMode
 227 unionFileModes (FileMode# m1#) (FileMode# m2#) = FileMode# (m1# `or#` m2#)
 228
 229 intersectFileModes :: FileMode -> FileMode -> FileMode
 230 intersectFileModes (FileMode# m1#) (FileMode# m2#) = FileMode# (m1# `and#` m2#)
 231
 232 \end{code}
 233
 234 %************************************************************
 235 %*                                                          *
 236 \subsection[FileDescriptor]{POSIX File descriptors}
 237 %*                                                          *
 238 %************************************************************
 239
 240 File descriptors (formerly @Channel@s) are the lowest level
 241 handles to file objects.
 242
 243 \begin{code}
 244 stdInput, stdOutput, stdError :: Fd
 245 stdInput   = intToFd 0
 246 stdOutput  = intToFd 1
 247 stdError   = intToFd 2
 248
 249 data OpenMode = ReadOnly | WriteOnly | ReadWrite
 250
 251 data OpenFileFlags =
 252  OpenFileFlags {
 253     append    :: Bool,
 254     exclusive :: Bool,
 255     noctty    :: Bool,
 256     nonBlock  :: Bool,
 257     trunc     :: Bool
 258  }
 259
 260 defaultFileFlags :: OpenFileFlags
 261 defaultFileFlags =
 262  OpenFileFlags {
 263     append    = False,
 264     exclusive = False,
 265     noctty    = False,
 266     nonBlock  = False,
 267     trunc     = False
 268   }
 269
 270 openFd :: FilePath
 271        -> OpenMode
 272        -> Maybe FileMode -- Just x => O_CREAT, Nothing => must exist
 273        -> OpenFileFlags
 274        -> IO Fd
 275 openFd name how maybe_mode (OpenFileFlags append exclusive noctty nonBlock truncate) =
 276     packStringIO name >>= \file ->
 277     _ccall_ open file flags mode_w >>= \fd@(I# fd#) ->
 278     if fd /= ((-1)::Int)
 279        then return (FD# fd#)
 280        else syserr "openFd"
 281   where
 282     mode_w = case maybe_mode of { Nothing -> ``0'' ; Just x -> x }
 283     flags  = W# (creat# `or#` flags# `or#` how#)
 284
 285     or (W# x#) (W# y#) = W# (x# `or#` y#)
 286
 287     (W# flags#) =
 288        (if append    then ``O_APPEND''   else zero) `or`
 289        (if exclusive then ``O_EXCL''     else zero) `or`
 290        (if noctty    then ``O_NOCTTY''   else zero) `or`
 291        (if nonBlock  then ``O_NONBLOCK'' else zero) `or`
 292        (if truncate  then ``O_TRUNC''    else zero)
 293
 294     zero = W# (int2Word# 0#)
 295
 296     creat# =
 297      case (case maybe_mode of {
 298               Nothing -> zero ;
 299               Just _ -> ``O_CREAT'' }) of {
 300       W# x -> x }
 301
 302     how#  =
 303      case
 304       (case how of { ReadOnly  -> ``O_RDONLY'';
 305                      WriteOnly -> ``O_WRONLY'';
 306                      ReadWrite -> ``O_RDWR''}) of {
 307       W# x -> x }
 308
 309 createFile :: FilePath -> FileMode -> IO Fd
 310 createFile name mode =
 311     packStringIO name >>= \file ->
 312     _ccall_ creat file mode >>= \fd@(I# fd#) ->
 313     if fd /= ((-1)::Int)
 314        then return (FD# fd#)
 315        else syserr "createFile"
 316
 317 setFileCreationMask :: FileMode -> IO FileMode
 318 setFileCreationMask mask =  _ccall_ umask mask
 319
 320 createLink :: FilePath -> FilePath -> IO ()
 321 createLink name1 name2 = do
 322     path1 <- packStringIO name1
 323     path2 <- packStringIO name2
 324     rc <- _ccall_ link path1 path2
 325     if rc == (0::Int)
 326        then return ()
 327        else syserr "createLink"
 328
 329 createDirectory :: FilePath -> FileMode -> IO ()
 330 createDirectory name mode = do -- NB: diff signature from LibDirectory one!
 331     dir <- packStringIO name
 332     rc  <- _ccall_ mkdir dir mode
 333     if rc == (0::Int)
 334        then return ()
 335        else syserr "createDirectory"
 336
 337 createNamedPipe :: FilePath -> FileMode -> IO ()
 338 createNamedPipe name mode = do
 339     pipe <- packStringIO name
 340     rc   <-_ccall_ mkfifo pipe mode
 341     if rc == (0::Int)
 342        then return ()
 343        else syserr "createNamedPipe"
 344
 345 removeLink :: FilePath -> IO ()
 346 removeLink name = do
 347     path <- packStringIO name
 348     rc   <-_ccall_ unlink path
 349     if rc == (0::Int)
 350        then return ()
 351        else syserr "removeLink"
 352
 353 rename :: FilePath -> FilePath -> IO ()
 354 rename name1 name2 = do
 355     path1 <- packStringIO name1
 356     path2 <- packStringIO name2
 357     rc    <- _ccall_ rename path1 path2
 358     if rc == (0::Int)
 359        then return ()
 360        else syserr "rename"
 361
 362 type FileStatus = ByteArray Int
 363 type FileID = Int
 364 type DeviceID = Int
 365
 366 fileMode :: FileStatus -> FileMode
 367 fileMode stat = unsafePerformIO $
 368     _casm_ ``%r = ((struct stat *)%0)->st_mode;'' stat
 369
 370 fileID :: FileStatus -> FileID
 371 fileID stat = unsafePerformIO $
 372     _casm_ ``%r = ((struct stat *)%0)->st_ino;'' stat
 373
 374 deviceID :: FileStatus -> DeviceID
 375 deviceID stat = unsafePerformIO $
 376     _casm_ ``%r = ((struct stat *)%0)->st_dev;'' stat
 377
 378 linkCount :: FileStatus -> LinkCount
 379 linkCount stat = unsafePerformIO $
 380     _casm_ ``%r = ((struct stat *)%0)->st_nlink;'' stat
 381
 382 fileOwner :: FileStatus -> UserID
 383 fileOwner stat = unsafePerformIO $
 384     _casm_ ``%r = ((struct stat *)%0)->st_uid;'' stat
 385
 386 fileGroup :: FileStatus -> GroupID
 387 fileGroup stat = unsafePerformIO $
 388     _casm_ ``%r = ((struct stat *)%0)->st_gid;'' stat
 389
 390 fileSize :: FileStatus -> FileOffset
 391 fileSize stat = unsafePerformIO $
 392     _casm_ ``%r = ((struct stat *)%0)->st_size;'' stat
 393
 394 accessTime :: FileStatus -> EpochTime
 395 accessTime stat = unsafePerformIO $
 396     _casm_ ``%r = ((struct stat *)%0)->st_atime;'' stat
 397
 398 modificationTime :: FileStatus -> EpochTime
 399 modificationTime stat = unsafePerformIO $
 400     _casm_ ``%r = ((struct stat *)%0)->st_mtime;'' stat
 401
 402 statusChangeTime :: FileStatus -> EpochTime
 403 statusChangeTime stat = unsafePerformIO $
 404     _casm_ ``%r = ((struct stat *)%0)->st_ctime;'' stat
 405
 406 isDirectory :: FileStatus -> Bool
 407 isDirectory stat = unsafePerformIO $
 408     _casm_ ``%r = S_ISDIR(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
 409     return (rc /= (0::Int))
 410
 411 isCharacterDevice :: FileStatus -> Bool
 412 isCharacterDevice stat = unsafePerformIO $
 413     _casm_ ``%r = S_ISCHR(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
 414     return (rc /= (0::Int))
 415
 416 isBlockDevice :: FileStatus -> Bool
 417 isBlockDevice stat = unsafePerformIO $
 418     _casm_ ``%r = S_ISBLK(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
 419     return (rc /= (0::Int))
 420
 421 isRegularFile :: FileStatus -> Bool
 422 isRegularFile stat = unsafePerformIO $
 423     _casm_ ``%r = S_ISREG(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
 424     return (rc /= (0::Int))
 425
 426 isNamedPipe :: FileStatus -> Bool
 427 isNamedPipe stat = unsafePerformIO $
 428     _casm_ ``%r = S_ISFIFO(((struct stat *)%0)->st_mode);'' stat >>= \ rc ->
 429     return (rc /= (0::Int))
 430
 431 getFileStatus :: FilePath -> IO FileStatus
 432 getFileStatus name = do
 433     path  <- packStringIO name
 434     bytes <- allocChars ``sizeof(struct stat)''
 435     rc    <- _casm_ ``%r = stat(%0,(struct stat *)%1);'' path bytes
 436     if rc == (0::Int)
 437        then do
 438             stat <- freeze bytes
 439             return stat
 440        else syserr "getFileStatus"
 441
 442 getFdStatus :: Fd -> IO FileStatus
 443 getFdStatus fd = do
 444     bytes <- allocChars ``sizeof(struct stat)''
 445     rc    <- _casm_ ``%r = fstat(%0,(struct stat *)%1);'' fd bytes
 446     if rc == (0::Int)
 447        then do
 448             stat <- freeze bytes
 449             return stat
 450        else syserr "getFdStatus"
 451
 452 fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
 453 fileAccess name read write exec = do
 454     path <- packStringIO name
 455     rc   <- _ccall_ access path flags
 456     return (rc == (0::Int))
 457   where
 458     flags  = I# (word2Int# (read# `or#` write# `or#` exec#))
 459     read#  = case (if read  then ``R_OK'' else ``0'') of { W# x -> x }
 460     write# = case (if write then ``W_OK'' else ``0'') of { W# x -> x }
 461     exec#  = case (if exec  then ``X_OK'' else ``0'') of { W# x -> x }
 462
 463 fileExist :: FilePath -> IO Bool
 464 fileExist name = do
 465     path <- packStringIO name
 466     rc   <- _ccall_ access path (``F_OK''::Int)
 467     return (rc == (0::Int))
 468
 469 setFileMode :: FilePath -> FileMode -> IO ()
 470 setFileMode name mode = do
 471     path <- packStringIO name
 472     rc   <- _ccall_ chmod path mode
 473     if rc == (0::Int)
 474        then return ()
 475        else syserr "setFileMode"
 476
 477 setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
 478 setOwnerAndGroup name uid gid = do
 479     path <- packStringIO name
 480     rc   <- _ccall_ chown path uid gid
 481     if rc == (0::Int)
 482        then return ()
 483        else syserr "setOwnerAndGroup"
 484
 485 setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
 486 setFileTimes name atime mtime = do
 487     path <- packStringIO name
 488     rc   <- _casm_ ``do {struct utimbuf ub; ub.actime = (time_t) %0;
 489                          ub.modtime = (time_t) %1;
 490                          %r = utime(%2, &ub);} while(0);'' atime mtime path
 491     if rc == (0::Int)
 492        then return ()
 493        else syserr "setFileTimes"
 494
 495 {- Set access and modification time to current time -}
 496 touchFile :: FilePath -> IO ()
 497 touchFile name = do
 498     path <- packStringIO name
 499     rc   <- _ccall_ utime path nullAddr
 500     if rc == (0::Int)
 501        then return ()
 502        else syserr "touchFile"
 503
 504 data PathVar = LinkLimit                     {- _PC_LINK_MAX         -}
 505              | InputLineLimit                {- _PC_MAX_CANON        -}
 506              | InputQueueLimit               {- _PC_MAX_INPUT        -}
 507              | FileNameLimit                 {- _PC_NAME_MAX         -}
 508              | PathNameLimit                 {- _PC_PATH_MAX         -}
 509              | PipeBufferLimit               {- _PC_PIPE_BUF         -}
 510              | SetOwnerAndGroupIsRestricted  {- _PC_CHOWN_RESTRICTED -}
 511              | FileNamesAreNotTruncated      {- _PC_NO_TRUNC         -}
 512
 513 getPathVar :: PathVar -> FilePath -> IO Limit
 514 getPathVar v name =
 515    (case v of
 516       LinkLimit       -> pathconf ``_PC_LINK_MAX''
 517       InputLineLimit  -> pathconf ``_PC_MAX_CANON''
 518       InputQueueLimit -> pathconf ``_PC_MAX_INPUT''
 519       FileNameLimit   -> pathconf ``_PC_NAME_MAX''
 520       PathNameLimit   -> pathconf ``_PC_PATH_MAX''
 521       PipeBufferLimit -> pathconf ``_PC_PIPE_BUF''
 522       SetOwnerAndGroupIsRestricted -> pathconf ``_PC_CHOWN_RESTRICTED''
 523       FileNamesAreNotTruncated     -> pathconf ``_PC_NO_TRUNC'') name
 524
 525 pathconf :: Int -> FilePath -> IO Limit
 526 pathconf n name = do
 527   path <- packStringIO name
 528   rc   <- _ccall_ pathconf path n
 529   if rc /= ((-1)::Int)
 530      then return rc
 531      else do
 532           errno <-  getErrorCode
 533           if errno == invalidArgument
 534              then ioError (IOError Nothing NoSuchThing "getPathVar" "no such path limit or option")
 535              else syserr "PosixFiles.getPathVar"
 536
 537
 538 getFileVar :: PathVar -> Fd -> IO Limit
 539 getFileVar v fd =
 540     (case v of
 541       LinkLimit       -> fpathconf (``_PC_LINK_MAX''::Int)
 542       InputLineLimit  -> fpathconf (``_PC_MAX_CANON''::Int)
 543       InputQueueLimit -> fpathconf ``_PC_MAX_INPUT''
 544       FileNameLimit   -> fpathconf ``_PC_NAME_MAX''
 545       PathNameLimit   -> fpathconf ``_PC_PATH_MAX''
 546       PipeBufferLimit -> fpathconf ``_PC_PIPE_BUF''
 547       SetOwnerAndGroupIsRestricted -> fpathconf ``_PC_CHOWN_RESTRICTED''
 548       FileNamesAreNotTruncated -> fpathconf ``_PC_NO_TRUNC'') fd
 549
 550 fpathconf :: Int -> Fd -> IO Limit
 551 fpathconf n fd = do
 552  rc <- _ccall_ fpathconf fd n
 553  if rc /= ((-1)::Int)
 554     then return rc
 555     else do
 556          errno <-  getErrorCode
 557          if errno == invalidArgument
 558             then ioError (IOError Nothing NoSuchThing "getFileVar" "no such path limit or option")
 559             else syserr "getFileVar"
 560
 561 \end{code}