improve slightly

This probably avoids the situation that caused the exception to be
thrown. It also makes sure that both threads end up canceled in the end,
while before the exception from wait outt could have caused errt to
never be waited on.

diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 3a9d3620a7fe48bf646321df7beabe5784659fa6..e62a5bba4a678436901a42ed0d9154e3fe9dc45d 100644 (file)
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -319,6 +319,7 @@ outputFilter cmd params environ outfilter errfilter =
                outt <- async $ tryIO (outfilter outh) >> hClose outh
                errt <- async $ tryIO (errfilter errh) >> hClose errh
                ret <- waitForProcess pid
+
                -- Normally, now that the process has exited, the threads
                -- will finish processing its output and terminate.
                -- But, just in case the process did something evil like
@@ -330,7 +331,10 @@ outputFilter cmd params environ outfilter errfilter =
                -- openssh.)
                void $ tryNonAsync $ race_
                        (wait outt >> wait errt)
-                       (threadDelaySeconds (Seconds 2) >> cancel outt >> cancel errt)
+                       (threadDelaySeconds (Seconds 2))
+               cancel outt
+               cancel errt
+
                return ret
        go _ _ _ _ = error "internal"