Skip to content

Commit

Permalink
Fix high CPU usage with external processes. Fixes: savonet#475
Browse files Browse the repository at this point in the history
toots committed Aug 30, 2017
1 parent 267a14e commit b30f102
Showing 2 changed files with 18 additions and 11 deletions.
2 changes: 2 additions & 0 deletions CHANGES
Original file line number Diff line number Diff line change
@@ -11,6 +11,8 @@ Changed:

Fixed:

- Fix scheduler loop causing high CPU usage when using External_process without some of the default callbacks. (#475)

- Revert `wait_for` implementation to pre-`1.3.0`, using a custom `select` loop (#453)

- Handle mime-type arguments in input.harbor streams. (#456)
27 changes: 16 additions & 11 deletions src/tools/process_handler.ml
Original file line number Diff line number Diff line change
@@ -117,15 +117,6 @@ let run ?priority ?env ?on_start ?on_stdin ?on_stdout ?on_stderr ?on_stop ?log c
let on_stop =
with_default (fun _ -> false) on_stop
in
let on_stdout =
with_default (fun _ -> `Continue) on_stdout
in
let on_stderr =
with_default (fun _ -> `Continue) on_stderr
in
let on_stdin =
with_default (fun _ -> `Continue) on_stdin
in
let create () =
log "Starting process";
let stdout,stdin,stderr =
@@ -150,11 +141,16 @@ let run ?priority ?env ?on_start ?on_stdin ?on_stdout ?on_stderr ?on_stop ?log c
Unix.descr_of_in_channel process.stderr
in
let read_events =
[`Read out_pipe;`Read stdout;`Read stderr]
List.fold_left (fun cur (fd, callback) ->
if callback <> None then (`Read fd)::cur
else cur)
[`Read out_pipe]
[(stdout, on_stdout);(stderr, on_stderr)]
in
let continue_events =
if process.stopped then read_events else
if on_stdin <> None && not process.stopped then
(`Write (Unix.descr_of_out_channel process.stdin))::read_events
else read_events
in
let events = match decision with
| `Kill -> cleanup ~log t; []
@@ -196,6 +192,15 @@ let run ?priority ?env ?on_start ?on_stdin ?on_stdout ?on_stderr ?on_stop ?log c
let stdout =
Unix.descr_of_in_channel process.stdout
in
let on_stdout =
with_default (fun _ -> `Continue) on_stdout
in
let on_stderr =
with_default (fun _ -> `Continue) on_stderr
in
let on_stdin =
with_default (fun _ -> `Continue) on_stdin
in
try
let decision =
if List.mem (`Read out_pipe) l then on_pipe () else

0 comments on commit b30f102

Please sign in to comment.