{-# LINE 1 "System/Posix/Files/ByteString.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE CApiFFI #-}
module System.Posix.Files.ByteString (
unionFileModes, intersectFileModes,
nullFileMode,
ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
setUserIDMode, setGroupIDMode,
stdFileMode, accessModes,
fileTypeModes,
blockSpecialMode, characterSpecialMode, namedPipeMode, regularFileMode,
directoryMode, symbolicLinkMode, socketMode,
setFileMode, setFdMode, setFileCreationMask,
fileAccess, fileExist,
FileStatus,
getFileStatus, getFdStatus, getSymbolicLinkStatus,
deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
specialDeviceID, fileSize, accessTime, modificationTime,
statusChangeTime,
accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
isDirectory, isSymbolicLink, isSocket,
fileBlockSize,
fileBlocks,
createNamedPipe,
createDevice,
createLink, removeLink,
createSymbolicLink, readSymbolicLink,
rename,
setOwnerAndGroup, setFdOwnerAndGroup,
{-# LINE 81 "System/Posix/Files/ByteString.hsc" #-}
setSymbolicLinkOwnerAndGroup,
{-# LINE 83 "System/Posix/Files/ByteString.hsc" #-}
setFileTimes, setFileTimesHiRes,
setFdTimesHiRes, setSymbolicLinkTimesHiRes,
touchFile, touchFd, touchSymbolicLink,
setFileSize, setFdSize,
PathVar(..), getPathVar, getFdPathVar,
) where
import System.Posix.Types
import System.Posix.Internals hiding (withFilePath, peekFilePathLen)
import Foreign
import Foreign.C hiding (
throwErrnoPath,
throwErrnoPathIf,
throwErrnoPathIf_,
throwErrnoPathIfNull,
throwErrnoPathIfMinus1,
throwErrnoPathIfMinus1_ )
import System.Posix.Files.Common
import System.Posix.ByteString.FilePath
import Data.Time.Clock.POSIX (POSIXTime)
{-# LINE 116 "System/Posix/Files/ByteString.hsc" #-}
setFileMode :: RawFilePath -> FileMode -> IO ()
setFileMode name m =
withFilePath name $ \s -> do
throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
fileAccess :: RawFilePath -> Bool -> Bool -> Bool -> IO Bool
fileAccess name readOK writeOK execOK = access name flags
where
flags = read_f .|. write_f .|. exec_f
read_f = if readOK then (4) else 0
{-# LINE 145 "System/Posix/Files/ByteString.hsc" #-}
write_f = if writeOK then (2) else 0
{-# LINE 146 "System/Posix/Files/ByteString.hsc" #-}
exec_f = if execOK then (1) else 0
{-# LINE 147 "System/Posix/Files/ByteString.hsc" #-}
fileExist :: RawFilePath -> IO Bool
fileExist name =
withFilePath name $ \s -> do
r <- c_access s (0)
{-# LINE 155 "System/Posix/Files/ByteString.hsc" #-}
if (r == 0)
then return True
else do err <- getErrno
if (err == eNOENT)
then return False
else throwErrnoPath "fileExist" name
access :: RawFilePath -> CMode -> IO Bool
access name flags =
withFilePath name $ \s -> do
r <- c_access s (fromIntegral flags)
if (r == 0)
then return True
else do err <- getErrno
if (err == eACCES || err == eROFS || err == eTXTBSY ||
err == ePERM)
then return False
else throwErrnoPath "fileAccess" name
getFileStatus :: RawFilePath -> IO FileStatus
getFileStatus path = do
fp <- mallocForeignPtrBytes (144)
{-# LINE 182 "System/Posix/Files/ByteString.hsc" #-}
withForeignPtr fp $ \p ->
withFilePath path $ \s ->
throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
return (FileStatus fp)
getSymbolicLinkStatus :: RawFilePath -> IO FileStatus
getSymbolicLinkStatus path = do
fp <- mallocForeignPtrBytes (144)
{-# LINE 195 "System/Posix/Files/ByteString.hsc" #-}
withForeignPtr fp $ \p ->
withFilePath path $ \s ->
throwErrnoPathIfMinus1_ "getSymbolicLinkStatus" path (c_lstat s p)
return (FileStatus fp)
foreign import capi unsafe "HsUnix.h lstat"
c_lstat :: CString -> Ptr CStat -> IO CInt
createNamedPipe :: RawFilePath -> FileMode -> IO ()
createNamedPipe name mode = do
withFilePath name $ \s ->
throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode)
{-# LINE 222 "System/Posix/Files/ByteString.hsc" #-}
createDevice :: RawFilePath -> FileMode -> DeviceID -> IO ()
createDevice path mode dev =
withFilePath path $ \s ->
throwErrnoPathIfMinus1_ "createDevice" path (c_mknod s mode dev)
foreign import capi unsafe "HsUnix.h mknod"
c_mknod :: CString -> CMode -> CDev -> IO CInt
{-# LINE 240 "System/Posix/Files/ByteString.hsc" #-}
createLink :: RawFilePath -> RawFilePath -> IO ()
createLink name1 name2 =
withFilePath name1 $ \s1 ->
withFilePath name2 $ \s2 ->
throwErrnoTwoPathsIfMinus1_ "createLink" name1 name2 (c_link s1 s2)
removeLink :: RawFilePath -> IO ()
removeLink name =
withFilePath name $ \s ->
throwErrnoPathIfMinus1_ "removeLink" name (c_unlink s)
createSymbolicLink :: RawFilePath -> RawFilePath -> IO ()
createSymbolicLink name1 name2 =
withFilePath name1 $ \s1 ->
withFilePath name2 $ \s2 ->
throwErrnoTwoPathsIfMinus1_ "createSymbolicLink" name1 name2 (c_symlink s1 s2)
foreign import ccall unsafe "symlink"
c_symlink :: CString -> CString -> IO CInt
{-# LINE 289 "System/Posix/Files/ByteString.hsc" #-}
readSymbolicLink :: RawFilePath -> IO RawFilePath
readSymbolicLink file =
allocaArray0 (4096) $ \buf -> do
{-# LINE 296 "System/Posix/Files/ByteString.hsc" #-}
withFilePath file $ \s -> do
len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
c_readlink s buf (4096)
{-# LINE 299 "System/Posix/Files/ByteString.hsc" #-}
peekFilePathLen (buf,fromIntegral len)
foreign import ccall unsafe "readlink"
c_readlink :: CString -> CString -> CSize -> IO CInt
rename :: RawFilePath -> RawFilePath -> IO ()
rename name1 name2 =
withFilePath name1 $ \s1 ->
withFilePath name2 $ \s2 ->
throwErrnoTwoPathsIfMinus1_ "rename" name1 name2 (c_rename s1 s2)
foreign import ccall unsafe "rename"
c_rename :: CString -> CString -> IO CInt
{-# LINE 323 "System/Posix/Files/ByteString.hsc" #-}
setOwnerAndGroup :: RawFilePath -> UserID -> GroupID -> IO ()
setOwnerAndGroup name uid gid = do
withFilePath name $ \s ->
throwErrnoPathIfMinus1_ "setOwnerAndGroup" name (c_chown s uid gid)
foreign import ccall unsafe "chown"
c_chown :: CString -> CUid -> CGid -> IO CInt
{-# LINE 345 "System/Posix/Files/ByteString.hsc" #-}
{-# LINE 347 "System/Posix/Files/ByteString.hsc" #-}
setSymbolicLinkOwnerAndGroup :: RawFilePath -> UserID -> GroupID -> IO ()
setSymbolicLinkOwnerAndGroup name uid gid = do
withFilePath name $ \s ->
throwErrnoPathIfMinus1_ "setSymbolicLinkOwnerAndGroup" name
(c_lchown s uid gid)
foreign import ccall unsafe "lchown"
c_lchown :: CString -> CUid -> CGid -> IO CInt
{-# LINE 360 "System/Posix/Files/ByteString.hsc" #-}
setFileTimes :: RawFilePath -> EpochTime -> EpochTime -> IO ()
setFileTimes name atime mtime = do
withFilePath name $ \s ->
allocaBytes (16) $ \p -> do
{-# LINE 372 "System/Posix/Files/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p atime
{-# LINE 373 "System/Posix/Files/ByteString.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p mtime
{-# LINE 374 "System/Posix/Files/ByteString.hsc" #-}
throwErrnoPathIfMinus1_ "setFileTimes" name (c_utime s p)
setFileTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
{-# LINE 385 "System/Posix/Files/ByteString.hsc" #-}
setFileTimesHiRes name atime mtime =
withFilePath name $ \s ->
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
c_utimensat (-100) s times 0
{-# LINE 390 "System/Posix/Files/ByteString.hsc" #-}
{-# LINE 396 "System/Posix/Files/ByteString.hsc" #-}
setSymbolicLinkTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
{-# LINE 408 "System/Posix/Files/ByteString.hsc" #-}
setSymbolicLinkTimesHiRes name atime mtime =
withFilePath name $ \s ->
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
c_utimensat (-100) s times (256)
{-# LINE 413 "System/Posix/Files/ByteString.hsc" #-}
{-# LINE 424 "System/Posix/Files/ByteString.hsc" #-}
touchFile :: RawFilePath -> IO ()
touchFile name = do
withFilePath name $ \s ->
throwErrnoPathIfMinus1_ "touchFile" name (c_utime s nullPtr)
touchSymbolicLink :: RawFilePath -> IO ()
{-# LINE 441 "System/Posix/Files/ByteString.hsc" #-}
touchSymbolicLink name =
withFilePath name $ \s ->
throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)
{-# LINE 449 "System/Posix/Files/ByteString.hsc" #-}
setFileSize :: RawFilePath -> FileOffset -> IO ()
setFileSize file off =
withFilePath file $ \s ->
throwErrnoPathIfMinus1_ "setFileSize" file (c_truncate s off)
foreign import capi unsafe "HsUnix.h truncate"
c_truncate :: CString -> COff -> IO CInt
getPathVar :: RawFilePath -> PathVar -> IO Limit
getPathVar name v = do
withFilePath name $ \ nameP ->
throwErrnoPathIfMinus1 "getPathVar" name $
c_pathconf nameP (pathVarConst v)
foreign import ccall unsafe "pathconf"
c_pathconf :: CString -> CInt -> IO CLong