directory 1.3.5.0 → 1.3.6.0
raw patch · 8 files changed
+84/−9 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- System/Directory.hs +6/−3
- System/Directory/Internal/Posix.hsc +8/−1
- System/Directory/Internal/Prelude.hs +1/−1
- changelog.md +6/−0
- directory.cabal +2/−1
- tests/GetHomeDirectory002.hs +17/−0
- tests/Main.hs +2/−0
- tests/Util.hs +42/−3
System/Directory.hs view
@@ -1498,9 +1498,12 @@ application-specific data here; use 'getXdgDirectory' or 'getAppUserDataDirectory' instead. -On Unix, 'getHomeDirectory' returns the value of the @HOME@-environment variable. On Windows, the system is queried for a-suitable path; a typical path might be @C:\/Users\//\<user\>/@.+On Unix, 'getHomeDirectory' behaves as follows:++* Returns $HOME env variable if set (including to an empty string).+* Otherwise uses home directory returned by `getpwuid_r` using the UID of the current proccesses user. This basically reads the /etc/passwd file. An empty home directory field is considered valid.++On Windows, the system is queried for a suitable path; a typical path might be @C:\/Users\//\<user\>/@. The operation may fail with:
System/Directory/Internal/Posix.hsc view
@@ -17,6 +17,7 @@ import qualified Data.Time.Clock.POSIX as POSIXTime import qualified GHC.Foreign as GHC import qualified System.Posix as Posix+import qualified System.Posix.User as PU createDirectoryInternal :: FilePath -> IO () createDirectoryInternal path = Posix.createDirectory path 0o777@@ -280,8 +281,14 @@ getPath :: IO [FilePath] getPath = splitSearchPath <$> getEnv "PATH" +-- | $HOME is preferred, because the user has control over it. However, POSIX+-- doesn't define it as a mandatory variable, so fall back to `getpwuid_r`. getHomeDirectoryInternal :: IO FilePath-getHomeDirectoryInternal = getEnv "HOME"+getHomeDirectoryInternal = do+ e <- lookupEnv "HOME"+ case e of+ Just fp -> pure fp+ Nothing -> PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID) getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath getXdgDirectoryFallback getHomeDirectory xdgDir = do
System/Directory/Internal/Prelude.hs view
@@ -47,7 +47,7 @@ #if MIN_VERSION_base(4, 8, 0) import Data.Void (Void) #else-import Control.Applicative (Applicative, (<*>), pure)+import Control.Applicative (Applicative, (<*>), (*>), pure) import Data.Functor ((<$>), (<$)) #endif import Control.Arrow (second)
changelog.md view
@@ -1,6 +1,12 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.6.0 (January 2020)++ * On non-Windows platforms, `getHomeDirectory` will fall back to+ `getpwuid_r` if `HOME` is not set.+ ([#102](https://github.com/haskell/directory/issues/102))+ ## 1.3.5.0 (December 2019) * Revert change introduced in the version `1.3.3.2`: Non-absolute `XDG_*`
directory.cabal view
@@ -1,5 +1,5 @@ name: directory-version: 1.3.5.0+version: 1.3.6.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -96,6 +96,7 @@ GetDirContents002 GetFileSize GetHomeDirectory001+ GetHomeDirectory002 GetPermissions001 LongPaths MakeAbsolute
+ tests/GetHomeDirectory002.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}+module GetHomeDirectory002 where++#if !defined(mingw32_HOST_OS)+import System.Posix.Env+#endif+#include "util.inl"++-- Test that the getpwuid_r fallback works.+-- This is only relevant on unix.+main :: TestEnv -> IO ()+main _t = do+#if !defined(mingw32_HOST_OS)+ unsetEnv "HOME"+#endif+ _ <- getHomeDirectory+ T(expect) () True -- avoid warnings about redundant imports
tests/Main.hs view
@@ -16,6 +16,7 @@ import qualified GetDirContents002 import qualified GetFileSize import qualified GetHomeDirectory001+import qualified GetHomeDirectory002 import qualified GetPermissions001 import qualified LongPaths import qualified MakeAbsolute@@ -49,6 +50,7 @@ T.isolatedRun _t "GetDirContents002" GetDirContents002.main T.isolatedRun _t "GetFileSize" GetFileSize.main T.isolatedRun _t "GetHomeDirectory001" GetHomeDirectory001.main+ T.isolatedRun _t "GetHomeDirectory002" GetHomeDirectory002.main T.isolatedRun _t "GetPermissions001" GetPermissions001.main T.isolatedRun _t "LongPaths" LongPaths.main T.isolatedRun _t "MakeAbsolute" MakeAbsolute.main
tests/Util.hs view
@@ -1,10 +1,16 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} -- | A rudimentary testing framework module Util where import Prelude () import System.Directory.Internal.Prelude import System.Directory import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime)+#if MIN_VERSION_base(4, 7, 0)+import System.Environment (getEnvironment, setEnv, unsetEnv)+#elif !defined(mingw32_HOST_OS)+import qualified System.Posix as Posix+#endif import System.FilePath ((</>), normalise) import qualified Data.List as List @@ -141,6 +147,37 @@ where cleanup dir' | keep = return () | otherwise = removePathForcibly dir' +isolateEnvironment :: IO a -> IO a+isolateEnvironment = bracket getEnvs setEnvs . const+ where+ getEnvs = List.sort . filter (\(k, _) -> k /= "") <$> getEnvironment+ setEnvs target = do+ current <- getEnvs+ updateEnvs current target+ new <- getEnvs+ when (target /= new) $ do+ -- Environment variables may be sensitive, so don't log them.+ throwIO (userError "isolateEnvironment.setEnvs failed")+ updateEnvs kvs1@((k1, v1) : kvs1') kvs2@((k2, v2) : kvs2') =+ case compare k1 k2 of+ LT -> unsetEnv k1 *> updateEnvs kvs1' kvs2+ EQ | v1 == v2 -> updateEnvs kvs1' kvs2'+ | otherwise -> setEnv k1 v2 *> updateEnvs kvs1' kvs2'+ GT -> setEnv k2 v2 *> updateEnvs kvs1 kvs2'+ updateEnvs [] [] = pure ()+ updateEnvs kvs1 [] = for_ kvs1 (unsetEnv . fst)+ updateEnvs [] kvs2 = for_ kvs2 (uncurry setEnv)+#if MIN_VERSION_base(4, 7, 0)+#elif !defined(mingw32_HOST_OS)+ getEnvironment = Posix.getEnvironment+ setEnv k v = Posix.setEnv k v True+ unsetEnv = Posix.unsetEnv+#else+ getEnvironment = pure []+ setEnv _ _ = pure ()+ unsetEnv _ = pure ()+#endif+ isolateWorkingDirectory :: Bool -> FilePath -> IO a -> IO a isolateWorkingDirectory keep dir action = do when (normalise dir `List.elem` [".", "./"]) $@@ -160,9 +197,11 @@ Right () -> return () isolatedRun :: TestEnv -> String -> (TestEnv -> IO ()) -> IO ()-isolatedRun t@TestEnv{testKeepDirs = keep} name =- run t name .- (isolateWorkingDirectory keep ("dist/test-" <> name <> ".tmp") .)+isolatedRun t@TestEnv{testKeepDirs = keep} name = run t name . (isolate .)+ where+ isolate =+ isolateEnvironment .+ isolateWorkingDirectory keep ("dist/test-" <> name <> ".tmp") tryRead :: Read a => String -> Maybe a tryRead s =