diff --git a/System/PosixCompat/Extensions.hsc b/System/PosixCompat/Extensions.hsc deleted file mode 100644 --- a/System/PosixCompat/Extensions.hsc +++ /dev/null @@ -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 diff --git a/System/PosixCompat/Files.hsc b/System/PosixCompat/Files.hsc deleted file mode 100644 --- a/System/PosixCompat/Files.hsc +++ /dev/null @@ -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 - diff --git a/System/PosixCompat/Types.hs b/System/PosixCompat/Types.hs deleted file mode 100644 --- a/System/PosixCompat/Types.hs +++ /dev/null @@ -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 diff --git a/System/PosixCompat/User.hsc b/System/PosixCompat/User.hsc deleted file mode 100644 --- a/System/PosixCompat/User.hsc +++ /dev/null @@ -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 diff --git a/cbits/HsUnixCompat.c b/cbits/HsUnixCompat.c --- a/cbits/HsUnixCompat.c +++ b/cbits/HsUnixCompat.c @@ -1,5 +1,9 @@ #include "HsUnixCompat.h" +#ifdef SOLARIS +#include +#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); } + diff --git a/include/HsUnixCompat.h b/include/HsUnixCompat.h --- a/include/HsUnixCompat.h +++ b/include/HsUnixCompat.h @@ -6,3 +6,4 @@ dev_t unix_makedev(unsigned int maj, unsigned int min); #define NEED_setSymbolicLinkOwnerAndGroup !HAVE_LCHOWN + diff --git a/src/System/PosixCompat.hs b/src/System/PosixCompat.hs new file mode 100644 --- /dev/null +++ b/src/System/PosixCompat.hs @@ -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 + diff --git a/src/System/PosixCompat/Extensions.hsc b/src/System/PosixCompat/Extensions.hsc new file mode 100644 --- /dev/null +++ b/src/System/PosixCompat/Extensions.hsc @@ -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 + diff --git a/src/System/PosixCompat/Files.hsc b/src/System/PosixCompat/Files.hsc new file mode 100644 --- /dev/null +++ b/src/System/PosixCompat/Files.hsc @@ -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 + diff --git a/src/System/PosixCompat/Time.hs b/src/System/PosixCompat/Time.hs new file mode 100644 --- /dev/null +++ b/src/System/PosixCompat/Time.hs @@ -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 + diff --git a/src/System/PosixCompat/Types.hs b/src/System/PosixCompat/Types.hs new file mode 100644 --- /dev/null +++ b/src/System/PosixCompat/Types.hs @@ -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 + diff --git a/src/System/PosixCompat/User.hsc b/src/System/PosixCompat/User.hsc new file mode 100644 --- /dev/null +++ b/src/System/PosixCompat/User.hsc @@ -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 diff --git a/unix-compat.cabal b/unix-compat.cabal --- a/unix-compat.cabal +++ b/unix-compat.cabal @@ -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 +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 +