Fix segfault for System.Posix.Env.ByteString.getEnvironment

(fixes #274)

Author: sol

System/Posix/Env.hsc

@@ -28,16 +28,16 @@ module System.Posix.Env (
 
 #include "HsUnix.h"
 
+import Foreign hiding (void)
 import Foreign.C.Error (throwErrnoIfMinus1_)
 import Foreign.C.Types
 import Foreign.C.String
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
 import Control.Monad
 import Data.Maybe (fromMaybe)
 import System.Posix.Internals
 
+import qualified System.Posix.Env.Internal as Internal
+
 -- |'getEnv' looks up a variable in the environment.
 
 getEnv ::
@@ -63,28 +63,7 @@ foreign import ccall unsafe "getenv"
    c_getenv :: CString -> IO CString
 
 getEnvironmentPrim :: IO [String]
-getEnvironmentPrim = do
-  c_environ <- getCEnviron
-  -- environ can be NULL
-  if c_environ == nullPtr
-    then return []
-    else do
-      arr <- peekArray0 nullPtr c_environ
-      mapM peekFilePath arr
-
-getCEnviron :: IO (Ptr CString)
-#if HAVE__NSGETENVIRON
--- You should not access @char **environ@ directly on Darwin in a bundle/shared library.
--- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
-getCEnviron = nsGetEnviron >>= peek
-
-foreign import ccall unsafe "_NSGetEnviron"
-   nsGetEnviron :: IO (Ptr (Ptr CString))
-#else
-getCEnviron = peek c_environ_p
-foreign import ccall unsafe "&environ"
-   c_environ_p :: Ptr (Ptr CString)
-#endif
+getEnvironmentPrim = Internal.getEnvironmentPrim >>= mapM peekFilePath 
 
 -- |'getEnvironment' retrieves the entire environment as a
 -- list of @(key,value)@ pairs.
@@ -184,7 +163,7 @@ foreign import ccall unsafe "clearenv"
 #else
 -- Fallback to 'environ[0] = NULL'.
 clearEnv = do
-  c_environ <- getCEnviron
+  c_environ <- Internal.getCEnviron
   unless (c_environ == nullPtr) $
     poke c_environ nullPtr
 #endif

System/Posix/Env/ByteString.hsc

@@ -44,6 +44,8 @@ import qualified Data.ByteString.Char8 as BC
 import Data.ByteString (ByteString)
 import Data.ByteString.Internal (ByteString (PS), memcpy)
 
+import qualified System.Posix.Env.Internal as Internal
+
 -- |'getEnv' looks up a variable in the environment.
 
 getEnv ::
@@ -69,25 +71,7 @@ foreign import ccall unsafe "getenv"
    c_getenv :: CString -> IO CString
 
 getEnvironmentPrim :: IO [ByteString]
-getEnvironmentPrim = do
-  c_environ <- getCEnviron
-  arr <- peekArray0 nullPtr c_environ
-  mapM B.packCString arr
-
-getCEnviron :: IO (Ptr CString)
-#if HAVE__NSGETENVIRON
--- You should not access @char **environ@ directly on Darwin in a bundle/shared library.
--- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
-getCEnviron = nsGetEnviron >>= peek
-
-foreign import ccall unsafe "_NSGetEnviron"
-   nsGetEnviron :: IO (Ptr (Ptr CString))
-#else
-getCEnviron = peek c_environ_p
-
-foreign import ccall unsafe "&environ"
-   c_environ_p :: Ptr (Ptr CString)
-#endif
+getEnvironmentPrim = Internal.getEnvironmentPrim >>= mapM B.packCString
 
 -- |'getEnvironment' retrieves the entire environment as a
 -- list of @(key,value)@ pairs.

System/Posix/Env/Internal.hsc

@@ -0,0 +1,29 @@
+module System.Posix.Env.Internal where
+
+#include "HsUnix.h"
+
+import Foreign
+import Foreign.C
+
+getEnvironmentPrim :: IO [Ptr CChar]
+getEnvironmentPrim = do
+  c_environ <- getCEnviron
+  if c_environ == nullPtr
+    then return []
+    else do
+      peekArray0 nullPtr c_environ
+
+getCEnviron :: IO (Ptr CString)
+#if HAVE__NSGETENVIRON
+-- You should not access @char **environ@ directly on Darwin in a bundle/shared library.
+-- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
+getCEnviron = nsGetEnviron >>= peek
+
+foreign import ccall unsafe "_NSGetEnviron"
+   nsGetEnviron :: IO (Ptr (Ptr CString))
+#else
+getCEnviron = peek c_environ_p
+
+foreign import ccall unsafe "&environ"
+   c_environ_p :: Ptr (Ptr CString)
+#endif

System/Posix/Env/PosixString.hsc

@@ -45,6 +45,8 @@ import System.OsString.Internal.Types
 import qualified System.OsPath.Data.ByteString.Short as B
 import Data.ByteString.Short.Internal ( copyToPtr )
 
+import qualified System.Posix.Env.Internal as Internal
+
 -- |'getEnv' looks up a variable in the environment.
 
 getEnv ::
@@ -70,25 +72,7 @@ foreign import ccall unsafe "getenv"
    c_getenv :: CString -> IO CString
 
 getEnvironmentPrim :: IO [PosixString]
-getEnvironmentPrim = do
-  c_environ <- getCEnviron
-  arr <- peekArray0 nullPtr c_environ
-  mapM (fmap PS . B.packCString) arr
-
-getCEnviron :: IO (Ptr CString)
-#if HAVE__NSGETENVIRON
--- You should not access @char **environ@ directly on Darwin in a bundle/shared library.
--- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
-getCEnviron = nsGetEnviron >>= peek
-
-foreign import ccall unsafe "_NSGetEnviron"
-   nsGetEnviron :: IO (Ptr (Ptr CString))
-#else
-getCEnviron = peek c_environ_p
-
-foreign import ccall unsafe "&environ"
-   c_environ_p :: Ptr (Ptr CString)
-#endif
+getEnvironmentPrim = Internal.getEnvironmentPrim >>= mapM (fmap PS . B.packCString)
 
 -- |'getEnvironment' retrieves the entire environment as a
 -- list of @(key,value)@ pairs.

tests/Test.hs

@@ -13,7 +13,7 @@ import Data.List (sort)
 import System.Exit
 import System.IO
 import System.Posix
-import qualified System.Posix.Env.ByteString
+import qualified System.Posix.Env.ByteString as ByteString
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -28,7 +28,7 @@ main = defaultMain $ testGroup "All"
   , fileStatus
   , fileStatusByteString
   , getEnvironment01
-  , getEnvironment02
+  , testSystemPosixEnvByteString
   , getGroupEntry
   , getUserEntry
   , processGroup001
@@ -69,11 +69,24 @@ getEnvironment01 = testCase "getEnvironment01" $ do
   not (null env)
     @? "environment should be non-empty"
 
-getEnvironment02 :: TestTree
-getEnvironment02 = testCase "getEnvironment02" $ do
-  env <- System.Posix.Env.ByteString.getEnvironment
-  not (null env)
-    @? "environment should be non-empty"
+protectEnvironment :: IO a -> IO a
+protectEnvironment action = E.bracket ByteString.getEnvironment ByteString.setEnvironment $ \ _ -> action
+
+testSystemPosixEnvByteString :: TestTree
+testSystemPosixEnvByteString =
+  testGroup "System.Posix.Env.ByteString" [
+    testGroup "getEnvironment" [
+      testCase "returns the environment" $ do
+        env <- ByteString.getEnvironment
+        not (null env)
+          @? "environment should be non-empty"
+    ]
+  , testGroup "clearEnv" [
+      testCase "clears the environment" $ protectEnvironment $ do
+        ByteString.clearEnv
+        ByteString.getEnvironment >>= (@?= [])
+    ]
+  ]
 
 getGroupEntry :: TestTree
 getGroupEntry = testCase "getGroupEntry" $ do
@@ -174,7 +187,7 @@ posix002 = testCase "posix002" $ do
   sort (lines actual) @?= ["ONE=1", "TWO=2"]
 
 posix005 :: TestTree
-posix005 = testCase "posix005" $ do
+posix005 = testCase "posix005" $ protectEnvironment $ do
     hSetBuffering stdout NoBuffering
 
     setEnvironment [("one","1"),("two","2")]

unix.cabal

@@ -141,6 +141,7 @@ library
         System.Posix.Process.Common
         System.Posix.Terminal.Common
         System.Posix.User.Common
+        System.Posix.Env.Internal
 
     ghc-options: -Wall