2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
4 \section[LibPosixFiles]{Haskell 1.3 POSIX File and Directory Operations}
18 changeWorkingDirectory, -- Too much like LibDirectory thing?
20 createDirectory, -- Too much like LibDirectory thing?
34 getWorkingDirectory, -- Too much like LibDirectory thing?
61 removeDirectory, -- Too much like LibDirectory thing
86 import LibDirectory ( removeDirectory, -- re-use its code
91 type DirStream = _Addr
93 openDirStream :: FilePath -> IO DirStream
95 _packBytesForCST name `thenStrictlyST` \ dir ->
96 _ccall_ opendir dir `thenPrimIO` \ dirp ->
97 if dirp /= ``NULL'' then
100 syserr "openDirStream"
102 readDirStream :: DirStream -> IO String
104 setErrorCode noError >>
105 _ccall_ readdir dirp `thenPrimIO` \ dirent ->
106 if dirent /= (``NULL''::_Addr) then
107 _casm_ ``%r = ((struct dirent *)%0)->d_name;'' dirent
108 `thenPrimIO` \ str ->
109 strcpy str `thenPrimIO` \ name ->
112 getErrorCode >>= \ errno ->
113 if errno == noError then
116 syserr "readDirStream"
118 rewindDirStream :: DirStream -> IO ()
119 rewindDirStream dirp =
120 _ccall_ rewinddir dirp `thenPrimIO` \ () ->
123 closeDirStream :: DirStream -> IO ()
124 closeDirStream dirp =
125 _ccall_ closedir dirp `thenPrimIO` \ rc ->
129 syserr "closeDirStream"
131 getWorkingDirectory :: IO FilePath
132 getWorkingDirectory = getCurrentDirectory{-LibDirectory-}
134 _ccall_ getCurrentDirectory `thenPrimIO` \ str ->
135 if str /= ``NULL'' then
136 strcpy str `thenPrimIO` \ pwd ->
137 _ccall_ free str `thenPrimIO` \ () ->
140 syserr "getWorkingDirectory"
143 changeWorkingDirectory :: FilePath -> IO ()
144 changeWorkingDirectory name = setCurrentDirectory{-LibDirectory-} name
146 _packBytesForCST name `thenStrictlyST` \ dir ->
147 _ccall_ chdir dir `thenPrimIO` \ rc ->
151 syserr "changeWorkingDirectory"
154 type FileMode = _Word
156 nullFileMode :: FileMode
159 ownerReadMode :: FileMode
160 ownerReadMode = ``S_IRUSR''
162 ownerWriteMode :: FileMode
163 ownerWriteMode = ``S_IWUSR''
165 ownerExecuteMode :: FileMode
166 ownerExecuteMode = ``S_IXUSR''
168 groupReadMode :: FileMode
169 groupReadMode = ``S_IRGRP''
171 groupWriteMode :: FileMode
172 groupWriteMode = ``S_IWGRP''
174 groupExecuteMode :: FileMode
175 groupExecuteMode = ``S_IXGRP''
177 otherReadMode :: FileMode
178 otherReadMode = ``S_IROTH''
180 otherWriteMode :: FileMode
181 otherWriteMode = ``S_IWOTH''
183 otherExecuteMode :: FileMode
184 otherExecuteMode = ``S_IXOTH''
186 setUserIDMode :: FileMode
187 setUserIDMode = ``S_ISUID''
189 setGroupIDMode :: FileMode
190 setGroupIDMode = ``S_ISGID''
192 stdFileMode :: FileMode
193 stdFileMode = ``(S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP|S_IROTH|S_IWOTH)''
195 ownerModes :: FileMode
196 ownerModes = ``S_IRWXU''
198 groupModes :: FileMode
199 groupModes = ``S_IRWXG''
201 otherModes :: FileMode
202 otherModes = ``S_IRWXO''
204 accessModes :: FileMode
205 accessModes = ``(S_IRWXU|S_IRWXG|S_IRWXO)''
207 unionFileModes :: FileMode -> FileMode -> FileMode
208 unionFileModes (W# m1#) (W# m2#) = W# (m1# `or#` m2#)
210 intersectFileModes :: FileMode -> FileMode -> FileMode
211 intersectFileModes (W# m1#) (W# m2#) = W# (m1# `and#` m2#)
222 data OpenMode = ReadOnly
226 openChannel :: FilePath
228 -> Maybe FileMode -- Just x => O_CREAT, Nothing => must exist
232 -> Bool -- O_NONBLOCK
235 openChannel name how maybe_mode append excl noctty nonblock trunc =
236 _packBytesForCST name `thenStrictlyST` \ file ->
237 _ccall_ open file flags mode `thenPrimIO` \ fd ->
243 mode, creat :: FileMode
244 mode = case maybe_mode of { Nothing -> ``0'' ; Just x -> x }
246 creat = case maybe_mode of { Nothing -> ``0'' ; Just _ -> ``O_CREAT'' }
247 creat# = case creat of { W# x -> x }
249 flags = W# (creat# `or#` append# `or#` excl# `or#`
250 noctty# `or#` nonblock# `or#` trunc#)
251 append# = case (if append then ``O_APPEND'' else ``0'') of { W# x -> x }
252 excl# = case (if excl then ``O_EXCL'' else ``0'') of { W# x -> x }
253 noctty# = case (if noctty then ``O_NOCTTY'' else ``0'') of { W# x -> x }
254 nonblock# = case (if nonblock then ``O_NONBLOCK'' else ``0'') of { W# x -> x }
255 trunc# = case (if trunc then ``O_TRUNC'' else ``0'') of { W# x -> x }
257 createFile :: FilePath -> FileMode -> IO Channel
258 createFile name mode =
259 _packBytesForCST name `thenStrictlyST` \ file ->
260 _ccall_ creat file mode `thenPrimIO` \ fd ->
266 setFileCreationMask :: FileMode -> IO FileMode
267 setFileCreationMask mask =
268 _ccall_ umask mask `thenPrimIO` \ omask ->
271 createLink :: FilePath -> FilePath -> IO ()
272 createLink name1 name2 =
273 _packBytesForCST name1 `thenStrictlyST` \ path1 ->
274 _packBytesForCST name2 `thenStrictlyST` \ path2 ->
275 _ccall_ link path1 path2 `thenPrimIO` \ rc ->
281 createDirectory :: FilePath -> FileMode -> IO ()
282 createDirectory name mode = -- NB: diff signature from LibDirectory one!
283 _packBytesForCST name `thenStrictlyST` \ dir ->
284 _ccall_ mkdir dir mode `thenPrimIO` \ rc ->
288 syserr "createDirectory"
290 createNamedPipe :: FilePath -> FileMode -> IO ()
291 createNamedPipe name mode =
292 _packBytesForCST name `thenStrictlyST` \ pipe ->
293 _ccall_ mkfifo pipe mode `thenPrimIO` \ rc ->
297 syserr "createNamedPipe"
299 removeLink :: FilePath -> IO ()
301 _packBytesForCST name `thenStrictlyST` \ path ->
302 _ccall_ unlink path `thenPrimIO` \ rc ->
308 {- USE LibDirectory ONE:
309 removeDirectory :: FilePath -> IO ()
310 removeDirectory name =
311 _packBytesForCST name `thenStrictlyST` \ dir ->
312 _ccall_ rmdir dir `thenPrimIO` \ rc ->
316 syserr "removeDirectory"
319 rename :: FilePath -> FilePath -> IO ()
321 _packBytesForCST name1 `thenStrictlyST` \ path1 ->
322 _packBytesForCST name2 `thenStrictlyST` \ path2 ->
323 _ccall_ rename path1 path2 `thenPrimIO` \ rc ->
329 type FileStatus = _ByteArray ()
333 fileMode :: FileStatus -> FileMode
334 fileMode stat = unsafePerformPrimIO (
335 _casm_ ``%r = ((struct stat *)%0)->st_mode;'' stat
336 `thenStrictlyST` \ mode ->
339 fileID :: FileStatus -> FileID
340 fileID stat = unsafePerformPrimIO (
341 _casm_ ``%r = ((struct stat *)%0)->st_ino;'' stat
342 `thenStrictlyST` \ ino ->
345 deviceID :: FileStatus -> DeviceID
346 deviceID stat = unsafePerformPrimIO (
347 _casm_ ``%r = ((struct stat *)%0)->st_dev;'' stat
348 `thenStrictlyST` \ dev ->
351 linkCount :: FileStatus -> LinkCount
352 linkCount stat = unsafePerformPrimIO (
353 _casm_ ``%r = ((struct stat *)%0)->st_nlink;'' stat
354 `thenStrictlyST` \ nlink ->
357 fileOwner :: FileStatus -> UserID
358 fileOwner stat = unsafePerformPrimIO (
359 _casm_ ``%r = ((struct stat *)%0)->st_uid;'' stat
360 `thenStrictlyST` \ uid ->
363 fileGroup :: FileStatus -> GroupID
364 fileGroup stat = unsafePerformPrimIO (
365 _casm_ ``%r = ((struct stat *)%0)->st_gid;'' stat
366 `thenStrictlyST` \ gid ->
369 fileSize :: FileStatus -> FileOffset
370 fileSize stat = unsafePerformPrimIO (
371 _casm_ ``%r = ((struct stat *)%0)->st_size;'' stat
372 `thenStrictlyST` \ size ->
375 accessTime :: FileStatus -> EpochTime
376 accessTime stat = unsafePerformPrimIO (
377 _casm_ ``%r = ((struct stat *)%0)->st_atime;'' stat
378 `thenStrictlyST` \ atime ->
381 modificationTime :: FileStatus -> EpochTime
382 modificationTime stat = unsafePerformPrimIO (
383 _casm_ ``%r = ((struct stat *)%0)->st_mtime;'' stat
384 `thenStrictlyST` \ mtime ->
387 statusChangeTime :: FileStatus -> EpochTime
388 statusChangeTime stat = unsafePerformPrimIO (
389 _casm_ ``%r = ((struct stat *)%0)->st_ctime;'' stat
390 `thenStrictlyST` \ ctime ->
393 isDirectory :: FileStatus -> Bool
394 isDirectory stat = unsafePerformPrimIO (
395 _casm_ ``%r = S_ISDIR(((struct stat *)%0)->st_mode);'' stat
396 `thenStrictlyST` \ rc ->
397 returnPrimIO (rc /= 0))
399 isCharacterDevice :: FileStatus -> Bool
400 isCharacterDevice stat = unsafePerformPrimIO (
401 _casm_ ``%r = S_ISCHR(((struct stat *)%0)->st_mode);'' stat
402 `thenStrictlyST` \ rc ->
403 returnPrimIO (rc /= 0))
405 isBlockDevice :: FileStatus -> Bool
406 isBlockDevice stat = unsafePerformPrimIO (
407 _casm_ ``%r = S_ISBLK(((struct stat *)%0)->st_mode);'' stat
408 `thenStrictlyST` \ rc ->
409 returnPrimIO (rc /= 0))
411 isRegularFile :: FileStatus -> Bool
412 isRegularFile stat = unsafePerformPrimIO (
413 _casm_ ``%r = S_ISREG(((struct stat *)%0)->st_mode);'' stat
414 `thenStrictlyST` \ rc ->
415 returnPrimIO (rc /= 0))
417 isNamedPipe :: FileStatus -> Bool
418 isNamedPipe stat = unsafePerformPrimIO (
419 _casm_ ``%r = S_ISFIFO(((struct stat *)%0)->st_mode);'' stat
420 `thenStrictlyST` \ rc ->
421 returnPrimIO (rc /= 0))
423 getFileStatus :: FilePath -> IO FileStatus
425 _packBytesForCST name `thenStrictlyST` \ path ->
426 allocChars ``sizeof(struct stat)'' `thenStrictlyST` \ bytes ->
427 _casm_ ``%r = stat(%0,(struct stat *)%1);'' path bytes
430 freeze bytes `thenStrictlyST` \ stat ->
433 syserr "getFileStatus"
435 getChannelStatus :: Channel -> IO FileStatus
436 getChannelStatus fd =
437 allocChars ``sizeof(struct stat)'' `thenStrictlyST` \ bytes ->
438 _casm_ ``%r = fstat(%0,(struct stat *)%1);'' fd bytes
441 freeze bytes `thenStrictlyST` \ stat ->
444 syserr "getChannelStatus"
446 queryAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
447 queryAccess name read write exec =
448 _packBytesForCST name `thenStrictlyST` \ path ->
449 _ccall_ access path flags `thenPrimIO` \ rc ->
452 flags = I# (word2Int# (read# `or#` write# `or#` exec#))
453 read# = case (if read then ``R_OK'' else ``0'') of { W# x -> x }
454 write# = case (if write then ``W_OK'' else ``0'') of { W# x -> x }
455 exec# = case (if exec then ``X_OK'' else ``0'') of { W# x -> x }
457 queryFile :: FilePath -> IO Bool
459 _packBytesForCST name `thenStrictlyST` \ path ->
460 _ccall_ access path (``F_OK''::Int) `thenPrimIO` \ rc ->
463 setFileMode :: FilePath -> FileMode -> IO ()
464 setFileMode name mode =
465 _packBytesForCST name `thenStrictlyST` \ path ->
466 _ccall_ chmod path mode `thenPrimIO` \ rc ->
472 setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
473 setOwnerAndGroup name uid gid =
474 _packBytesForCST name `thenStrictlyST` \ path ->
475 _ccall_ chown path uid gid `thenPrimIO` \ rc ->
479 syserr "setOwnerAndGroup"
481 setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
482 setFileTimes name atime mtime =
483 _packBytesForCST name `thenStrictlyST` \ path ->
484 _casm_ ``do {struct utimbuf ub; ub.actime = (time_t) %0; ub.modtime = (time_t) %1;
485 %r = utime(%2, &ub);} while(0);'' atime mtime path
490 syserr "setFileTimes"
492 touchFile :: FilePath -> IO ()
494 _packBytesForCST name `thenStrictlyST` \ path ->
495 _ccall_ utime path (``NULL''::_Addr) `thenPrimIO` \ rc ->
501 data PathVar = LinkLimit
507 | SetOwnerAndGroupIsRestricted
508 | FileNamesAreNotTruncated
510 getPathVar :: PathVar -> FilePath -> IO Limit
513 LinkLimit -> pathconf ``_PC_LINK_MAX''
514 InputLineLimit -> pathconf ``_PC_MAX_CANON''
515 InputQueueLimit -> pathconf ``_PC_MAX_INPUT''
516 FileNameLimit -> pathconf ``_PC_NAME_MAX''
517 PathNameLimit -> pathconf ``_PC_PATH_MAX''
518 PipeBufferLimit -> pathconf ``_PC_PIPE_BUF''
519 SetOwnerAndGroupIsRestricted -> pathconf ``_PC_CHOWN_RESTRICTED''
520 FileNamesAreNotTruncated -> pathconf ``_PC_NO_TRUNC''
522 pathconf :: Int -> IO Limit
524 _packBytesForCST name `thenStrictlyST` \ path ->
525 _ccall_ pathconf path n `thenPrimIO` \ rc ->
529 getErrorCode >>= \ errno ->
530 if errno == invalidArgument then
531 failWith (NoSuchThing "no such path limit or option")
535 getChannelVar :: PathVar -> Channel -> IO Limit
538 LinkLimit -> fpathconf ``_PC_LINK_MAX''
539 InputLineLimit -> fpathconf ``_PC_MAX_CANON''
540 InputQueueLimit -> fpathconf ``_PC_MAX_INPUT''
541 FileNameLimit -> fpathconf ``_PC_NAME_MAX''
542 PathNameLimit -> fpathconf ``_PC_PATH_MAX''
543 PipeBufferLimit -> fpathconf ``_PC_PIPE_BUF''
544 SetOwnerAndGroupIsRestricted -> fpathconf ``_PC_CHOWN_RESTRICTED''
545 FileNamesAreNotTruncated -> fpathconf ``_PC_NO_TRUNC''
547 fpathconf :: Int -> IO Limit
549 _ccall_ fpathconf fd n `thenPrimIO` \ rc ->
553 getErrorCode >>= \ errno ->
554 if errno == invalidArgument then
555 failWith (NoSuchThing "no such path limit or option")