work around ghc segfault

hSetEncoding of a closed handle segfaults.
https://ghc.haskell.org/trac/ghc/ticket/7161

8484c0c1976b2daa4be674b09f6f54c15c746aa6 introduced the crash.
In particular, stdin may get closed (by eg, getContents) and then trying
to set its encoding will crash. We didn't need to adjust stdin's
encoding anyway, but only stderr, to work around
https://github.com/yesodweb/persistent/issues/474

Thanks to Mesar Hameed for assistance related to reproducing this bug.

diff --git a/Database/Handle.hs b/Database/Handle.hs
index 9071cd5380446f36995a4c7b9aa08213ff822788..d84ce5b6209655967cf8e0061e1c7b2e470b5671 100644 (file)
--- a/Database/Handle.hs
+++ b/Database/Handle.hs
@@ -69,7 +69,7 @@ openDb db tablename = do
        worker <- async (workerThread (T.pack db) tablename jobs)
        
        -- work around https://github.com/yesodweb/persistent/issues/474
-       liftIO useFileSystemEncoding
+       liftIO $ fileEncoding stderr
 
        return $ DbHandle worker jobs
 

diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs
index be43ace95e863d87665e36049d6828de8079a643..ae3bd35d7b4d7045af16540faa545c66a1ce3f80 100644 (file)
--- a/Utility/FileSystemEncoding.hs
+++ b/Utility/FileSystemEncoding.hs
@@ -10,6 +10,7 @@
 
 module Utility.FileSystemEncoding (
        useFileSystemEncoding,
+       fileEncoding,
        withFilePath,
        md5FilePath,
        decodeBS,
@@ -63,6 +64,13 @@ useFileSystemEncoding = do
        hSetEncoding stderr e
        Encoding.setLocaleEncoding e    
 
+fileEncoding :: Handle -> IO ()
+#ifndef mingw32_HOST_OS
+fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
+#else
+fileEncoding h = hSetEncoding h Encoding.utf8
+#endif
+
 {- Marshal a Haskell FilePath into a NUL terminated C string using temporary
  - storage. The FilePath is encoded using the filesystem encoding,
  - reversing the decoding that should have been done when the FilePath