package devkit
Development kit - general purpose library
Install
Dune Dependency
Authors
Maintainers
Sources
devkit-1.3.tbz
sha256=dae965685dceed47ad8e9844f12fe707dafdf2c3bdd46d0431d5b4d1e7754b23
sha512=b94ade804d751db87434042bbaa821fa8e82e233820a76806f910e2da040094b137e88a3579911a1626930912622b064c776ddbcb6991fb7111021ebf6553fdc
doc/src/devkit.core/signal.ml.html
Source file signal.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
(** Signal handling *) open ExtLib module U = ExtUnix.All module Ev = Async.Ev let log = Log.from "signal" (** {2 libevent + signalfd} *) type t = { ev : Ev.event; fd : Unix.file_descr; h : (int, (int -> unit)) Hashtbl.t; mutable active : bool; } let init events = let fd = U.signalfd ~sigs:[] ~flags:[] () in Unix.set_nonblock fd; let t = { ev = Ev.create (); fd = fd; h = Hashtbl.create 1; active = true; } in Ev.set events t.ev t.fd ~persist:true [Ev.READ] (fun _ _ -> try (* references to t keep it alive with ev *) let ssi = U.signalfd_read t.fd in let signo = U.ssi_signo_sys ssi in match Hashtbl.find_option t.h signo with | None -> Exn.fail "no handler for %d" signo | Some f -> f signo with exn -> log #warn ~exn "signal handler" ); Ev.add t.ev None; t let stop t = match t.active with | false -> () | true -> Ev.del t.ev; Hashtbl.clear t.h; Unix.close t.fd; t.active <- false let handle t sigs f = List.iter (fun signo -> Hashtbl.replace t.h signo f) sigs; let sigs = List.of_enum (Hashtbl.keys t.h) in let (_:int list) = Unix.sigprocmask Unix.SIG_BLOCK sigs in let _ = U.signalfd ~fd:t.fd ~sigs ~flags:[] () in () let handle_exit t f = handle t [Sys.sigterm; Sys.sigint] (fun n -> log #info "Received signal %i (exit)..." n; (try f () with exn -> log #warn ~exn "Signal.handle_exit"); log #info "Signal handler done.";) let handle_reload t f = handle t [Sys.sighup] (fun n -> log #info "Received signal %i (reload)..." n; (try f () with exn -> log #warn ~exn "Signal.handle_reload"); log #info "Signal handler done.") (** {2 Lwt} *) let h_lwt = Hashtbl.create 10 let lwt_handle sigs f = sigs |> List.iter begin fun signo -> Option.may Lwt_unix.disable_signal_handler @@ Hashtbl.find_option h_lwt signo; let sig_id = Lwt_unix.on_signal signo (fun (_:int) -> f ()) in Hashtbl.replace h_lwt signo sig_id end let lwt_handle_exit = lwt_handle [Sys.sigterm; Sys.sigint] let lwt_handle_reload = lwt_handle [Sys.sighup] (** {2 generic registration} *) let install_sys signo f = Sys.set_signal signo (Sys.Signal_handle f) let install_libevent t signo f = handle t [signo] f let install_lwt signo f = lwt_handle [signo] (fun () -> f signo) let h = Hashtbl.create 10 let verbose = ref false let do_install = ref install_sys let is_safe_output () = !verbose let set sigs f = sigs |> List.iter begin fun signo -> let f = match Hashtbl.find_option h signo with | None -> f | Some g -> (fun n -> g n; f n) in Hashtbl.replace h signo f; !do_install signo f end let set1 signal f = set [signal] (fun _ -> f ()) type state = (int, int -> unit) Hashtbl.t let save () = Hashtbl.copy h let restore x = Hashtbl.clear h; Hashtbl.iter (Hashtbl.add h) x let replace sigs f = sigs |> List.iter (fun signo -> Hashtbl.replace h signo f; !do_install signo f) let reinstall () = Hashtbl.iter !do_install h let wrap name f = begin fun n -> if !verbose then log #info "Received signal %i (%s)..." n name; (try f () with exn -> if !verbose then log #warn ~exn "Signal handler failed"); if !verbose then log #info "Signal handler done."; end let set_exit f = set [Sys.sigterm; Sys.sigint] (wrap "exit" f) let set_reload f = set [Sys.sighup] (wrap "reload" f) let setup_sys () = verbose := false; (* potential deadlock *) do_install := install_sys; reinstall () let setup_libevent' t = verbose := true; do_install := (install_libevent t); reinstall () let setup_libevent = setup_libevent' let setup_libevent_ events = setup_libevent' @@ init events let setup_lwt () = verbose := true; do_install := install_lwt; reinstall ()
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>