packages feed

unix-compat (empty) → 0.1

raw patch · 8 files changed

+693/−0 lines, 8 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2007, Bjorn Bringert+All rights reserved.++Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice, +  this list of conditions and the following disclaimer.+- Redistributions in binary form must reproduce the above copyright +  notice, this list of conditions and the following disclaimer in the +  documentation and/or other materials provided with the distribution.+- Neither the names of the copyright owners nor the names of the +  contributors may be used to endorse or promote products derived +  from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,26 @@+> import Distribution.PackageDescription (PackageDescription(buildDepends))+> import Distribution.Setup (ConfigFlags)+> import Distribution.Simple (UserHooks(confHook),+>                             defaultMainWithHooks, defaultUserHooks, +>                             Dependency(..), VersionRange(..))+> import Distribution.Simple.LocalBuildInfo (LocalBuildInfo)+> import qualified System.Info (os)++> main :: IO ()+> main = defaultMainWithHooks myHooks++> myHooks :: UserHooks+> myHooks = addOptionalUnixDependencyHook defaultUserHooks++> addOptionalUnixDependencyHook :: UserHooks -> UserHooks+> addOptionalUnixDependencyHook hooks = +>    hooks { confHook = confHook hooks . addOptionalUnixDependency }++> addOptionalUnixDependency :: PackageDescription -> PackageDescription+> addOptionalUnixDependency desc = +>   case System.Info.os of+>      "mingw32" -> desc+>      _         -> addDependency (Dependency "unix" AnyVersion) desc++> addDependency :: Dependency -> PackageDescription -> PackageDescription+> addDependency dep desc = desc { buildDepends = dep : buildDepends desc}
+ System/PosixCompat/Extensions.hsc view
@@ -0,0 +1,49 @@+-- | This module provides some functions not present in the unix package.+module System.PosixCompat.Extensions (+         -- * Device IDs.+         CMajor, CMinor,+         deviceMajor, deviceMinor, makeDeviceID+   ) where++#include "HsUnixCompat.h"++import Foreign.C.Types+import System.Posix.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 view
@@ -0,0 +1,411 @@+-- | 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++#include "HsUnixCompat.h"++#if UNIX_IMPL++import System.Posix.Files++#if NEED_setSymbolicLinkOwnerAndGroup+import System.Posix.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.Posix.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/User.hsc view
@@ -0,0 +1,127 @@+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++#include "HsUnixCompat.h"++#if UNIX_IMPL++import System.Posix.User++#else /* Portable implementation */++import System.IO.Error+import System.Posix.Types++#endif+++#if UNIX_IMPL++#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
@@ -0,0 +1,17 @@+#include "HsUnixCompat.h"++#if UNIX_IMPL++unsigned int unix_major(dev_t dev) {+  return major(dev);+}++unsigned int unix_minor(dev_t dev) {+  return minor(dev);+}++dev_t unix_makedev(unsigned int maj, unsigned int min) {+  return makedev(maj, min);+}++#endif
+ include/HsUnixCompat.h view
@@ -0,0 +1,14 @@+#define UNIX_IMPL !defined(mingw32_HOST_OS)++#if UNIX_IMPL+#include "HsUnix.h"+#include <sys/types.h>++unsigned int unix_major(dev_t dev);+unsigned int unix_minor(dev_t dev);+dev_t unix_makedev(unsigned int maj, unsigned int min);++#define NEED_setSymbolicLinkOwnerAndGroup !HAVE_LCHOWN++#endif+
+ unix-compat.cabal view
@@ -0,0 +1,23 @@+Name: unix-compat+Version: 0.1+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.+Exposed-modules:+  System.PosixCompat.Extensions+  System.PosixCompat.Files+  System.PosixCompat.User+-- Also depends on the unix package on POSIX platforms, added by Setup.lhs.+Build-depends: base+Extensions: CPP, ForeignFunctionInterface+Include-dirs: include+Install-includes: HsUnixCompat.h+C-sources: cbits/HsUnixCompat.c+Extra-source-files: include/HsUnixCompat.h+GHC-Options: -O -Wall