pass pid as int not string

Author: patricoferris

lib/macos.ml

@@ -1,29 +1,31 @@
 (* Extensions to the Os module for macOS *)
-open Lwt.Infix
+open Lwt.Syntax
 open Os
 
 let ( / ) = Filename.concat
 
 let user_exists ~user =
-  pread ["sudo"; "dscl"; "."; "list"; "/Users"] >|= fun s ->
+  let+ s = pread ["sudo"; "dscl"; "."; "list"; "/Users"] in
   List.exists (Astring.String.equal user) (Astring.String.cuts ~sep:"\n" s)
 
 (* Generates a new MacOS user called `<prefix><uid>' *)
 let create_new_user ~username ~home ~uid ~gid =
-  user_exists ~user:username >>= begin function
-    | true ->  Lwt.return_ok ()
-    | false ->
-      let user = "/Users" / username in
-      let pp s ppf = Fmt.pf ppf "[ Mac ] %s\n" s in
-      let dscl = ["dscl"; "."; "-create"; user ] in
-        sudo_result ~pp:(pp "UniqueID") (dscl @ ["UniqueID"; uid]) >>!= fun _ ->
-        sudo_result ~pp:(pp "PrimaryGroupID") (dscl @ ["PrimaryGroupID"; gid]) >>!= fun _ ->
-        sudo_result ~pp:(pp "UserShell") (dscl @ ["UserShell"; "/bin/bash"]) >>!= fun _ ->
-        sudo_result ~pp:(pp "NFSHomeDirectory") (dscl @ ["NFSHomeDirectory"; home])
-  end
+  let* exists = user_exists ~user:username in
+  if exists then Lwt.return_ok ()
+  else
+    let user = "/Users" / username in
+    let pp s ppf = Fmt.pf ppf "[ Mac ] %s\n" s in
+    let dscl = [ "dscl"; "."; "-create"; user ] in
+    sudo_result ~pp:(pp "UniqueID") (dscl @ [ "UniqueID"; uid ]) >>!= fun _ ->
+    sudo_result ~pp:(pp "PrimaryGroupID") (dscl @ [ "PrimaryGroupID"; gid ])
+    >>!= fun _ ->
+    sudo_result ~pp:(pp "UserShell") (dscl @ [ "UserShell"; "/bin/bash" ])
+    >>!= fun _ ->
+    sudo_result ~pp:(pp "NFSHomeDirectory") (dscl @ [ "NFSHomeDirectory"; home ])
 
 let delete_user ~user =
-  user_exists ~user >>= begin function
+  let* exists = user_exists ~user in
+  match exists with
     | false ->
       Log.info (fun f -> f "Not deleting %s as they don't exist" user);
       Lwt_result.return ()
@@ -32,32 +34,30 @@ let delete_user ~user =
       let pp s ppf = Fmt.pf ppf "[ Mac ] %s\n" s in
       let delete = ["dscl"; "."; "-delete"; user ] in
         sudo_result ~pp:(pp "Deleting") delete
-  end
 
 let descendants ~pid =
   Lwt.catch
-    (fun () -> pread ["sudo"; "pgrep"; "-P"; pid ] >|= fun s -> Astring.String.cuts ~sep:"\n" s)
+    (fun () ->
+      let+ s = pread ["sudo"; "pgrep"; "-P"; string_of_int pid ] in
+      let pids = Astring.String.cuts ~sep:"\n" s in
+      List.filter_map int_of_string_opt pids)
     (* Errors if there are none, probably errors for other reasons too... *)
     (fun _ -> Lwt.return [])
 
 let kill ~pid =
-  let pp s ppf = Fmt.pf ppf "[ %s ]" s in
-  if String.length pid = 0 then (Log.warn (fun f -> f "Empty PID"); Lwt.return ())
-  else begin
-    let delete = ["kill"; "-9";  pid ] in
-    sudo_result ~pp:(pp "KILL") delete >>= fun t ->
-      match t with
-      | Ok () -> Lwt.return ()
-      | Error (`Msg m) -> (
-        Log.warn (fun f -> f "Failed to kill process %s because %s" pid m);
-        Lwt.return ()
-      )
-  end
+  let pp _ ppf = Fmt.pf ppf "[ KILL ]" in
+  let delete = ["kill"; "-9";  string_of_int pid ] in
+  let* t = sudo_result ~pp:(pp "KILL") delete in
+    match t with
+    | Ok () -> Lwt.return ()
+    | Error (`Msg m) ->
+      Log.warn (fun f -> f "Failed to kill process %i because %s" pid m);
+      Lwt.return ()
 
 let kill_all_descendants ~pid =
   let rec kill_all pid : unit Lwt.t =
-    descendants ~pid >>= fun ds ->
-    Lwt_list.iter_s kill_all ds >>= fun () ->
+    let* ds = descendants ~pid in
+    let* () = Lwt_list.iter_s kill_all ds in
     kill ~pid
   in
     kill_all pid

lib/macos_sandbox.ml

@@ -92,7 +92,7 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config homedir =
     let aux () =
       if Lwt.is_sleeping proc then (
         match !proc_id with
-          | Some pid -> Macos.kill_all_descendants ~pid:(string_of_int pid)
+          | Some pid -> Macos.kill_all_descendants ~pid
           | None -> Log.warn (fun f -> f "Failed to find pid..."); Lwt.return ()
           )
       else Lwt.return_unit  (* Process has already finished *)

lib/macos_sandbox.mli

@@ -10,5 +10,5 @@ val cmdliner : config Cmdliner.Term.t
     and parameters to setup a specific sandbox's configuration. *)
 
 val create : state_dir:string -> config -> t Lwt.t
-(** [create ~state_dir config] is a runc sandboxing system that keeps state in [state_dir]
-    and is configured using [config]. *)
+(** [create ~state_dir config] is a user-based sandboxing system for macOS that
+    keeps state in [state_dir] and is configured using [config]. *)