diff --git a/example/z-playground/server/playground.ml b/example/z-playground/server/playground.ml index 191c5d04..b45b9561 100644 --- a/example/z-playground/server/playground.ml +++ b/example/z-playground/server/playground.ml @@ -479,12 +479,6 @@ let rec gc ?(initial = true) () = let () = Dream.log "Starting playground"; - (* Stop when systemd sends SIGTERM. *) - let stop, signal_stop = Lwt.wait () in - Lwt_unix.on_signal Sys.sigterm (fun _signal -> - Lwt.wakeup_later signal_stop ()) - |> ignore; - (* Build the base image. *) Lwt_main.run begin Lwt_io.(with_file ~mode:Output "Dockerfile" (fun channel -> @@ -520,7 +514,7 @@ let () = Dream.html (Client.html example) in - Dream.run ~interface:"0.0.0.0" ~port:80 ~stop ~adjust_terminal:false + Dream.run ~interface:"0.0.0.0" ~port:80 ~adjust_terminal:false @@ Dream.logger @@ Dream.router [ diff --git a/src/dream.mli b/src/dream.mli index 9a1bd5dd..d5b98d97 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -2130,7 +2130,7 @@ val run : - [~stop] is a promise that causes the server to stop accepting new requests, and {!Dream.run} to return. Requests that have already entered the Web application continue to be processed. The default value is a - promise that never resolves. + promise that resolves when [SIGTERM] or [SIGINT] is received. - [~error_handler] handles all errors, both from the application, and low-level errors. See {!section-errors} and example {{:https://github.com/camlworks/dream/tree/master/example/9-error#folders-and-files} diff --git a/src/http/http.ml b/src/http/http.ml index c1054ea2..6cce597a 100644 --- a/src/http/http.ml +++ b/src/http/http.ml @@ -673,7 +673,19 @@ let serve_with_maybe_https let default_interface = "localhost" let default_port = 8080 -let never = fst (Lwt.wait ()) + +(* Lazy option default to avoid side effects. *) +let option_or opt default = match opt with + | Some v -> v + | None -> default () + +(* Lazy signal handler to avoid side effects. *) +let on_termination_signal () = + let term_promise, term_resolve = Lwt.wait () in + let int_promise, int_resolve = Lwt.wait () in + ignore (Lwt_unix.on_signal Sys.sigterm (fun _ -> Lwt.wakeup_later term_resolve ())); + ignore (Lwt_unix.on_signal Sys.sigint (fun _ -> Lwt.wakeup_later int_resolve ())); + Lwt.pick [term_promise; int_promise] let network ~port ~socket_path = match socket_path with @@ -684,7 +696,7 @@ let serve ?(interface = default_interface) ?(port = default_port) ?socket_path - ?(stop = never) + ?stop ?(error_handler = Error_handler.default) ?(tls = false) ?certificate_file @@ -696,7 +708,7 @@ let serve "serve" ~interface ~network:(network ~port ~socket_path) - ~stop + ~stop:(option_or stop on_termination_signal) ~error_handler ~tls:(if tls then `OpenSSL else `No) ?certificate_file @@ -712,7 +724,7 @@ let run ?(interface = default_interface) ?(port = default_port) ?socket_path - ?(stop = never) + ?stop ?(error_handler = Error_handler.default) ?(tls = false) ?certificate_file @@ -759,7 +771,7 @@ let run "run" ~interface ~network:(network ~port ~socket_path) - ~stop + ~stop:(option_or stop on_termination_signal) ~error_handler ~tls:(if tls then `OpenSSL else `No) ?certificate_file ?key_file