diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/cbits/HsUnixCompat.c b/cbits/HsUnixCompat.c --- a/cbits/HsUnixCompat.c +++ b/cbits/HsUnixCompat.c @@ -2,6 +2,8 @@ #ifdef SOLARIS #include +#elif defined(__linux__) || defined(__GNU__) +#include #endif unsigned int unix_major(dev_t dev) diff --git a/cbits/mktemp.c b/cbits/mktemp.c --- a/cbits/mktemp.c +++ b/cbits/mktemp.c @@ -41,13 +41,21 @@ #include #include #include + +#if defined(__wasm__) +#include +#else #include #include -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) @@ -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 diff --git a/include/HsUnixCompat.h b/include/HsUnixCompat.h --- a/include/HsUnixCompat.h +++ b/include/HsUnixCompat.h @@ -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 diff --git a/src/System/PosixCompat.hs b/src/System/PosixCompat.hs --- a/src/System/PosixCompat.hs +++ b/src/System/PosixCompat.hs @@ -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. diff --git a/src/System/PosixCompat/Extensions.hsc b/src/System/PosixCompat/Extensions.hsc --- a/src/System/PosixCompat/Extensions.hsc +++ b/src/System/PosixCompat/Extensions.hsc @@ -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 diff --git a/src/System/PosixCompat/Files.hsc b/src/System/PosixCompat/Files.hsc --- a/src/System/PosixCompat/Files.hsc +++ b/src/System/PosixCompat/Files.hsc @@ -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,16 +122,30 @@ 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 -import System.IO (IOMode(..), openFile, hFileSize, hSetFileSize, hClose) +import System.Directory (Permissions, emptyPermissions) +import System.Directory (getPermissions, setPermissions) +import System.Directory (readable, setOwnerReadable) +import System.Directory (writable, setOwnerWritable) +import System.Directory (executable, setOwnerExecutable) +import System.Directory (searchable, setOwnerSearchable) +import System.Directory (doesFileExist, doesDirectoryExist) +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__ @@ -256,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 @@ -297,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) @@ -312,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" @@ -363,7 +423,7 @@ -- Hard links createLink :: FilePath -> FilePath -> IO () -createLink _ _ = unsupported "createLink" +createLink = createHardLink removeLink :: FilePath -> IO () removeLink _ = unsupported "removeLink" @@ -375,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() @@ -402,7 +466,36 @@ -- utime() setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO () -setFileTimes _ _ _ = unsupported "setFileTimes" +setFileTimes file atime mtime = + bracket openFileHandle closeHandle $ \handle -> do + (creationTime, _, _) <- getFileTime handle + setFileTimeCompat + handle + creationTime + (epochTimeToFileTime atime) + (epochTimeToFileTime mtime) + where + openFileHandle = createFile file + gENERIC_WRITE + fILE_SHARE_NONE + Nothing + oPEN_EXISTING + fILE_ATTRIBUTE_NORMAL + Nothing + + -- based on https://support.microsoft.com/en-us/kb/167296 + epochTimeToFileTime (CTime t) = FILETIME (fromIntegral ll) + 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 = diff --git a/src/System/PosixCompat/Internal/Time.hs b/src/System/PosixCompat/Internal/Time.hs --- a/src/System/PosixCompat/Internal/Time.hs +++ b/src/System/PosixCompat/Internal/Time.hs @@ -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 diff --git a/src/System/PosixCompat/Process.hs b/src/System/PosixCompat/Process.hs new file mode 100644 --- /dev/null +++ b/src/System/PosixCompat/Process.hs @@ -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 diff --git a/src/System/PosixCompat/Temp.hs b/src/System/PosixCompat/Temp.hs --- a/src/System/PosixCompat/Temp.hs +++ b/src/System/PosixCompat/Temp.hs @@ -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) diff --git a/src/System/PosixCompat/Types.hs b/src/System/PosixCompat/Types.hs --- a/src/System/PosixCompat/Types.hs +++ b/src/System/PosixCompat/Types.hs @@ -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 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) diff --git a/src/System/PosixCompat/User.hsc b/src/System/PosixCompat/User.hsc deleted file mode 100644 --- a/src/System/PosixCompat/User.hsc +++ /dev/null @@ -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 diff --git a/tests/LinksSpec.hs b/tests/LinksSpec.hs new file mode 100644 --- /dev/null +++ b/tests/LinksSpec.hs @@ -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 + ) diff --git a/tests/MkstempSpec.hs b/tests/MkstempSpec.hs new file mode 100644 --- /dev/null +++ b/tests/MkstempSpec.hs @@ -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 diff --git a/tests/ProcessSpec.hs b/tests/ProcessSpec.hs new file mode 100644 --- /dev/null +++ b/tests/ProcessSpec.hs @@ -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 diff --git a/tests/main.hs b/tests/main.hs new file mode 100644 --- /dev/null +++ b/tests/main.hs @@ -0,0 +1,13 @@ +module Main where + +import MkstempSpec +import LinksSpec +import ProcessSpec + +import Test.Hspec + +main :: IO () +main = hspec $ do + mkstempSpec + linksSpec + processSpec diff --git a/unix-compat.cabal b/unix-compat.cabal --- a/unix-compat.cabal +++ b/unix-compat.cabal @@ -1,72 +1,110 @@ +cabal-version: 1.18 name: unix-compat -version: 0.4.1.4 +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 +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.6 - 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