diff options
| author | Ben Sima <ben@bsima.me> | 2024-04-15 15:32:22 -0400 |
|---|---|---|
| committer | Ben Sima <ben@bsima.me> | 2024-04-15 16:00:53 -0400 |
| commit | bceac781e4505a6e2089621012deee449fe62b11 (patch) | |
| tree | e212313994515b101ea371d323004f4c4bd44541 /Biz | |
| parent | de41131cb6b462946caaec9a9a87767441081474 (diff) | |
Cleanup build processes on timeout
On timeout, bild would leave it's child processes still running, which means
that a long build would continue to go in the background, and I'd have to
manually find and kill it. The fix was simply to use Conduit's
`closeStreamingProcessHandle` function, and make sure that Conduit created a
group for the processes (by default it doesn't).
I tested this by building and running `bild` with a very low timeout (1 minute)
and watching `gotop` to make sure it stopped the active build process. I
couldn't figure out a simple way to test this automatically.
Diffstat (limited to 'Biz')
| -rw-r--r-- | Biz/Bild.hs | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index f8385c8..cc10782 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -208,16 +208,14 @@ move args = /> filter isBuildableNs +> foldM analyze mempty +> printOrBuild - +> exitSummary - -- convert minutes to microseconds - |> Timeout.timeout (minutes * 60_000_000) + |> Timeout.timeout (toMillis minutes) +> \case Nothing -> - Log.wipe + Log.br >> Log.fail ["bild", "timeout after " <> tshow minutes <> " minutes"] + >> Log.br >> exitWith (ExitFailure 124) - Just _ -> - pure () + Just s -> exitSummary s where minutes = Cli.getArgWithDefault args "10" (Cli.longOption "time") @@ -951,12 +949,17 @@ data Proc = Proc onSuccess :: IO () } +-- | Convert minutes to milliseconds. +toMillis :: Num a => a -> a +toMillis mins = mins * 60_000_000 + -- | Run a subprocess, streaming output if --loud is set. run :: Proc -> IO (Exit.ExitCode, ByteString) run Proc {..} = do IO.hSetBuffering stdout IO.NoBuffering loud ?| Log.info ["proc", unwords <| map str <| cmd : args] Conduit.proc cmd args + |> (\proc -> proc {Process.create_group = True}) |> Conduit.streamingProcess +> \(Conduit.UseProvidedHandle, stdout_, stderr_, hdl) -> (,,) </ Async.Concurrently (Conduit.waitForStreamingProcess hdl) @@ -965,11 +968,14 @@ run Proc {..} = do |> Async.runConcurrently +> \case (Exit.ExitFailure n, output, outerr) -> - putStr outerr + Conduit.closeStreamingProcessHandle hdl + >> putStr outerr >> onFailure >> pure (Exit.ExitFailure n, output) (Exit.ExitSuccess, output, _) -> - onSuccess >> pure (Exit.ExitSuccess, output) + Conduit.closeStreamingProcessHandle hdl + >> onSuccess + >> pure (Exit.ExitSuccess, output) -- | Helper for running a standard bild subprocess. proc :: |