unix-compat 0.5.4 → 0.6
raw patch · 7 files changed
+291/−33 lines, 7 filesdep +HUnitdep +extradep +filepathdep ~directory
Dependencies added: HUnit, extra, filepath, hspec, monad-parallel, temporary, unix-compat
Dependency ranges changed: directory
Files
- CHANGELOG.md +3/−0
- LICENSE +2/−0
- src/System/PosixCompat/Files.hsc +45/−29
- tests/LinksSpec.hs +122/−0
- tests/MkstempSpec.hs +29/−0
- tests/main.hs +11/−0
- unix-compat.cabal +79/−4
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## 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
src/System/PosixCompat/Files.hsc view
@@ -122,6 +122,7 @@ 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(..))@@ -133,10 +134,12 @@ 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)@@ -314,14 +317,23 @@ isSocket stat = (fileMode stat `intersectFileModes` fileTypeModes) == socketMode -getFileStatus :: FilePath -> IO FileStatus-getFileStatus path = do- perm <- liftM permsToMode (getPermissions path)- typ <- getFileType 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)@@ -340,13 +352,38 @@ } 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 + openReparsePoint = if forLink then fILE_FLAG_OPEN_REPARSE_POINT else 0++ -- not yet defined in Win32 package:+ fILE_FLAG_OPEN_REPARSE_POINT :: FileAttributeOrFlag+ fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000++ -- 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.@@ -373,30 +410,9 @@ truncate (t * 10000000 + windowsPosixEpochDifference) -} -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."- getFdStatus :: Fd -> IO FileStatus getFdStatus _ = unsupported "getFdStatus" -getSymbolicLinkStatus :: FilePath -> IO FileStatus-getSymbolicLinkStatus path = getFileStatus path- createNamedPipe :: FilePath -> FileMode -> IO () createNamedPipe _ _ = unsupported "createNamedPipe" @@ -419,7 +435,7 @@ createSymbolicLink _ _ = unsupported "createSymbolicLink" readSymbolicLink :: FilePath -> IO FilePath-readSymbolicLink _ = unsupported "readSymbolicLink"+readSymbolicLink = getSymbolicLinkTarget -- ----------------------------------------------------------------------------- -- Renaming
+ 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/main.hs view
@@ -0,0 +1,11 @@+module Main where++import MkstempSpec+import LinksSpec++import Test.Hspec++main :: IO ()+main = hspec $ do+ mkstempSpec+ linksSpec
unix-compat.cabal view
@@ -1,5 +1,5 @@ name: unix-compat-version: 0.5.4+version: 0.6 synopsis: Portable POSIX-compatibility layer. description: This package provides portable implementations of parts of the unix package. This package re-exports the unix@@ -15,9 +15,12 @@ build-type: Simple cabal-version: >= 1.10 +extra-source-files:+ CHANGELOG.md+ source-repository head type: git- location: git://github.com/jacobstanley/unix-compat.git+ location: git@github.com:jacobstanley/unix-compat.git flag old-time description: build against old-time package@@ -46,6 +49,7 @@ extra-libraries: msvcrt build-depends: Win32 >= 2.5.0.0+ build-depends: filepath >= 1.0 && < 1.5 if flag(old-time) build-depends: old-time >= 1.0.0.0 && < 1.2.0.0@@ -58,16 +62,87 @@ build-depends: directory == 1.1.* else build-depends: time >= 1.0 && < 1.13- build-depends: directory >= 1.2 && < 1.4+ build-depends: directory >= 1.3.1 && < 1.4 other-modules: System.PosixCompat.Internal.Time else- build-depends: unix >= 2.4 && < 2.9+ build-depends: unix >= 2.6 && < 2.9 include-dirs: include includes: HsUnixCompat.h install-includes: HsUnixCompat.h c-sources: cbits/HsUnixCompat.c if os(solaris) cc-options: -DSOLARIS++Test-Suite unix-compat-testsuite+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ ghc-options: -Wall+ main-is: main.hs++ other-modules:+ MkstempSpec+ LinksSpec++ -- ghc-options:+ -- -Wall+ -- -fwarn-tabs+ -- -funbox-strict-fields+ -- -threaded+ -- -fno-warn-unused-do-bind+ -- -fno-warn-type-defaults++ -- extensions:+ -- OverloadedStrings+ -- ExtendedDefaultRules++ -- if flag(lifted)+ -- cpp-options: -DLIFTED++ build-depends:+ unix-compat+ , base == 4.*+ , monad-parallel+ , hspec+ , HUnit+ , directory+ , extra+ , temporary++ if os(windows)+ -- c-sources:+ -- cbits/HsUname.c+ -- cbits/mktemp.c++ -- extra-libraries: msvcrt+ -- build-depends: Win32 >= 2.5.0.0++ 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.13+ build-depends: directory >= 1.3.1 && < 1.4++ -- other-modules:+ -- System.PosixCompat.Internal.Time++ else+ -- build-depends: unix >= 2.4 && < 2.9+ -- include-dirs: include+ -- includes: HsUnixCompat.h+ -- install-includes: HsUnixCompat.h+ -- c-sources: cbits/HsUnixCompat.c+ if os(solaris)+ cc-options: -DSOLARIS++ build-depends: directory >= 1.3.1 && < 1.4