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