Skip to content

Commit b5b80d9

Browse files
authored
Workaround hDuplicateTo issues (#235)
We have seen a bunch of failures on CI where this failed with EBUSY. I find the hDuplicateTo here to be quite useful for debugging since you don’t have to worry about corrupting the JSON-RPC stream to instead of getting rid of it, we add a somewhat ugly workaround. There is an explanation in an inline comment on why this helps but admittedly I am somewhat guessing since I don’t understand what is actually allocating the file descriptor that turns out to be stdout. That said, I am not guessing on the results: Without this PR I am able to make this fail in roughly 50% of the cases on CI whereas with this PR, I’ve now run it 60 times on CI without a single failure.
1 parent fa2c295 commit b5b80d9

File tree

2 files changed

+81
-3
lines changed

2 files changed

+81
-3
lines changed

src/Development/IDE/GHC/Util.hs

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,11 +20,15 @@ module Development.IDE.GHC.Util(
2020
moduleImportPath,
2121
HscEnvEq, hscEnv, newHscEnvEq,
2222
readFileUtf8,
23+
hDuplicateTo,
2324
cgGutsToCoreModule
2425
) where
2526

2627
import Config
28+
import Control.Concurrent
2729
import Data.List.Extra
30+
import Data.Maybe
31+
import Data.Typeable
2832
#if MIN_GHC_API_VERSION(8,6,0)
2933
import Fingerprint
3034
#endif
@@ -34,6 +38,12 @@ import GhcPlugins hiding (Unique)
3438
import Data.IORef
3539
import Control.Exception
3640
import FileCleanup
41+
import GHC.IO.BufferedIO (BufferedIO)
42+
import GHC.IO.Device as IODevice
43+
import GHC.IO.Encoding
44+
import GHC.IO.Exception
45+
import GHC.IO.Handle.Types
46+
import GHC.IO.Handle.Internals
3747
import Platform
3848
import Data.Unique
3949
import Development.Shake.Classes
@@ -154,3 +164,71 @@ cgGutsToCoreModule safeMode guts modDetails = CoreModule
154164
(md_types modDetails)
155165
(cg_binds guts)
156166
safeMode
167+
168+
-- This is a slightly modified version of hDuplicateTo in GHC.
169+
-- See the inline comment for more details.
170+
hDuplicateTo :: Handle -> Handle -> IO ()
171+
hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2) = do
172+
withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
173+
-- The implementation in base has this call to hClose_help.
174+
-- _ <- hClose_help h2_
175+
-- hClose_help does two things:
176+
-- 1. It flushes the buffer, we replicate this here
177+
_ <- flushWriteBuffer h2_ `catch` \(_ :: IOException) -> pure ()
178+
-- 2. It closes the handle. This is redundant since dup2 takes care of that
179+
-- but even worse it is actively harmful! Once the handle has been closed
180+
-- another thread is free to reallocate it. This leads to dup2 failing with EBUSY
181+
-- if it happens just in the right moment.
182+
withHandle_' "hDuplicateTo" h1 m1 $ \h1_ -> do
183+
dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)
184+
hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2) = do
185+
withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do
186+
_ <- hClose_help w2_
187+
withHandle_' "hDuplicateTo" h1 w1 $ \w1_ -> do
188+
dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)
189+
withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do
190+
_ <- hClose_help r2_
191+
withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do
192+
dupHandleTo path h1 (Just w1) r2_ r1_ Nothing
193+
hDuplicateTo h1 _ =
194+
ioe_dupHandlesNotCompatible h1
195+
196+
-- | This is copied unmodified from GHC since it is not exposed.
197+
dupHandleTo :: FilePath
198+
-> Handle
199+
-> Maybe (MVar Handle__)
200+
-> Handle__
201+
-> Handle__
202+
-> Maybe HandleFinalizer
203+
-> IO Handle__
204+
dupHandleTo filepath h other_side
205+
_hto_@Handle__{haDevice=devTo}
206+
h_@Handle__{haDevice=dev} mb_finalizer = do
207+
flushBuffer h_
208+
case cast devTo of
209+
Nothing -> ioe_dupHandlesNotCompatible h
210+
Just dev' -> do
211+
_ <- IODevice.dup2 dev dev'
212+
FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
213+
takeMVar m
214+
215+
-- | This is copied unmodified from GHC since it is not exposed.
216+
-- Note the beautiful inline comment!
217+
dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
218+
-> FilePath
219+
-> Maybe (MVar Handle__)
220+
-> Handle__
221+
-> Maybe HandleFinalizer
222+
-> IO Handle
223+
dupHandle_ new_dev filepath other_side _h_@Handle__{..} mb_finalizer = do
224+
-- XXX wrong!
225+
mb_codec <- if isJust haEncoder then fmap Just getLocaleEncoding else return Nothing
226+
mkHandle new_dev filepath haType True{-buffered-} mb_codec
227+
NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }
228+
mb_finalizer other_side
229+
230+
-- | This is copied unmodified from GHC since it is not exposed.
231+
ioe_dupHandlesNotCompatible :: Handle -> IO a
232+
ioe_dupHandlesNotCompatible h =
233+
ioException (IOError (Just h) IllegalOperation "hDuplicateTo"
234+
"handles are incompatible" Nothing Nothing)

src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Development.IDE.LSP.LanguageServer
1212
import Language.Haskell.LSP.Types
1313
import Language.Haskell.LSP.Types.Capabilities
1414
import Development.IDE.LSP.Server
15+
import qualified Development.IDE.GHC.Util as Ghcide
1516
import qualified Language.Haskell.LSP.Control as LSP
1617
import qualified Language.Haskell.LSP.Core as LSP
1718
import Control.Concurrent.Chan
@@ -23,7 +24,7 @@ import Data.Default
2324
import Data.Maybe
2425
import qualified Data.Set as Set
2526
import qualified Data.Text as T
26-
import GHC.IO.Handle (hDuplicate, hDuplicateTo)
27+
import GHC.IO.Handle (hDuplicate)
2728
import System.IO
2829
import Control.Monad.Extra
2930

@@ -37,7 +38,6 @@ import Development.IDE.Core.FileStore
3738
import Language.Haskell.LSP.Core (LspFuncs(..))
3839
import Language.Haskell.LSP.Messages
3940

40-
4141
runLanguageServer
4242
:: LSP.Options
4343
-> PartialHandlers
@@ -48,7 +48,7 @@ runLanguageServer options userHandlers getIdeState = do
4848
-- to stdout. This guards against stray prints from corrupting the JSON-RPC
4949
-- message stream.
5050
newStdout <- hDuplicate stdout
51-
stderr `hDuplicateTo` stdout
51+
stderr `Ghcide.hDuplicateTo` stdout
5252
hSetBuffering stderr NoBuffering
5353
hSetBuffering stdout NoBuffering
5454

0 commit comments

Comments
 (0)