From cacc7e67185ab040fd7b2f0ea156dd2684066d66 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 17 Jul 2022 14:19:18 +0200
Subject: [PATCH 1/2] Add regression test for putEnv wrt #68

---
 tests/PutEnv001.hs | 32 ++++++++++++++++++++++++++++++++
 unix.cabal         |  8 ++++++++
 2 files changed, 40 insertions(+)
 create mode 100644 tests/PutEnv001.hs

diff --git a/tests/PutEnv001.hs b/tests/PutEnv001.hs
new file mode 100644
index 00000000..0a7f1af6
--- /dev/null
+++ b/tests/PutEnv001.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -O0 -Wno-name-shadowing #-}
+
+module Main (main) where
+
+import Data.String ( fromString )
+import System.Mem
+import System.Posix.Env.ByteString
+import Test.Tasty
+import Test.Tasty.HUnit
+
+-- test regression of incorrect 'free': https://github.com/haskell/unix/issues/68#issue-170072591
+main :: IO ()
+main = do
+  putEnv "foo=bar"
+  defaultMain $ testGroup "All" [ test ]
+
+test :: TestTree
+test = testCase "putEnv" $ do
+  performMinorGC
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  performMinorGC
+  print env
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  performMinorGC
+  print env
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  performMinorGC
+  print env
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  print env
+  env @?= Just (fromString "bar")
diff --git a/unix.cabal b/unix.cabal
index a297c5d5..b2702adf 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -242,3 +242,11 @@ test-suite Terminal
     default-language: Haskell2010
     build-depends: base, unix, tasty-hunit
     ghc-options: -Wall
+
+test-suite PutEnv001
+    hs-source-dirs: tests
+    main-is: PutEnv001.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix, tasty, tasty-hunit
+    ghc-options: -Wall -with-rtsopts=-V0 -O0

From 8bb190c84e5cf39ffb6fbe7e1223d086cafc89c8 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 17 Jul 2022 01:02:32 +0200
Subject: [PATCH 2/2] Synchronize ByteString and String modules

And fix free-bug in 'putEnv'. Fixes #68
---
 System/Posix/Env/ByteString.hsc | 37 ++++++++++++++++++++++++++++-----
 1 file changed, 32 insertions(+), 5 deletions(-)

diff --git a/System/Posix/Env/ByteString.hsc b/System/Posix/Env/ByteString.hsc
index e1888d7e..924b9395 100644
--- a/System/Posix/Env/ByteString.hsc
+++ b/System/Posix/Env/ByteString.hsc
@@ -1,5 +1,5 @@
 {-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -21,9 +21,11 @@ module System.Posix.Env.ByteString (
         , getEnvDefault
         , getEnvironmentPrim
         , getEnvironment
+        , setEnvironment
         , putEnv
         , setEnv
-       , unsetEnv
+        , unsetEnv
+        , clearEnv
 
        -- * Program arguments
        , getArgs
@@ -31,13 +33,16 @@ module System.Posix.Env.ByteString (
 
 #include "HsUnix.h"
 
+import Control.Monad
 import Foreign
 import Foreign.C
 import Data.Maybe       ( fromMaybe )
 
+import System.Posix.Env ( clearEnv )
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import Data.ByteString (ByteString)
+import Data.ByteString.Internal (ByteString (PS), memcpy)
 
 -- |'getEnv' looks up a variable in the environment.
 
@@ -96,6 +101,18 @@ getEnvironment = do
       | BC.head y == '=' = (x,B.tail y)
       | otherwise       = error $ "getEnvironment: insane variable " ++ BC.unpack x
 
+-- |'setEnvironment' resets the entire environment to the given list of
+-- @(key,value)@ pairs.
+--
+-- @since 2.8.0.0
+setEnvironment ::
+  [(ByteString,ByteString)] {- ^ @[(key,value)]@ -} ->
+  IO ()
+setEnvironment env = do
+  clearEnv
+  forM_ env $ \(key,value) ->
+    setEnv key value True {-overwrite-}
+
 -- |The 'unsetEnv' function deletes all instances of the variable name
 -- from the environment.
 
@@ -116,15 +133,25 @@ foreign import capi unsafe "HsUnix.h unsetenv"
    c_unsetenv :: CString -> IO ()
 # endif
 #else
-unsetEnv name = putEnv (name ++ "=")
+unsetEnv name = putEnv (BC.snoc name '=')
 #endif
 
 -- |'putEnv' function takes an argument of the form @name=value@
 -- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
 
 putEnv :: ByteString {- ^ "key=value" -} -> IO ()
-putEnv keyvalue = B.useAsCString keyvalue $ \s ->
-  throwErrnoIfMinus1_ "putenv" (c_putenv s)
+putEnv (PS fp o l) = withForeignPtr fp $ \p -> do
+  -- https://pubs.opengroup.org/onlinepubs/009696899/functions/putenv.html
+  --
+  -- "the string pointed to by string shall become part of the environment,
+  -- so altering the string shall change the environment. The space used by
+  -- string is no longer used once a new string which defines name is passed to putenv()."
+  --
+  -- hence we must not free the buffer
+  buf <- mallocBytes (l+1)
+  memcpy buf (p `plusPtr` o) l
+  pokeByteOff buf l (0::Word8)
+  throwErrnoIfMinus1_ "putenv" (c_putenv (castPtr buf))
 
 foreign import ccall unsafe "putenv"
    c_putenv :: CString -> IO CInt