unix-compat-0.4.1.3: src/System/PosixCompat/Files.hsc
{-# LANGUAGE CPP #-}
{-|
This module makes the operations exported by @System.Posix.Files@
available on all platforms. On POSIX systems it re-exports operations from
@System.Posix.Files@. On other platforms it emulates the operations as far
as possible.
/NOTE: the portable implementations are not well tested, in some cases
functions are only stubs./
-}
module System.PosixCompat.Files (
-- * File modes
-- FileMode exported by System.Posix.Types
unionFileModes
, intersectFileModes
, nullFileMode
, ownerReadMode
, ownerWriteMode
, ownerExecuteMode
, ownerModes
, groupReadMode
, groupWriteMode
, groupExecuteMode
, groupModes
, otherReadMode
, otherWriteMode
, otherExecuteMode
, otherModes
, setUserIDMode
, setGroupIDMode
, stdFileMode
, accessModes
-- ** Setting file modes
, setFileMode
, setFdMode
, setFileCreationMask
-- ** Checking file existence and permissions
, fileAccess
, fileExist
-- * File status
, FileStatus
-- ** Obtaining file status
, getFileStatus
, getFdStatus
, getSymbolicLinkStatus
-- ** Querying file status
, deviceID
, fileID
, fileMode
, linkCount
, fileOwner
, fileGroup
, specialDeviceID
, fileSize
, accessTime
, modificationTime
, statusChangeTime
, isBlockDevice
, isCharacterDevice
, isNamedPipe
, isRegularFile
, isDirectory
, isSymbolicLink
, isSocket
-- * Creation
, createNamedPipe
, createDevice
-- * Hard links
, createLink
, removeLink
-- * Symbolic links
, createSymbolicLink
, readSymbolicLink
-- * Renaming files
, rename
-- * Changing file ownership
, setOwnerAndGroup
, setFdOwnerAndGroup
, setSymbolicLinkOwnerAndGroup
-- * Changing file timestamps
, setFileTimes
, touchFile
-- * Setting file sizes
, setFileSize
, setFdSize
-- * Find system-specific limits for a file
, PathVar(..)
, getPathVar
, getFdPathVar
) where
#ifndef mingw32_HOST_OS
#include "HsUnixCompat.h"
import System.Posix.Files
#if NEED_setSymbolicLinkOwnerAndGroup
import System.PosixCompat.Types
setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
setSymbolicLinkOwnerAndGroup _ _ _ = return ()
#endif
#else /* Portable implementation */
import Control.Exception (bracket)
import Control.Monad (liftM, liftM2)
import Data.Bits ((.|.), (.&.))
import Prelude hiding (read)
import System.Directory
import System.IO (IOMode(..), openFile, hFileSize, hSetFileSize, hClose)
import System.IO.Error
import System.PosixCompat.Types
import System.Win32.File hiding (getFileType)
import System.PosixCompat.Internal.Time (
getClockTime, clockTimeToEpochTime
, modificationTimeToEpochTime
)
#ifdef __GLASGOW_HASKELL__
import GHC.IO.Handle.FD (fdToHandle)
#endif
unsupported :: String -> IO a
unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
where
x = "System.PosixCompat.Files." ++ f ++ ": not supported"
-- -----------------------------------------------------------------------------
-- POSIX file modes
nullFileMode :: FileMode
nullFileMode = 0o000000
ownerReadMode :: FileMode
ownerWriteMode :: FileMode
ownerExecuteMode :: FileMode
groupReadMode :: FileMode
groupWriteMode :: FileMode
groupExecuteMode :: FileMode
otherReadMode :: FileMode
otherWriteMode :: FileMode
otherExecuteMode :: FileMode
setUserIDMode :: FileMode
setGroupIDMode :: FileMode
ownerReadMode = 0o000400
ownerWriteMode = 0o000200
ownerExecuteMode = 0o000100
groupReadMode = 0o000040
groupWriteMode = 0o000020
groupExecuteMode = 0o000010
otherReadMode = 0o000004
otherWriteMode = 0o000002
otherExecuteMode = 0o000001
setUserIDMode = 0o004000
setGroupIDMode = 0o002000
stdFileMode :: FileMode
ownerModes :: FileMode
groupModes :: FileMode
otherModes :: FileMode
accessModes :: FileMode
stdFileMode = ownerReadMode .|. ownerWriteMode .|.
groupReadMode .|. groupWriteMode .|.
otherReadMode .|. otherWriteMode
ownerModes = ownerReadMode .|. ownerWriteMode .|. ownerExecuteMode
groupModes = groupReadMode .|. groupWriteMode .|. groupExecuteMode
otherModes = otherReadMode .|. otherWriteMode .|. otherExecuteMode
accessModes = ownerModes .|. groupModes .|. otherModes
unionFileModes :: FileMode -> FileMode -> FileMode
unionFileModes m1 m2 = m1 .|. m2
intersectFileModes :: FileMode -> FileMode -> FileMode
intersectFileModes m1 m2 = m1 .&. m2
fileTypeModes :: FileMode
fileTypeModes = 0o0170000
blockSpecialMode :: FileMode
characterSpecialMode :: FileMode
namedPipeMode :: FileMode
regularFileMode :: FileMode
directoryMode :: FileMode
symbolicLinkMode :: FileMode
socketMode :: FileMode
blockSpecialMode = 0o0060000
characterSpecialMode = 0o0020000
namedPipeMode = 0o0010000
regularFileMode = 0o0100000
directoryMode = 0o0040000
symbolicLinkMode = 0o0120000
socketMode = 0o0140000
setFileMode :: FilePath -> FileMode -> IO ()
setFileMode name m = setPermissions name $ modeToPerms m
setFdMode :: Fd -> FileMode -> IO ()
setFdMode _ _ = unsupported "setFdMode"
-- | The portable implementation does nothing and returns 'nullFileMode'.
setFileCreationMask :: FileMode -> IO FileMode
setFileCreationMask _ = return nullFileMode
modeToPerms :: FileMode -> Permissions
#ifdef DIRECTORY_1_0
modeToPerms m = Permissions
{ readable = m .&. ownerReadMode /= 0
, writable = m .&. ownerWriteMode /= 0
, executable = m .&. ownerExecuteMode /= 0
, searchable = m .&. ownerExecuteMode /= 0 }
#else
modeToPerms m =
setOwnerReadable (m .&. ownerReadMode /= 0) $
setOwnerWritable (m .&. ownerWriteMode /= 0) $
setOwnerExecutable (m .&. ownerExecuteMode /= 0) $
setOwnerSearchable (m .&. ownerExecuteMode /= 0) $
emptyPermissions
#endif
-- -----------------------------------------------------------------------------
-- access()
fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
fileAccess name read write exec =
do perm <- getPermissions name
return $ (not read || readable perm)
&& (not write || writable perm)
&& (not exec || executable perm || searchable perm)
fileExist :: FilePath -> IO Bool
fileExist name = liftM2 (||) (doesFileExist name) (doesDirectoryExist name)
-- -----------------------------------------------------------------------------
-- stat() support
data FileStatus = FileStatus
{ deviceID :: DeviceID
, fileID :: FileID
, fileMode :: FileMode
, linkCount :: LinkCount
, fileOwner :: UserID
, fileGroup :: GroupID
, specialDeviceID :: DeviceID
, fileSize :: FileOffset
, accessTime :: EpochTime
, modificationTime :: EpochTime
, statusChangeTime :: EpochTime
}
isBlockDevice :: FileStatus -> Bool
isBlockDevice stat =
(fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode
isCharacterDevice :: FileStatus -> Bool
isCharacterDevice stat =
(fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode
isNamedPipe :: FileStatus -> Bool
isNamedPipe stat =
(fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode
isRegularFile :: FileStatus -> Bool
isRegularFile stat =
(fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode
isDirectory :: FileStatus -> Bool
isDirectory stat =
(fileMode stat `intersectFileModes` fileTypeModes) == directoryMode
isSymbolicLink :: FileStatus -> Bool
isSymbolicLink stat =
(fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode
isSocket :: FileStatus -> Bool
isSocket stat =
(fileMode stat `intersectFileModes` fileTypeModes) == socketMode
getFileStatus :: FilePath -> IO FileStatus
getFileStatus path = do
perm <- liftM permsToMode (getPermissions path)
typ <- getFileType path
size <- if typ == regularFileMode then getFileSize path else return 0
mtime <- liftM modificationTimeToEpochTime (getModificationTime path)
info <- bracket openPath closeHandle getFileInformationByHandle
return $ FileStatus
{ deviceID = fromIntegral (bhfiVolumeSerialNumber info)
, fileID = fromIntegral (bhfiFileIndex info)
, fileMode = typ .|. perm
, linkCount = fromIntegral (bhfiNumberOfLinks info)
, fileOwner = 0
, fileGroup = 0
, specialDeviceID = 0
, fileSize = size
, accessTime = mtime
, modificationTime = mtime
, statusChangeTime = mtime }
where
openPath = createFile path
gENERIC_READ
(fILE_SHARE_READ .|. fILE_SHARE_WRITE .|. fILE_SHARE_DELETE)
Nothing
oPEN_EXISTING
(sECURITY_ANONYMOUS .|. fILE_FLAG_BACKUP_SEMANTICS)
Nothing
permsToMode :: Permissions -> FileMode
permsToMode perms = r .|. w .|. x
where
r = f (readable perms) (ownerReadMode .|. groupReadMode .|. otherReadMode)
w = f (writable perms) (ownerWriteMode .|. groupWriteMode .|. otherWriteMode)
x = f (executable perms || searchable perms)
(ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode)
f True m = m
f False _ = nullFileMode
getFileType :: FilePath -> IO FileMode
getFileType path =
do f <- doesFileExist path
if f then return regularFileMode
else do d <- doesDirectoryExist path
if d then return directoryMode
else unsupported "Unknown file type."
getFileSize :: FilePath -> IO FileOffset
getFileSize path =
bracket (openFile path ReadMode) hClose (liftM fromIntegral . hFileSize)
getFdStatus :: Fd -> IO FileStatus
getFdStatus _ = unsupported "getFdStatus"
getSymbolicLinkStatus :: FilePath -> IO FileStatus
getSymbolicLinkStatus path = getFileStatus path
createNamedPipe :: FilePath -> FileMode -> IO ()
createNamedPipe _ _ = unsupported "createNamedPipe"
createDevice :: FilePath -> FileMode -> DeviceID -> IO ()
createDevice _ _ _ = unsupported "createDevice"
-- -----------------------------------------------------------------------------
-- Hard links
createLink :: FilePath -> FilePath -> IO ()
createLink _ _ = unsupported "createLink"
removeLink :: FilePath -> IO ()
removeLink _ = unsupported "removeLink"
-- -----------------------------------------------------------------------------
-- Symbolic Links
createSymbolicLink :: FilePath -> FilePath -> IO ()
createSymbolicLink _ _ = unsupported "createSymbolicLink"
readSymbolicLink :: FilePath -> IO FilePath
readSymbolicLink _ = unsupported "readSymbolicLink"
-- -----------------------------------------------------------------------------
-- Renaming files
rename :: FilePath -> FilePath -> IO ()
rename name1 name2 = renameFile name1 name2
-- -----------------------------------------------------------------------------
-- chown()
-- | The portable implementation does nothing.
setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
setOwnerAndGroup _ _ _ = return ()
-- | The portable implementation does nothing.
setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
setFdOwnerAndGroup _ _ _ = return ()
-- | The portable implementation does nothing.
setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
setSymbolicLinkOwnerAndGroup _ _ _ = return ()
-- -----------------------------------------------------------------------------
-- utime()
setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
setFileTimes _ _ _ = unsupported "setFileTimes"
touchFile :: FilePath -> IO ()
touchFile name =
do t <- liftM clockTimeToEpochTime getClockTime
setFileTimes name t t
-- -----------------------------------------------------------------------------
-- Setting file sizes
setFileSize :: FilePath -> FileOffset -> IO ()
setFileSize file off =
bracket (openFile file WriteMode) (hClose)
(\h -> hSetFileSize h (fromIntegral off))
setFdSize :: Fd -> FileOffset -> IO ()
#ifdef __GLASGOW_HASKELL__
setFdSize (Fd fd) off =
do h <- fdToHandle (fromIntegral fd)
hSetFileSize h (fromIntegral off)
#else
setFdSize fd off = unsupported "setFdSize"
#endif
-- -----------------------------------------------------------------------------
-- pathconf()/fpathconf() support
data PathVar
= FileSizeBits -- _PC_FILESIZEBITS
| LinkLimit -- _PC_LINK_MAX
| InputLineLimit -- _PC_MAX_CANON
| InputQueueLimit -- _PC_MAX_INPUT
| FileNameLimit -- _PC_NAME_MAX
| PathNameLimit -- _PC_PATH_MAX
| PipeBufferLimit -- _PC_PIPE_BUF
-- These are described as optional in POSIX:
-- _PC_ALLOC_SIZE_MIN
-- _PC_REC_INCR_XFER_SIZE
-- _PC_REC_MAX_XFER_SIZE
-- _PC_REC_MIN_XFER_SIZE
-- _PC_REC_XFER_ALIGN
| SymbolicLinkLimit -- _PC_SYMLINK_MAX
| SetOwnerAndGroupIsRestricted -- _PC_CHOWN_RESTRICTED
| FileNamesAreNotTruncated -- _PC_NO_TRUNC
| VDisableChar -- _PC_VDISABLE
| AsyncIOAvailable -- _PC_ASYNC_IO
| PrioIOAvailable -- _PC_PRIO_IO
| SyncIOAvailable -- _PC_SYNC_IO
getPathVar :: FilePath -> PathVar -> IO Limit
getPathVar _ _ = unsupported "getPathVar"
getFdPathVar :: Fd -> PathVar -> IO Limit
getFdPathVar _ _ = unsupported "getFdPathVar"
#endif