unix-compat 0.4.3.1 → 0.7.4.1
raw patch · 18 files changed
Files
- CHANGELOG.md +34/−0
- LICENSE +2/−0
- cbits/HsUnixCompat.c +2/−0
- cbits/mktemp.c +24/−8
- include/HsUnixCompat.h +0/−2
- src/System/PosixCompat.hs +2/−2
- src/System/PosixCompat/Extensions.hsc +4/−4
- src/System/PosixCompat/Files.hsc +118/−56
- src/System/PosixCompat/Internal/Time.hs +1/−26
- src/System/PosixCompat/Process.hs +30/−0
- src/System/PosixCompat/Temp.hs +2/−2
- src/System/PosixCompat/Types.hs +3/−12
- src/System/PosixCompat/User.hsc +0/−133
- tests/LinksSpec.hs +122/−0
- tests/MkstempSpec.hs +29/−0
- tests/ProcessSpec.hs +12/−0
- tests/main.hs +13/−0
- unix-compat.cabal +69/−31
+ CHANGELOG.md view
@@ -0,0 +1,34 @@+## Version 0.7.4.1 (2025-08-26)++- Fix build with `-Werror=unused-packages`.+- Tested with GHC 8.0 - 9.14 alpha1.++## Version 0.7.4 (2025-03-27)++- Add `wasm32-wasi` support+ ([PR #16](https://github.com/haskell-pkg-janitors/unix-compat/pull/16)).+- Tested with GHC 8.0 - 9.12.++## Version 0.7.3 (2024-10-11)++- Fix `sysmacros.h` include for GNU/Hurd+ ([PR #12](https://github.com/haskell-pkg-janitors/unix-compat/pull/12)).+- Tested with GHC 8.0 - 9.10.++## Version 0.7.2 (2024-06-25)++- Remove flag `old-time` and drop support for `old-time`.+- Remove support for GHC 7.+- Tested with GHC 8.0 - 9.10.++## Version 0.7.1 (2023-12-06) Santa Clause edition++- Add `System.PosixCompat.Process` module, exporting `getProcessID`.++## Version 0.7 (2023-03-15)++- Remove `System.PosixCompat.User` module.++## Version 0.6 (2022-05-22)++- Better support for symbolic links.
LICENSE view
@@ -1,3 +1,5 @@+BSD 3-Clause License+ Copyright (c) 2007-2008, Björn Bringert Copyright (c) 2007-2009, Duncan Coutts Copyright (c) 2010-2011, Jacob Stanley
cbits/HsUnixCompat.c view
@@ -2,6 +2,8 @@ #ifdef SOLARIS #include <sys/mkdev.h>+#elif defined(__linux__) || defined(__GNU__)+#include <sys/sysmacros.h> #endif unsigned int unix_major(dev_t dev)
cbits/mktemp.c view
@@ -41,13 +41,21 @@ #include <stdlib.h> #include <string.h> #include <unistd.h>++#if defined(__wasm__)+#include <sys/random.h>+#else #include <windows.h> #include <wincrypt.h> -static int random(uint32_t *);+#define open _open+#define stat _stat+#endif++static int unixcompat_random(uint32_t *); static int _gettemp(char *, int *); -static const unsigned char padchar[] =+static const char padchar[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; int unixcompat_mkstemp(char *path)@@ -64,7 +72,7 @@ { char *start, *trv, *suffp, *carryp; char *pad;- struct _stat sbuf;+ struct stat sbuf; int rval; uint32_t randidx, randval; char carrybuf[MAXPATHLEN];@@ -84,7 +92,7 @@ /* Fill space with random characters */ while (trv >= path && *trv == 'X') {- if (!random(&randval)) {+ if (!unixcompat_random(&randval)) { /* this should never happen */ errno = EIO; return 0;@@ -104,7 +112,7 @@ for (; trv > path; --trv) { if (*trv == '/') { *trv = '\0';- rval = _stat(path, &sbuf);+ rval = stat(path, &sbuf); *trv = '/'; if (rval != 0) return (0);@@ -120,11 +128,11 @@ for (;;) { if (doopen) { if ((*doopen =- _open(path, O_CREAT|O_EXCL|O_RDWR, 0600)) >= 0)+ open(path, O_CREAT|O_EXCL|O_RDWR, 0600)) >= 0) return (1); if (errno != EEXIST) return (0);- } else if (_stat(path, &sbuf))+ } else if (stat(path, &sbuf)) return (errno == ENOENT); /* If we have a collision, cycle through the space of filenames */@@ -154,8 +162,15 @@ /*NOTREACHED*/ } -static int random(uint32_t *value)+#if defined(__wasm__)+static int unixcompat_random(uint32_t *value) {+ int r = getentropy(value, sizeof(uint32_t));+ return r == 0 ? 1 : 0;+}+#else+static int unixcompat_random(uint32_t *value)+{ /* This handle is never released. Windows will clean up when the process * exits. Python takes this approach when emulating /dev/urandom, and if * it's good enough for them, then it's good enough for us. */@@ -171,3 +186,4 @@ return 1; }+#endif
include/HsUnixCompat.h view
@@ -4,5 +4,3 @@ 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
src/System/PosixCompat.hs view
@@ -7,20 +7,20 @@ -} module System.PosixCompat ( module System.PosixCompat.Files+ , module System.PosixCompat.Process , module System.PosixCompat.Temp , module System.PosixCompat.Time , module System.PosixCompat.Types , module System.PosixCompat.Unistd- , module System.PosixCompat.User , usingPortableImpl ) where import System.PosixCompat.Files+import System.PosixCompat.Process import System.PosixCompat.Temp import System.PosixCompat.Time import System.PosixCompat.Types import System.PosixCompat.Unistd-import System.PosixCompat.User -- | 'True' if unix-compat is using its portable implementation, -- or 'False' if the unix package is simply being re-exported.
src/System/PosixCompat/Extensions.hsc view
@@ -12,7 +12,7 @@ ) where -#ifndef mingw32_HOST_OS+#if !(defined(mingw32_HOST_OS) || defined(wasm32_HOST_ARCH)) #include "HsUnixCompat.h" #endif @@ -27,7 +27,7 @@ -- -- The portable implementation always returns @0@. deviceMajor :: DeviceID -> CMajor-#ifdef mingw32_HOST_OS+#if defined(mingw32_HOST_OS) || defined(wasm32_HOST_ARCH) deviceMajor _ = 0 #else deviceMajor dev = unix_major dev@@ -39,7 +39,7 @@ -- -- The portable implementation always returns @0@. deviceMinor :: DeviceID -> CMinor-#ifdef mingw32_HOST_OS+#if defined(mingw32_HOST_OS) || defined(wasm32_HOST_ARCH) deviceMinor _ = 0 #else deviceMinor dev = unix_minor dev@@ -49,7 +49,7 @@ -- | Creates a 'DeviceID' for a device file given a major and minor number. makeDeviceID :: CMajor -> CMinor -> DeviceID-#ifdef mingw32_HOST_OS+#if defined(mingw32_HOST_OS) || defined(wasm32_HOST_ARCH) makeDeviceID _ _ = 0 #else makeDeviceID ma mi = unix_makedev ma mi
src/System/PosixCompat/Files.hsc view
@@ -59,6 +59,9 @@ , accessTime , modificationTime , statusChangeTime+ , accessTimeHiRes+ , modificationTimeHiRes+ , statusChangeTimeHiRes , isBlockDevice , isCharacterDevice , isNamedPipe@@ -103,11 +106,11 @@ #ifndef mingw32_HOST_OS -#include "HsUnixCompat.h"+#include "HsUnixConfig.h" import System.Posix.Files -#if NEED_setSymbolicLinkOwnerAndGroup+#if !HAVE_LCHOWN import System.PosixCompat.Types setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()@@ -119,7 +122,9 @@ import Control.Exception (bracket) import Control.Monad (liftM, liftM2) import Data.Bits ((.|.), (.&.))+import Data.Char (toLower) import Data.Int (Int64)+import Data.Time.Clock.POSIX (POSIXTime) import Foreign.C.Types (CTime(..)) import Prelude hiding (read) import System.Directory (Permissions, emptyPermissions)@@ -129,16 +134,18 @@ import System.Directory (executable, setOwnerExecutable) import System.Directory (searchable, setOwnerSearchable) import System.Directory (doesFileExist, doesDirectoryExist)-import System.Directory (getModificationTime, renameFile)-import System.IO (IOMode(..), openFile, hFileSize, hSetFileSize, hClose)+import System.Directory (getSymbolicLinkTarget)+import System.FilePath (takeExtension)+import System.IO (IOMode(..), openFile, hSetFileSize, hClose) import System.IO.Error import System.PosixCompat.Types-import System.Win32.File hiding (getFileType)+import System.Win32.File+import System.Win32.HardLink (createHardLink) import System.Win32.Time (FILETIME(..), getFileTime, setFileTime)+import System.Win32.Types (HANDLE) import System.PosixCompat.Internal.Time ( getClockTime, clockTimeToEpochTime- , modificationTimeToEpochTime ) #ifdef __GLASGOW_HASKELL__@@ -266,17 +273,20 @@ -- 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+ { deviceID :: DeviceID+ , fileID :: FileID+ , fileMode :: FileMode+ , linkCount :: LinkCount+ , fileOwner :: UserID+ , fileGroup :: GroupID+ , specialDeviceID :: DeviceID+ , fileSize :: FileOffset+ , accessTime :: EpochTime+ , modificationTime :: EpochTime+ , statusChangeTime :: EpochTime+ , accessTimeHiRes :: POSIXTime+ , modificationTimeHiRes :: POSIXTime+ , statusChangeTimeHiRes :: POSIXTime } isBlockDevice :: FileStatus -> Bool@@ -307,13 +317,23 @@ isSocket stat = (fileMode stat `intersectFileModes` fileTypeModes) == socketMode -getFileStatus :: FilePath -> IO FileStatus-getFileStatus path = do- perm <- liftM permsToMode (getPermissions path)- typ <- getFileType path- size <- if typ == regularFileMode then getFileSize path else return 0- mtime <- liftM modificationTimeToEpochTime (getModificationTime path)+getStatus :: Bool -> FilePath -> IO FileStatus+getStatus forLink path = do info <- bracket openPath closeHandle getFileInformationByHandle+ let atime = windowsToPosixTime (bhfiLastAccessTime info)+ mtime = windowsToPosixTime (bhfiLastWriteTime info)+ ctime = windowsToPosixTime (bhfiCreationTime info)+ attr = bhfiFileAttributes info+ isLink = attr .&. fILE_ATTRIBUTE_REPARSE_POINT /= 0+ isDir = attr .&. fILE_ATTRIBUTE_DIRECTORY /= 0+ isWritable = attr .&. fILE_ATTRIBUTE_READONLY == 0+ -- Contrary to Posix systems, directory symlinks on Windows have both+ -- fILE_ATTRIBUTE_REPARSE_POINT and fILE_ATTRIBUTE_DIRECTORY bits set.+ typ+ | isLink = symbolicLinkMode+ | isDir = directoryMode+ | otherwise = regularFileMode -- it's a lie but what can we do?+ perm = permissions path isWritable isDir return $ FileStatus { deviceID = fromIntegral (bhfiVolumeSerialNumber info) , fileID = fromIntegral (bhfiFileIndex info)@@ -322,47 +342,77 @@ , fileOwner = 0 , fileGroup = 0 , specialDeviceID = 0- , fileSize = size- , accessTime = mtime- , modificationTime = mtime- , statusChangeTime = mtime }+ , fileSize = fromIntegral (bhfiSize info)+ , accessTime = posixTimeToEpochTime atime+ , modificationTime = posixTimeToEpochTime mtime+ , statusChangeTime = posixTimeToEpochTime mtime+ , accessTimeHiRes = atime+ , modificationTimeHiRes = mtime+ , statusChangeTimeHiRes = ctime+ } where openPath = createFile path- gENERIC_READ+ fILE_READ_EA (fILE_SHARE_READ .|. fILE_SHARE_WRITE .|. fILE_SHARE_DELETE) Nothing oPEN_EXISTING- (sECURITY_ANONYMOUS .|. fILE_FLAG_BACKUP_SEMANTICS)+ (fILE_FLAG_BACKUP_SEMANTICS .|. openReparsePoint) Nothing -permsToMode :: Permissions -> FileMode-permsToMode perms = r .|. w .|. x- where- r = f (readable perms) (ownerReadMode .|. groupReadMode .|. otherReadMode)- w = f (writable perms) (ownerWriteMode .|. groupWriteMode .|. otherWriteMode)- x = f (executable perms || searchable perms)- (ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode)- f True m = m- f False _ = nullFileMode+ openReparsePoint = if forLink then fILE_FLAG_OPEN_REPARSE_POINT else 0 -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."+ -- not yet defined in Win32 package:+ fILE_FLAG_OPEN_REPARSE_POINT :: FileAttributeOrFlag+ fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000 -getFileSize :: FilePath -> IO FileOffset-getFileSize path =- bracket (openFile path ReadMode) hClose (liftM fromIntegral . hFileSize)+ -- Fused from System.Directory.Internal.Windows.getAccessPermissions+ -- and the former modeToPerms function.+ permissions path is_writable is_dir = r .|. w .|. x+ where+ is_executable =+ (toLower <$> takeExtension path) `elem` [".bat", ".cmd", ".com", ".exe"]+ r = ownerReadMode .|. groupReadMode .|. otherReadMode+ w = f is_writable (ownerWriteMode .|. groupWriteMode .|. otherWriteMode)+ x = f (is_executable || is_dir)+ (ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode)+ f True m = m+ f False _ = nullFileMode +getSymbolicLinkStatus :: FilePath -> IO FileStatus+getSymbolicLinkStatus = getStatus True++getFileStatus :: FilePath -> IO FileStatus+getFileStatus = getStatus False++-- | Convert a 'POSIXTime' (synomym for 'Data.Time.Clock.NominalDiffTime')+-- into an 'EpochTime' (integral number of seconds since epoch). This merely+-- throws away the fractional part.+posixTimeToEpochTime :: POSIXTime -> EpochTime+posixTimeToEpochTime = fromInteger . floor++-- three function stolen from System.Directory.Internals.Windows:++-- | Difference between the Windows and POSIX epochs in units of 100ns.+windowsPosixEpochDifference :: Num a => a+windowsPosixEpochDifference = 116444736000000000++-- | Convert from Windows time to POSIX time.+windowsToPosixTime :: FILETIME -> POSIXTime+windowsToPosixTime (FILETIME t) =+ (fromIntegral t - windowsPosixEpochDifference) / 10000000++{- will be needed to /set/ high res timestamps, not yet supported++-- | Convert from POSIX time to Windows time. This is lossy as Windows time+-- has a resolution of only 100ns.+posixToWindowsTime :: POSIXTime -> FILETIME+posixToWindowsTime t = FILETIME $+ truncate (t * 10000000 + windowsPosixEpochDifference)+-}+ getFdStatus :: Fd -> IO FileStatus getFdStatus _ = unsupported "getFdStatus" -getSymbolicLinkStatus :: FilePath -> IO FileStatus-getSymbolicLinkStatus path = getFileStatus path- createNamedPipe :: FilePath -> FileMode -> IO () createNamedPipe _ _ = unsupported "createNamedPipe" @@ -373,7 +423,7 @@ -- Hard links createLink :: FilePath -> FilePath -> IO ()-createLink _ _ = unsupported "createLink"+createLink = createHardLink removeLink :: FilePath -> IO () removeLink _ = unsupported "removeLink"@@ -385,13 +435,17 @@ createSymbolicLink _ _ = unsupported "createSymbolicLink" readSymbolicLink :: FilePath -> IO FilePath-readSymbolicLink _ = unsupported "readSymbolicLink"+readSymbolicLink = getSymbolicLinkTarget -- -------------------------------------------------------------------------------- Renaming files+-- Renaming rename :: FilePath -> FilePath -> IO ()-rename name1 name2 = renameFile name1 name2+#if MIN_VERSION_Win32(2, 6, 0)+rename name1 name2 = moveFileEx name1 (Just name2) mOVEFILE_REPLACE_EXISTING+#else+rename name1 name2 = moveFileEx name1 name2 mOVEFILE_REPLACE_EXISTING+#endif -- ----------------------------------------------------------------------------- -- chown()@@ -415,7 +469,7 @@ setFileTimes file atime mtime = bracket openFileHandle closeHandle $ \handle -> do (creationTime, _, _) <- getFileTime handle- setFileTime+ setFileTimeCompat handle creationTime (epochTimeToFileTime atime)@@ -434,6 +488,14 @@ where ll :: Int64 ll = fromIntegral t * 10000000 + 116444736000000000++setFileTimeCompat :: HANDLE -> FILETIME -> FILETIME -> FILETIME -> IO ()+setFileTimeCompat h crt acc wrt =+#if MIN_VERSION_Win32(2, 12, 0)+ setFileTime h (Just crt) (Just acc) (Just wrt)+#else+ setFileTime h crt acc wrt+#endif touchFile :: FilePath -> IO () touchFile name =
src/System/PosixCompat/Internal/Time.hs view
@@ -7,28 +7,10 @@ ClockTime , getClockTime , clockTimeToEpochTime- , ModificationTime- , modificationTimeToEpochTime ) where import System.Posix.Types (EpochTime)--#ifdef OLD_TIME--import System.Time (ClockTime(TOD), getClockTime)--clockTimeToEpochTime :: ClockTime -> EpochTime-clockTimeToEpochTime (TOD s _) = fromInteger s--type ModificationTime = ClockTime--modificationTimeToEpochTime :: ModificationTime -> EpochTime-modificationTimeToEpochTime = clockTimeToEpochTime--#else--import Data.Time.Clock (UTCTime)-import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, utcTimeToPOSIXSeconds)+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) type ClockTime = POSIXTime @@ -37,10 +19,3 @@ clockTimeToEpochTime :: ClockTime -> EpochTime clockTimeToEpochTime = fromInteger . floor--type ModificationTime = UTCTime--modificationTimeToEpochTime :: UTCTime -> EpochTime-modificationTimeToEpochTime = clockTimeToEpochTime . utcTimeToPOSIXSeconds--#endif
+ src/System/PosixCompat/Process.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE CPP #-}++{-|+This module intends to make the operations of @System.Posix.Process@ available+on all platforms.+-}+module System.PosixCompat.Process (+ getProcessID+ ) where++#if defined(mingw32_HOST_OS)++import System.Posix.Types (ProcessID)+import System.Win32.Process (getCurrentProcessId)++getProcessID :: IO ProcessID+getProcessID = fromIntegral <$> getCurrentProcessId++#elif defined(wasm32_HOST_ARCH)++import System.Posix.Types (ProcessID)++getProcessID :: IO ProcessID+getProcessID = pure 1++#else++import System.Posix.Process++#endif
src/System/PosixCompat/Temp.hs view
@@ -11,13 +11,13 @@ mkstemp ) where -#ifndef mingw32_HOST_OS+#if !(defined(mingw32_HOST_OS) || defined(wasm32_HOST_ARCH)) -- Re-export unix package import System.Posix.Temp #elif defined(__GLASGOW_HASKELL__)--- Windows w/ GHC, we have fdToHandle so we+-- Window/WASM w/ GHC, we have fdToHandle so we -- can use our own implementation of mkstemp. import System.IO (Handle)
src/System/PosixCompat/Types.hs view
@@ -8,14 +8,11 @@ redefined by this module. -} module System.PosixCompat.Types (+ module System.Posix.Types #ifdef mingw32_HOST_OS- module AllPosixTypesButFileID- , FileID , UserID , GroupID , LinkCount-#else- module System.Posix.Types #endif ) where @@ -23,15 +20,9 @@ -- Since CIno (FileID's underlying type) reflects <sys/type.h> ino_t, -- which mingw defines as short int (int16), it must be overriden to -- match the size of windows fileIndex (word64).-import System.Posix.Types as AllPosixTypesButFileID hiding (FileID)--import Data.Word (Word32, Word64)+import System.Posix.Types -newtype FileID = FileID Word64- deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)-instance Show FileID where show (FileID x) = show x-instance Read FileID where readsPrec i s = [ (FileID x, s')- | (x,s') <- readsPrec i s]+import Data.Word (Word32) newtype UserID = UserID Word32 deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real)
− src/System/PosixCompat/User.hsc
@@ -1,133 +0,0 @@-{-# LANGUAGE CPP #-}--{-|-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--#ifndef mingw32_HOST_OS--#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
+ tests/LinksSpec.hs view
@@ -0,0 +1,122 @@+module LinksSpec(linksSpec) where++import Control.Concurrent ( threadDelay )+import Control.Exception ( finally )+import qualified System.Directory as D+import System.Info ( os )+import System.IO.Error ( tryIOError )+import System.IO.Temp+import System.PosixCompat+import Test.Hspec+import Test.HUnit++isWindows :: Bool+isWindows = os == "mingw32"++linksSpec :: Spec+linksSpec = do+ describe "createSymbolicLink" $ do+ it "should error on Windows and succeed on other OSes" $ do+ runInTempDir $ do+ writeFile "file" ""+ result <- tryIOError $ createSymbolicLink "file" "file_link"+ case result of+ Left _ | isWindows -> return ()+ Right _ | isWindows -> do+ assertFailure "Succeeded while expected to fail on Windows"+ Left e -> assertFailure $ "Expected to succeed, but failed with " ++ show e+ Right _ -> return ()+ describe "getSymbolicLinkStatus" $ do+ it "should detect symbolic link to a file" $ do+ runFileLinkTest $ do+ stat <- getSymbolicLinkStatus "file_link"+ assert $ isSymbolicLink stat+ it "should detect symbolic link to a directory" $ do+ runDirLinkTest $ do+ stat <- getSymbolicLinkStatus "dir_link"+ assert $ isSymbolicLink stat+ it "should give later time stamp than getFileStatus for link to file" $ do+ runFileLinkTest $ do+ lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "file_link"+ stat_mtime <- modificationTimeHiRes <$> getFileStatus "file_link"+ assert $ lstat_mtime > stat_mtime+ it "should give later time stamp than getFileStatus for link to dir" $ do+ runDirLinkTest $ do+ lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "dir_link"+ stat_mtime <- modificationTimeHiRes <$> getFileStatus "dir_link"+ assert $ lstat_mtime > stat_mtime+ it "should give a different fileID than getFileStatus for link to file" $ do+ runFileLinkTest $ do+ lstat_id <- fileID <$> getSymbolicLinkStatus "file_link"+ fstat_id <- fileID <$> getFileStatus "file_link"+ assert $ lstat_id /= fstat_id+ it "should give a different fileID than getFileStatus for link to dir" $ do+ runDirLinkTest $ do+ lstat_id <- fileID <$> getSymbolicLinkStatus "dir_link"+ fstat_id <- fileID <$> getFileStatus "dir_link"+ assert $ lstat_id /= fstat_id+ describe "getFileStatus" $ do+ it "should detect that symbolic link target is a file" $ do+ runFileLinkTest $ do+ stat <- getFileStatus "file_link"+ assert $ isRegularFile stat+ it "should detect that symbolic link target is a directory" $ do+ runDirLinkTest $ do+ stat <- getFileStatus "dir_link"+ assert $ isDirectory stat+ it "should be equal for link and link target (except access time)" $ do+ runFileLinkTest $ do+ fstat <- getFileStatus "file"+ flstat <- getFileStatus "file_link"+ assert $ fstat `mostlyEq` flstat+ runDirLinkTest $ do+ fstat <- getFileStatus "dir"+ flstat <- getFileStatus "dir_link"+ assert $ fstat `mostlyEq` flstat++ where++ runFileLinkTest action =+ runInTempDir $ do+ writeFile "file" ""+ threadDelay delay+ D.createFileLink "file" "file_link"+ action++ runDirLinkTest action =+ runInTempDir $ do+ D.createDirectory "dir"+ threadDelay delay+ D.createDirectoryLink "dir" "dir_link"+ action++ runInTempDir action = do+ orig <- D.getCurrentDirectory+ withTempDirectory orig "xxxxxxx" $ \tmp -> do+ D.setCurrentDirectory tmp+ action `finally` D.setCurrentDirectory orig++ -- We need to set the delay this high because otherwise the timestamp test+ -- above fails on Linux and Windows, though not on MacOS. This seems to be+ -- an artefact of the GHC runtime system which gives two subsequently+ -- created files the same timestamp unless the delay is large enough.+ delay = 10000++ -- Test equality for all parts except accessTime+ mostlyEq :: FileStatus -> FileStatus -> Bool+ mostlyEq x y = tuple x == tuple y+ where+ tuple s =+ ( deviceID s+ , fileID s+ , fileMode s+ , linkCount s+ , fileOwner s+ , fileGroup s+ , specialDeviceID s+ , fileSize s+ , modificationTime s+ , statusChangeTime s+ , modificationTimeHiRes s+ , statusChangeTimeHiRes s+ )
+ tests/MkstempSpec.hs view
@@ -0,0 +1,29 @@+module MkstempSpec(mkstempSpec) where+import Control.Monad.Parallel+import System.Directory+import System.IO+import System.PosixCompat ( mkstemp )+import Test.Hspec++mkstempSpec :: Spec+mkstempSpec = describe "mkstemp" $ do+ it "TODO" $ do+ let n = 10000+ hSetBuffering stdout NoBuffering++ putStr $ "Creating " ++ show n ++ " temp files..."+ xs <- replicateM n createTempFile+ if length xs == n+ then putStrLn "ok"+ else putStrLn "FAIL"++ putStr "Deleting temp files..."+ Control.Monad.Parallel.mapM_ removeFile xs+ putStrLn "ok"++createTempFile :: IO FilePath+createTempFile = do+ (p,h) <- mkstemp "tempfileXXXXXXX"+ hPutStrLn h "this is a temporary file"+ hClose h+ return p
+ tests/ProcessSpec.hs view
@@ -0,0 +1,12 @@+module ProcessSpec (processSpec) where++import System.PosixCompat+import Test.HUnit+import Test.Hspec++processSpec :: Spec+processSpec = do+ describe "getProcessID" $ do+ it "should work on Windows and Unix" $ do+ pid <- getProcessID+ assert $ pid > 0
+ tests/main.hs view
@@ -0,0 +1,13 @@+module Main where++import MkstempSpec+import LinksSpec+import ProcessSpec++import Test.Hspec++main :: IO ()+main = hspec $ do+ mkstempSpec+ linksSpec+ processSpec
unix-compat.cabal view
@@ -1,72 +1,110 @@+cabal-version: 1.18 name: unix-compat-version: 0.4.3.1+version: 0.7.4.1 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. -homepage: http://github.com/jystic/unix-compat+homepage: https://github.com/haskell-pkg-janitors/unix-compat license: BSD3 license-file: LICENSE author: Björn Bringert, Duncan Coutts, Jacob Stanley, Bryan O'Sullivan-maintainer: Jacob Stanley <jacob@stanley.io>+maintainer: https://github.com/haskell-pkg-janitors category: System build-type: Simple-cabal-version: >= 1.6 +tested-with:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2++extra-doc-files:+ CHANGELOG.md+ source-repository head type: git- location: git://github.com/jystic/unix-compat.git--flag old-time- description: build against old-time package- default: False+ location: https://github.com/haskell-pkg-janitors/unix-compat.git Library hs-source-dirs: src- ghc-options: -Wall- build-depends: base == 4.* exposed-modules: System.PosixCompat System.PosixCompat.Extensions System.PosixCompat.Files+ System.PosixCompat.Process System.PosixCompat.Temp System.PosixCompat.Time System.PosixCompat.Types System.PosixCompat.Unistd- System.PosixCompat.User + build-depends: base >= 4.9 && < 5+ if os(windows) c-sources: cbits/HsUname.c cbits/mktemp.c extra-libraries: msvcrt- build-depends: Win32 >= 2.3.0.2-- if flag(old-time)- build-depends: old-time >= 1.0.0.0 && < 1.2.0.0- cpp-options: -DOLD_TIME-- if impl(ghc < 7)- build-depends: directory == 1.0.*- cpp-options: -DDIRECTORY_1_0- else- build-depends: directory == 1.1.*- else- build-depends: time >= 1.0 && < 1.7- build-depends: directory >= 1.2 && < 1.3+ build-depends: Win32 >= 2.5.0.0 && < 3+ build-depends: directory >= 1.3.1 && < 1.4+ build-depends: filepath >= 1.4.1.0 && < 1.6+ build-depends: time >= 1.6.0.1 && < 2 other-modules: System.PosixCompat.Internal.Time else- build-depends: unix >= 2.4 && < 2.8- include-dirs: include- includes: HsUnixCompat.h- install-includes: HsUnixCompat.h- c-sources: cbits/HsUnixCompat.c+ build-depends: unix >= 2.7.2.0 && < 2.9+ if arch(wasm32)+ c-sources: cbits/mktemp.c+ else+ include-dirs: include+ includes: HsUnixCompat.h+ install-includes: HsUnixCompat.h+ c-sources: cbits/HsUnixCompat.c if os(solaris) cc-options: -DSOLARIS++ default-language: Haskell2010+ ghc-options:+ -Wall+ -Wcompat++Test-Suite unix-compat-testsuite+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: main.hs++ other-modules:+ MkstempSpec+ LinksSpec+ ProcessSpec++ build-depends:+ unix-compat+ , base+ , monad-parallel+ , hspec >= 2.5.5+ , HUnit+ , directory >= 1.3.1.0+ -- directory-1.3.1.0 adds createFileLink+ , temporary++ default-language: Haskell2010+ ghc-options:+ -Wall+ -Wcompat