95 lines
3.2 KiB
OCaml
95 lines
3.2 KiB
OCaml
open Lwt.Syntax
|
|
open Lwt.Infix
|
|
open Config
|
|
|
|
let read_file path =
|
|
let open Lwt_io in
|
|
with_file ~mode:Input path (fun f -> f |> read_chars |> Lwt_stream.to_string)
|
|
|
|
let scrape_pid uid pid =
|
|
let proc = "/proc/" ^ pid in
|
|
let* ours = Lwt_unix.stat proc >|= fun x -> x.st_uid = uid in
|
|
if ours then
|
|
let* command = proc ^ "/comm" |> read_file >|= String.trim in
|
|
let* state =
|
|
let* s = proc ^ "/stat" |> read_file in
|
|
s |> Parse.get_state
|
|
in
|
|
let* cwd = proc ^ "/cwd" |> Lwt_unix.readlink in
|
|
Lwt.return_some (String.trim command, state, cwd)
|
|
else Lwt.return_none
|
|
|
|
let scrape_all uid =
|
|
let* pids =
|
|
Lwt_unix.files_of_directory "/proc"
|
|
|> Lwt_stream.filter (fun name ->
|
|
String.fold_left
|
|
(fun result char ->
|
|
if not result then false
|
|
else match char with '0' .. '9' -> true | _ -> false)
|
|
true name)
|
|
|> Lwt_stream.to_list
|
|
in
|
|
(* scrape procfs for info *)
|
|
pids
|
|
|> Lwt_list.map_p (fun x ->
|
|
Lwt.catch
|
|
(fun () -> scrape_pid uid x)
|
|
(function
|
|
| Unix.Unix_error (_, _, _) ->
|
|
(* sick of these errors and i don't fucking care !!! *)
|
|
(* let* () = *)
|
|
(* Lwt_io.eprintlf "Error scraping pid %s: %s" x *)
|
|
(* (Unix.error_message e) *)
|
|
(* in *)
|
|
Lwt.return_none
|
|
| Lwt_io.Channel_closed e ->
|
|
let* () = Lwt_io.eprintlf "channel closed: %s" e in
|
|
Lwt.return_none
|
|
| _ ->
|
|
let* () = Lwt_io.eprintlf "Unknown error during pid scrape" in
|
|
Lwt.return_none))
|
|
|
|
|
|
|
|
let get_blockers ~(blockers : blocker_list) ~config_path
|
|
~procdata =
|
|
let is_at_rest state cond =
|
|
match state with 'T' when cond = Stop -> true | 'X' -> true | _ -> false
|
|
in
|
|
let* blockers =
|
|
procdata
|
|
|> Lwt_list.filter_p (function
|
|
| Some (cmd, state, cwd) ->
|
|
let blocker = List.find_opt (fun b -> b.name = cmd) blockers in
|
|
let cond = (Option.value ~default:{name=""; cond=Stop} blocker).cond in
|
|
let cmd_block = Option.is_some blocker in
|
|
let state_block =
|
|
not (is_at_rest state cond)
|
|
and cwd_block =
|
|
if String.length cwd >= String.length config_path then
|
|
String.sub cwd 0 (String.length config_path) = config_path
|
|
else false
|
|
in
|
|
let blocked = cmd_block && state_block && cwd_block in
|
|
Lwt.return blocked
|
|
(* can we improve error handling here ? *)
|
|
| None -> Lwt.return_false)
|
|
in
|
|
List.length blockers > 0 |> Lwt.return
|
|
|
|
let rec scrape_loop ~blockers ~config_path ~uid =
|
|
(* get all relevant process info *)
|
|
let* procdata = scrape_all uid in
|
|
(* determine who is blocking our update *)
|
|
let* blocked = get_blockers ~blockers ~config_path ~procdata in
|
|
(* have a snooze and come back *)
|
|
if blocked then
|
|
let* () = Lwt_unix.sleep 2.0 in
|
|
scrape_loop ~blockers ~config_path ~uid
|
|
else Lwt.return_unit
|
|
|
|
let await_blockers ~config_path ~blockers =
|
|
let uid = Unix.getuid () in
|
|
scrape_loop ~blockers ~config_path ~uid
|