unix-compat 0.1.2.1 → 0.2
raw patch · 13 files changed
+740/−662 lines, 13 filesdep ~basedep ~directorydep ~old-timenew-uploader
Dependency ranges changed: base, directory, old-time, unix
Files
- System/PosixCompat/Extensions.hsc +0/−52
- System/PosixCompat/Files.hsc +0/−411
- System/PosixCompat/Types.hs +0/−32
- System/PosixCompat/User.hsc +0/−135
- cbits/HsUnixCompat.c +5/−0
- include/HsUnixCompat.h +1/−0
- src/System/PosixCompat.hs +27/−0
- src/System/PosixCompat/Extensions.hsc +53/−0
- src/System/PosixCompat/Files.hsc +404/−0
- src/System/PosixCompat/Time.hs +31/−0
- src/System/PosixCompat/Types.hs +39/−0
- src/System/PosixCompat/User.hsc +133/−0
- unix-compat.cabal +47/−32
− System/PosixCompat/Extensions.hsc
@@ -1,52 +0,0 @@--- | This module provides some functions not present in the unix package.-module System.PosixCompat.Extensions (- -- * Device IDs.- CMajor, CMinor,- deviceMajor, deviceMinor, makeDeviceID- ) where---#if UNIX_IMPL-#include "HsUnixCompat.h"-#endif--import Foreign.C.Types-import System.PosixCompat.Types---type CMajor = CUInt-type CMinor = CUInt---- | Gets the major number from a 'DeviceID' for a device file.--- --- The portable implementation always returns @0@.-deviceMajor :: DeviceID -> CMajor-#if UNIX_IMPL-deviceMajor dev = unix_major dev--foreign import ccall unsafe "unix_major" unix_major :: CDev -> CUInt-#else-deviceMajor _ = 0-#endif---- | Gets the minor number from a 'DeviceID' for a device file.--- --- The portable implementation always returns @0@.-deviceMinor :: DeviceID -> CMinor-#if UNIX_IMPL-deviceMinor dev = unix_minor dev--foreign import ccall unsafe "unix_minor" unix_minor :: CDev -> CUInt-#else-deviceMinor _ = 0-#endif---- | Creates a 'DeviceID' for a device file given a major and minor number.-makeDeviceID :: CMajor -> CMinor -> DeviceID-#if UNIX_IMPL-makeDeviceID ma mi = unix_makedev ma mi--foreign import ccall unsafe "unix_makedev" unix_makedev :: CUInt -> CUInt -> CDev-#else-makeDeviceID _ _ = 0-#endif
− System/PosixCompat/Files.hsc
@@ -1,411 +0,0 @@--- | 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 this--- operations as far as possible.------ NOTE: the portable implementations are not well tested.-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--#if UNIX_IMPL--#include "HsUnixCompat.h"--import System.Posix.Files--#if NEED_setSymbolicLinkOwnerAndGroup-import System.PosixCompat.Types-#endif--#else /* Portable implementation */--import Control.Exception (bracket)-import Control.Monad (liftM, liftM2)-import Data.Bits ((.|.), (.&.))-import System.Directory (renameFile, doesFileExist, doesDirectoryExist, - Permissions(..), getPermissions, setPermissions,- getModificationTime)-import System.IO (IOMode(..), openFile, hFileSize, hSetFileSize, hClose)-import System.IO.Error-import System.PosixCompat.Types-import System.Time (ClockTime(..), getClockTime)--#if __GLASGOW_HASKELL__-import GHC.Handle (fdToHandle)-#endif---#endif----#if UNIX_IMPL--#if NEED_setSymbolicLinkOwnerAndGroup-setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()-setSymbolicLinkOwnerAndGroup name uid gid = return ()-#endif---#else /* Portable implementations */--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 fd m = unsupported "setFdMode"---- | The portable implementation does nothing and returns 'nullFileMode'.-setFileCreationMask :: FileMode -> IO FileMode-setFileCreationMask mask = return nullFileMode--modeToPerms :: FileMode -> Permissions-modeToPerms m = Permissions {- readable = m .&. ownerReadMode /= 0,- writable = m .&. ownerWriteMode /= 0,- executable = m .&. ownerExecuteMode /= 0,- searchable = m .&. ownerExecuteMode /= 0- }---- -------------------------------------------------------------------------------- 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 clockTimeToEpochTime $ getModificationTime path- return $ FileStatus {- deviceID = -1,- fileID = -1,- fileMode = typ .|. perm,- linkCount = 1,- fileOwner = 0,- fileGroup = 0,- specialDeviceID = 0,- fileSize = size,- accessTime = mtime,- modificationTime = mtime,- statusChangeTime = mtime- }--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)--clockTimeToEpochTime :: ClockTime -> EpochTime-clockTimeToEpochTime (TOD s _) = fromInteger s---getFdStatus :: Fd -> IO FileStatus-getFdStatus fd = unsupported "getFdStatus"--getSymbolicLinkStatus :: FilePath -> IO FileStatus-getSymbolicLinkStatus path = getFileStatus path--createNamedPipe :: FilePath -> FileMode -> IO ()-createNamedPipe name mode = unsupported "createNamedPipe"--createDevice :: FilePath -> FileMode -> DeviceID -> IO ()-createDevice path mode dev = unsupported "createDevice"---- -------------------------------------------------------------------------------- Hard links--createLink :: FilePath -> FilePath -> IO ()-createLink name1 name2 = unsupported "createLink"--removeLink :: FilePath -> IO ()-removeLink name = unsupported "removeLink"---- -------------------------------------------------------------------------------- Symbolic Links--createSymbolicLink :: FilePath -> FilePath -> IO ()-createSymbolicLink file1 file2 = unsupported "createSymbolicLink"--readSymbolicLink :: FilePath -> IO FilePath-readSymbolicLink file = 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 name uid gid = return ()---- | The portable implementation does nothing.-setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()-setFdOwnerAndGroup fd uid gid = return ()---- | The portable implementation does nothing.-setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()-setSymbolicLinkOwnerAndGroup name uid gid = return ()---- -------------------------------------------------------------------------------- utime()--setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()-setFileTimes name atime mtime = 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 ()-#if __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 name v = unsupported "getPathVar"--getFdPathVar :: Fd -> PathVar -> IO Limit-getFdPathVar fd v = unsupported "getFdPathVar"--#endif-
− System/PosixCompat/Types.hs
@@ -1,32 +0,0 @@-module System.PosixCompat.Types (- module System.Posix.Types,-#ifndef UNIX_IMPL- UserID, GroupID, LinkCount-#endif- ) where--import System.Posix.Types--#ifndef UNIX_IMPL--import Data.Word (Word32)--newtype UserID = UserID Word32- deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)-instance Show UserID where show (UserID x) = show x-instance Read UserID where readsPrec i s = [ (UserID x, s')- | (x,s') <- readsPrec i s]--newtype GroupID = GroupID Word32- deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)-instance Show GroupID where show (GroupID x) = show x-instance Read GroupID where readsPrec i s = [ (GroupID x, s')- | (x,s') <- readsPrec i s]--newtype LinkCount = LinkCount Word32- deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)-instance Show LinkCount where show (LinkCount x) = show x-instance Read LinkCount where readsPrec i s = [ (LinkCount x, s')- | (x,s') <- readsPrec i s]--#endif
− System/PosixCompat/User.hsc
@@ -1,135 +0,0 @@-module System.PosixCompat.User (- -- * User environment- -- ** Querying the user environment- getRealUserID,- getRealGroupID,- getEffectiveUserID,- getEffectiveGroupID,- getGroups,- getLoginName,- getEffectiveUserName,-- -- *** The group database- GroupEntry(..),- getGroupEntryForID,- getGroupEntryForName,- getAllGroupEntries,-- -- *** The user database- UserEntry(..),- getUserEntryForID,- getUserEntryForName,- getAllUserEntries,-- -- ** Modifying the user environment- setUserID,- setGroupID- ) where--#if UNIX_IMPL--#include "HsUnixCompat.h"--import System.Posix.User--#else /* Portable implementation */--import System.IO.Error-import System.PosixCompat.Types--#endif---#if UNIX_IMPL--#if __GLASGOW_HASKELL__<605-getAllGroupEntries :: IO [GroupEntry]-getAllGroupEntries = return []--getAllUserEntries :: IO [UserEntry]-getAllUserEntries = return []-#endif--#else /* Portable implementation */--unsupported :: String -> IO a-unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing- where x = "System.PosixCompat.User." ++ f ++ ": not supported"---- -------------------------------------------------------------------------------- User environment--getRealUserID :: IO UserID-getRealUserID = unsupported "getRealUserID"--getRealGroupID :: IO GroupID-getRealGroupID = unsupported "getRealGroupID"--getEffectiveUserID :: IO UserID-getEffectiveUserID = unsupported "getEffectiveUserID"--getEffectiveGroupID :: IO GroupID-getEffectiveGroupID = unsupported "getEffectiveGroupID"--getGroups :: IO [GroupID]-getGroups = return []--getLoginName :: IO String-getLoginName = unsupported "getLoginName"--setUserID :: UserID -> IO ()-setUserID uid = return ()--setGroupID :: GroupID -> IO ()-setGroupID gid = return ()---- -------------------------------------------------------------------------------- User names--getEffectiveUserName :: IO String-getEffectiveUserName = unsupported "getEffectiveUserName"---- -------------------------------------------------------------------------------- The group database --data GroupEntry =- GroupEntry {- groupName :: String,- groupPassword :: String,- groupID :: GroupID,- groupMembers :: [String]- } deriving (Show, Read, Eq)--getGroupEntryForID :: GroupID -> IO GroupEntry-getGroupEntryForID gid = unsupported "getGroupEntryForID"--getGroupEntryForName :: String -> IO GroupEntry-getGroupEntryForName name = unsupported "getGroupEntryForName"--getAllGroupEntries :: IO [GroupEntry]-getAllGroupEntries = return []---- -------------------------------------------------------------------------------- The user database (pwd.h)--data UserEntry =- UserEntry {- userName :: String,- userPassword :: String,- userID :: UserID,- userGroupID :: GroupID,- userGecos :: String,- homeDirectory :: String,- userShell :: String- } deriving (Show, Read, Eq)--getUserEntryForID :: UserID -> IO UserEntry-getUserEntryForID uid = unsupported "getUserEntryForID"--getUserEntryForName :: String -> IO UserEntry-getUserEntryForName name = unsupported "getUserEntryForName"--getAllUserEntries :: IO [UserEntry]-getAllUserEntries = return []--#endif
cbits/HsUnixCompat.c view
@@ -1,5 +1,9 @@ #include "HsUnixCompat.h" +#ifdef SOLARIS+#include <sys/mkdev.h>+#endif+ unsigned int unix_major(dev_t dev) { return major(dev); }@@ -11,3 +15,4 @@ dev_t unix_makedev(unsigned int maj, unsigned int min) { return makedev(maj, min); }+
include/HsUnixCompat.h view
@@ -6,3 +6,4 @@ dev_t unix_makedev(unsigned int maj, unsigned int min); #define NEED_setSymbolicLinkOwnerAndGroup !HAVE_LCHOWN+
+ src/System/PosixCompat.hs view
@@ -0,0 +1,27 @@+{-|+The @unix-compat@ package provides portable implementations of parts of the+@unix@ package. On POSIX system it re-exports operations from the @unix@+package, on other platforms it emulates the operations as far as possible.+-}+module System.PosixCompat (+ module System.PosixCompat.Files,+ module System.PosixCompat.Time,+ module System.PosixCompat.Types,+ module System.PosixCompat.User,+ usingPortableImpl+ ) where++import System.PosixCompat.Files+import System.PosixCompat.Time+import System.PosixCompat.Types+import System.PosixCompat.User++-- | 'True' if unix-compat is using its portable implementation,+-- or 'False' if the unix package is simply being re-exported.+usingPortableImpl :: Bool+#ifdef UNIX_IMPL+usingPortableImpl = False+#else+usingPortableImpl = True+#endif+
+ src/System/PosixCompat/Extensions.hsc view
@@ -0,0 +1,53 @@+-- | This module provides some functions not present in the unix package.+module System.PosixCompat.Extensions (+ -- * Device IDs.+ CMajor, CMinor,+ deviceMajor, deviceMinor, makeDeviceID+ ) where+++#ifdef UNIX_IMPL+#include "HsUnixCompat.h"+#endif++import Foreign.C.Types+import System.PosixCompat.Types+++type CMajor = CUInt+type CMinor = CUInt++-- | Gets the major number from a 'DeviceID' for a device file.+-- +-- The portable implementation always returns @0@.+deviceMajor :: DeviceID -> CMajor+#ifdef UNIX_IMPL+deviceMajor dev = unix_major dev++foreign import ccall unsafe "unix_major" unix_major :: CDev -> CUInt+#else+deviceMajor _ = 0+#endif++-- | Gets the minor number from a 'DeviceID' for a device file.+-- +-- The portable implementation always returns @0@.+deviceMinor :: DeviceID -> CMinor+#ifdef UNIX_IMPL+deviceMinor dev = unix_minor dev++foreign import ccall unsafe "unix_minor" unix_minor :: CDev -> CUInt+#else+deviceMinor _ = 0+#endif++-- | Creates a 'DeviceID' for a device file given a major and minor number.+makeDeviceID :: CMajor -> CMinor -> DeviceID+#ifdef UNIX_IMPL+makeDeviceID ma mi = unix_makedev ma mi++foreign import ccall unsafe "unix_makedev" unix_makedev :: CUInt -> CUInt -> CDev+#else+makeDeviceID _ _ = 0+#endif+
+ src/System/PosixCompat/Files.hsc view
@@ -0,0 +1,404 @@+{-|+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++#ifdef UNIX_IMPL++#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 (renameFile, doesFileExist, doesDirectoryExist, + Permissions(..), getPermissions, setPermissions,+ getModificationTime)+import System.IO (IOMode(..), openFile, hFileSize, hSetFileSize, hClose)+import System.IO.Error+import System.PosixCompat.Types+import System.Time (ClockTime(..), getClockTime)++#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+modeToPerms m = Permissions {+ readable = m .&. ownerReadMode /= 0,+ writable = m .&. ownerWriteMode /= 0,+ executable = m .&. ownerExecuteMode /= 0,+ searchable = m .&. ownerExecuteMode /= 0+ }++-- -----------------------------------------------------------------------------+-- 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 clockTimeToEpochTime $ getModificationTime path+ return $ FileStatus {+ deviceID = -1,+ fileID = -1,+ fileMode = typ .|. perm,+ linkCount = 1,+ fileOwner = 0,+ fileGroup = 0,+ specialDeviceID = 0,+ fileSize = size,+ accessTime = mtime,+ modificationTime = mtime,+ statusChangeTime = mtime+ }++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)++clockTimeToEpochTime :: ClockTime -> EpochTime+clockTimeToEpochTime (TOD s _) = fromInteger s+++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+
+ src/System/PosixCompat/Time.hs view
@@ -0,0 +1,31 @@+{-|+This module makes the operations exported by @System.Posix.Time@+available on all platforms. On POSIX systems it re-exports operations from+@System.Posix.Time@, on other platforms it emulates the operations as far+as possible.+-}+module System.PosixCompat.Time (+ epochTime,+ ) where++#ifdef UNIX_IMPL++import System.Posix.Time++#else++import Control.Monad (liftM)+import System.Posix.Types (EpochTime)+import System.Time (ClockTime(..), getClockTime)++-- | The portable version of @epochTime@ calls 'getClockTime' to obtain the+-- number of seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT+-- 1970).+epochTime :: IO EpochTime+epochTime = liftM clockTimeToEpochTime getClockTime++clockTimeToEpochTime :: ClockTime -> EpochTime+clockTimeToEpochTime (TOD s _) = fromInteger s++#endif+
+ src/System/PosixCompat/Types.hs view
@@ -0,0 +1,39 @@+{-|+This module re-exports the types from @System.Posix.Types@ on all platforms.++On Windows 'UserID', 'GroupID' and 'LinkCount' are missing, so they are+redefined by this module.+-}+module System.PosixCompat.Types (+ module System.Posix.Types,+#ifdef MISSING_POSIX_TYPES+ UserID, GroupID, LinkCount+#endif+ ) where++import System.Posix.Types++#ifdef MISSING_POSIX_TYPES++import Data.Word (Word32)++newtype UserID = UserID Word32+ deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)+instance Show UserID where show (UserID x) = show x+instance Read UserID where readsPrec i s = [ (UserID x, s')+ | (x,s') <- readsPrec i s]++newtype GroupID = GroupID Word32+ deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)+instance Show GroupID where show (GroupID x) = show x+instance Read GroupID where readsPrec i s = [ (GroupID x, s')+ | (x,s') <- readsPrec i s]++newtype LinkCount = LinkCount Word32+ deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)+instance Show LinkCount where show (LinkCount x) = show x+instance Read LinkCount where readsPrec i s = [ (LinkCount x, s')+ | (x,s') <- readsPrec i s]++#endif+
+ src/System/PosixCompat/User.hsc view
@@ -0,0 +1,133 @@+{-|+This module makes the operations exported by @System.Posix.User@+available on all platforms. On POSIX systems it re-exports operations from+@System.Posix.User@. On other platforms it provides dummy implementations.+-}+module System.PosixCompat.User (+ -- * User environment+ -- ** Querying the user environment+ getRealUserID,+ getRealGroupID,+ getEffectiveUserID,+ getEffectiveGroupID,+ getGroups,+ getLoginName,+ getEffectiveUserName,++ -- *** The group database+ GroupEntry(..),+ getGroupEntryForID,+ getGroupEntryForName,+ getAllGroupEntries,++ -- *** The user database+ UserEntry(..),+ getUserEntryForID,+ getUserEntryForName,+ getAllUserEntries,++ -- ** Modifying the user environment+ setUserID,+ setGroupID+ ) where++#ifdef UNIX_IMPL++#include "HsUnixCompat.h"++import System.Posix.User++#if __GLASGOW_HASKELL__<605+getAllGroupEntries :: IO [GroupEntry]+getAllGroupEntries = return []++getAllUserEntries :: IO [UserEntry]+getAllUserEntries = return []+#endif++#else /* Portable implementation */++import System.IO.Error+import System.PosixCompat.Types++unsupported :: String -> IO a+unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing+ where x = "System.PosixCompat.User." ++ f ++ ": not supported"++-- -----------------------------------------------------------------------------+-- User environment++getRealUserID :: IO UserID+getRealUserID = unsupported "getRealUserID"++getRealGroupID :: IO GroupID+getRealGroupID = unsupported "getRealGroupID"++getEffectiveUserID :: IO UserID+getEffectiveUserID = unsupported "getEffectiveUserID"++getEffectiveGroupID :: IO GroupID+getEffectiveGroupID = unsupported "getEffectiveGroupID"++getGroups :: IO [GroupID]+getGroups = return []++getLoginName :: IO String+getLoginName = unsupported "getLoginName"++setUserID :: UserID -> IO ()+setUserID _ = return ()++setGroupID :: GroupID -> IO ()+setGroupID _ = return ()++-- -----------------------------------------------------------------------------+-- User names++getEffectiveUserName :: IO String+getEffectiveUserName = unsupported "getEffectiveUserName"++-- -----------------------------------------------------------------------------+-- The group database ++data GroupEntry =+ GroupEntry {+ groupName :: String,+ groupPassword :: String,+ groupID :: GroupID,+ groupMembers :: [String]+ } deriving (Show, Read, Eq)++getGroupEntryForID :: GroupID -> IO GroupEntry+getGroupEntryForID _ = unsupported "getGroupEntryForID"++getGroupEntryForName :: String -> IO GroupEntry+getGroupEntryForName _ = unsupported "getGroupEntryForName"++getAllGroupEntries :: IO [GroupEntry]+getAllGroupEntries = return []++-- -----------------------------------------------------------------------------+-- The user database (pwd.h)++data UserEntry =+ UserEntry {+ userName :: String,+ userPassword :: String,+ userID :: UserID,+ userGroupID :: GroupID,+ userGecos :: String,+ homeDirectory :: String,+ userShell :: String+ } deriving (Show, Read, Eq)++getUserEntryForID :: UserID -> IO UserEntry+getUserEntryForID _ = unsupported "getUserEntryForID"++getUserEntryForName :: String -> IO UserEntry+getUserEntryForName _ = unsupported "getUserEntryForName"++getAllUserEntries :: IO [UserEntry]+getAllUserEntries = return []++#endif
unix-compat.cabal view
@@ -1,40 +1,55 @@-Name: unix-compat-Version: 0.1.2.1-Cabal-version: >= 1.2.1-Build-type: Simple-License: BSD4-License-file: LICENSE-Maintainer: bjorn@bringert.net-Synopsis: Portable POSIX-compatibility layer.-Description:- This package provides portable implementations of parts- of the unix package. This package re-exports the unix - package when available. When it isn't available,- portable implementations are used.+name: unix-compat+version: 0.2+synopsis: Portable POSIX-compatibility layer.+description: This package provides portable implementations of parts+ of the unix package. This package re-exports the unix + package when available. When it isn't available,+ portable implementations are used. -Flag split-base+homepage: http://github.com/jystic/unix-compat+license: BSD3+license-file: LICENSE+author: Björn Bringert, Duncan Coutts, Jacob Stanley+maintainer: Jacob Stanley <jacob@stanley.io>+category: System+build-type: Simple+cabal-version: >= 1.6 +source-repository head+ type: git+ location: git://github.com/jystic/unix-compat.git++Flag portable+ default: False+ description: Force compiling in portable mode, useful for testing.+ Library- Exposed-modules:+ hs-source-dirs: src++ exposed-modules:+ System.PosixCompat System.PosixCompat.Extensions System.PosixCompat.Files- System.PosixCompat.User+ System.PosixCompat.Time System.PosixCompat.Types- Extensions: CPP- GHC-Options: -Wall- Build-depends: base+ System.PosixCompat.User+ extensions: CPP+ ghc-options: -Wall+ build-depends: base == 4.* - if os(windows)- if flag(split-base)- Build-depends: base >= 3, old-time, directory- else- Build-depends: base < 3- Extensions: GeneralizedNewtypeDeriving+ if flag(portable) || os(windows)+ build-depends: old-time == 1.0.*, directory == 1.0.*+ extensions: GeneralizedNewtypeDeriving+ if os(windows)+ cpp-options: -DMISSING_POSIX_TYPES else- Build-depends: unix- Extensions: ForeignFunctionInterface- CPP-options: -DUNIX_IMPL- Include-dirs: include- Includes: HsUnixCompat.h- Install-includes: HsUnixCompat.h- C-sources: cbits/HsUnixCompat.c+ build-depends: unix == 2.4.*+ extensions: ForeignFunctionInterface+ cpp-options: -DUNIX_IMPL+ include-dirs: include+ includes: HsUnixCompat.h+ install-includes: HsUnixCompat.h+ c-sources: cbits/HsUnixCompat.c+ if os(solaris)+ cc-options: -DSOLARIS+