close send side of password pipe on exec

This avoids a hang approximately 1% of the time when running the test
suite on StatelessOpenPGP.

Since I've not seen git-annex hang when running git like that, I guess
git probably does something that avoids hanging similarly. Still, fixed
the same problem in Utility.Gpg too.

Sponsored-by: Kevin Mueller on Patreon

diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
index 54521fbedf11d5ca8d27fc648220f81c19cbb36a..2ef077990f4627dfa3cdd7ba6322f081b4c57655 100644 (file)
--- a/Utility/Gpg.hs
+++ b/Utility/Gpg.hs
@@ -163,6 +163,7 @@ feedRead cmd params passphrase feeder reader = do
        let setup = liftIO $ do
                -- pipe the passphrase into gpg on a fd
                (frompipe, topipe) <- System.Posix.IO.createPipe
+               setFdOption topipe CloseOnExec True
                toh <- fdToHandle topipe
                t <- async $ do
                        B.hPutStr toh (passphrase <> "\n")

diff --git a/Utility/StatelessOpenPGP.hs b/Utility/StatelessOpenPGP.hs
index dfee3ec3c561d7cfae4b9243429c15033eefb12c..73e3746a3a537ba3c666f9331645bc88967b9b9c 100644 (file)
--- a/Utility/StatelessOpenPGP.hs
+++ b/Utility/StatelessOpenPGP.hs
@@ -133,6 +133,7 @@ feedRead cmd subcmd params password emptydirectory feeder reader = do
        let setup = liftIO $ do
                -- pipe the passphrase in on a fd
                (frompipe, topipe) <- System.Posix.IO.createPipe
+               setFdOption topipe CloseOnExec True
                toh <- fdToHandle topipe
                t <- async $ do
                        B.hPutStr toh (password <> "\n")