T7363: track process id in session data

In practice, this may be passed in the request as the ppid, as needed
for CLI applications to coordinate with the ambient config session. For
other uses, the client pid will suffice.

10 files changed, 44 insertions, 19 deletions

diff --git a/data/vyconf.proto b/data/vyconf.proto
index 5e9d0ff..f77b035 100644
--- a/data/vyconf.proto
+++ b/data/vyconf.proto
@@ -13,8 +13,9 @@ message Request {
   }
 
   message SetupSession {
-    optional string ClientApplication = 1;
-    optional int32 OnBehalfOf = 2;
+    required int32 ClientPid = 1;
+    optional string ClientApplication = 2;
+    optional int32 OnBehalfOf = 3;
   }
 
   message Teardown {
diff --git a/src/session.ml b/src/session.ml
index 1ff7c45..e7be5d7 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -27,15 +27,17 @@ type session_data = {
     changeset: cfg_op list;
     client_app: string;
     user: string;
+    client_pid: int32;
 }
 
-let make world client_app user = {
+let make world client_app user pid = {
     proposed_config = world.running_config;
     modified = false;
     conf_mode = false;
     changeset = [];
     client_app = client_app;
-    user = user
+    user = user;
+    client_pid = pid;
 }
 
 let string_of_op op =
diff --git a/src/session.mli b/src/session.mli
index 4bae311..f7469e0 100644
--- a/src/session.mli
+++ b/src/session.mli
@@ -15,12 +15,13 @@ type session_data = {
     conf_mode: bool;
     changeset: cfg_op list;
     client_app: string;
-    user: string
+    user: string;
+    client_pid: int32
 }
 
 exception Session_error of string
 
-val make : world -> string -> string -> session_data
+val make : world -> string -> string -> int32 -> session_data
 
 val set_modified : session_data -> session_data
 
diff --git a/src/vycli.ml b/src/vycli.ml
index 75e92b5..174d6f4 100644
--- a/src/vycli.ml
+++ b/src/vycli.ml
@@ -67,7 +67,8 @@ let main socket op path out_format config_format =
                     | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
                 end
             | OpSetupSession ->
-                let%lwt resp = setup_session client "vycli" in
+                let pid = Int32.of_int (Unix.getppid ()) in
+                let%lwt resp = setup_session client "vycli" pid in
                 begin
                     match resp with
                     | Ok c -> get_token c
diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
index c4811c5..9971f8f 100644
--- a/src/vyconf_client.ml
+++ b/src/vyconf_client.ml
@@ -53,10 +53,10 @@ let prompt client =
     let%lwt resp = do_request client req in
     Lwt.return resp
 
-let setup_session ?(on_behalf_of=None) client client_app =
+let setup_session ?(on_behalf_of=None) client client_app pid =
     if Option.is_some client.session then Lwt.return (Error "Client is already associated with a session") else
     let id = on_behalf_of |> (function None -> None | Some x -> (Some (Int32.of_int x))) in
-    let req = Setup_session {client_application=(Some client_app); on_behalf_of=id} in
+    let req = Setup_session {client_application=(Some client_app); on_behalf_of=id; client_pid=pid} in
     let%lwt resp = do_request client req in
     match resp.status with
     | Success ->
diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli
index 9c25c60..39e955b 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -8,7 +8,7 @@ val shutdown : t -> t Lwt.t
 
 val prompt : t -> Vyconf_connect.Vyconf_pbt.response Lwt.t
 
-val setup_session : ?on_behalf_of:(int option) -> t -> string -> (t, string) result Lwt.t
+val setup_session : ?on_behalf_of:(int option) -> t -> string -> int32 -> (t, string) result Lwt.t
 
 val teardown_session : ?on_behalf_of:(int option) -> t -> (string, string) result Lwt.t
 
diff --git a/src/vyconf_client_session.ml b/src/vyconf_client_session.ml
index 407aaff..93068fa 100644
--- a/src/vyconf_client_session.ml
+++ b/src/vyconf_client_session.ml
@@ -33,7 +33,8 @@ let call_op ?(out_format="plain") ?(config_format="curly") socket token op path
             begin
             match o with
             | OpSetupSession ->
-                let%lwt resp = Vyconf_client.setup_session client "vyconf_client_session" in
+                let pid = Int32.of_int (Unix.getppid ()) in
+                let%lwt resp = Vyconf_client.setup_session client "vyconf_client_session" pid in
                 begin
                     match resp with
                     | Ok c -> Vyconf_client.get_token c
diff --git a/src/vyconf_pbt.ml b/src/vyconf_pbt.ml
index 2f528a1..c3a608f 100644
--- a/src/vyconf_pbt.ml
+++ b/src/vyconf_pbt.ml
@@ -11,6 +11,7 @@ type request_output_format =
 type request_prompt = unit
 
 type request_setup_session = {
+  client_pid : int32;
   client_application : string option;
   on_behalf_of : int32 option;
 }
@@ -183,9 +184,11 @@ let rec default_request_output_format () = (Out_plain:request_output_format)
 let rec default_request_prompt = ()
 
 let rec default_request_setup_session 
+  ?client_pid:((client_pid:int32) = 0l)
   ?client_application:((client_application:string option) = None)
   ?on_behalf_of:((on_behalf_of:int32 option) = None)
   () : request_setup_session  = {
+  client_pid;
   client_application;
   on_behalf_of;
 }
@@ -387,11 +390,13 @@ let rec default_response
 }
 
 type request_setup_session_mutable = {
+  mutable client_pid : int32;
   mutable client_application : string option;
   mutable on_behalf_of : int32 option;
 }
 
 let default_request_setup_session_mutable () : request_setup_session_mutable = {
+  client_pid = 0l;
   client_application = None;
   on_behalf_of = None;
 }
@@ -654,7 +659,8 @@ let rec pp_request_prompt fmt (v:request_prompt) =
 
 let rec pp_request_setup_session fmt (v:request_setup_session) = 
   let pp_i fmt () =
-    Pbrt.Pp.pp_record_field ~first:true "client_application" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.client_application;
+    Pbrt.Pp.pp_record_field ~first:true "client_pid" Pbrt.Pp.pp_int32 fmt v.client_pid;
+    Pbrt.Pp.pp_record_field ~first:false "client_application" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.client_application;
     Pbrt.Pp.pp_record_field ~first:false "on_behalf_of" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.on_behalf_of;
   in
   Pbrt.Pp.pp_brk pp_i fmt ()
@@ -896,16 +902,18 @@ let rec encode_pb_request_prompt (v:request_prompt) encoder =
 ()
 
 let rec encode_pb_request_setup_session (v:request_setup_session) encoder = 
+  Pbrt.Encoder.int32_as_varint v.client_pid encoder;
+  Pbrt.Encoder.key 1 Pbrt.Varint encoder; 
   begin match v.client_application with
   | Some x -> 
     Pbrt.Encoder.string x encoder;
-    Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 
+    Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 
   | None -> ();
   end;
   begin match v.on_behalf_of with
   | Some x -> 
     Pbrt.Encoder.int32_as_varint x encoder;
-    Pbrt.Encoder.key 2 Pbrt.Varint encoder; 
+    Pbrt.Encoder.key 3 Pbrt.Varint encoder; 
   | None -> ();
   end;
   ()
@@ -1307,23 +1315,31 @@ let rec decode_pb_request_prompt d =
 let rec decode_pb_request_setup_session d =
   let v = default_request_setup_session_mutable () in
   let continue__= ref true in
+  let client_pid_is_set = ref false in
   while !continue__ do
     match Pbrt.Decoder.key d with
     | None -> (
     ); continue__ := false
-    | Some (1, Pbrt.Bytes) -> begin
-      v.client_application <- Some (Pbrt.Decoder.string d);
+    | Some (1, Pbrt.Varint) -> begin
+      v.client_pid <- Pbrt.Decoder.int32_as_varint d; client_pid_is_set := true;
     end
     | Some (1, pk) -> 
       Pbrt.Decoder.unexpected_payload "Message(request_setup_session), field(1)" pk
-    | Some (2, Pbrt.Varint) -> begin
-      v.on_behalf_of <- Some (Pbrt.Decoder.int32_as_varint d);
+    | Some (2, Pbrt.Bytes) -> begin
+      v.client_application <- Some (Pbrt.Decoder.string d);
     end
     | Some (2, pk) -> 
       Pbrt.Decoder.unexpected_payload "Message(request_setup_session), field(2)" pk
+    | Some (3, Pbrt.Varint) -> begin
+      v.on_behalf_of <- Some (Pbrt.Decoder.int32_as_varint d);
+    end
+    | Some (3, pk) -> 
+      Pbrt.Decoder.unexpected_payload "Message(request_setup_session), field(3)" pk
     | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
   done;
+  begin if not !client_pid_is_set then Pbrt.Decoder.missing_field "client_pid" end;
   ({
+    client_pid = v.client_pid;
     client_application = v.client_application;
     on_behalf_of = v.on_behalf_of;
   } : request_setup_session)
diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli
index 5791bff..667a64d 100644
--- a/src/vyconf_pbt.mli
+++ b/src/vyconf_pbt.mli
@@ -18,6 +18,7 @@ type request_output_format =
 type request_prompt = unit
 
 type request_setup_session = {
+  client_pid : int32;
   client_application : string option;
   on_behalf_of : int32 option;
 }
@@ -196,6 +197,7 @@ val default_request_prompt : unit
 (** [default_request_prompt ()] is the default value for type [request_prompt] *)
 
 val default_request_setup_session : 
+  ?client_pid:int32 ->
   ?client_application:string option ->
   ?on_behalf_of:int32 option ->
   unit ->
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 9eaee6b..b0b4e52 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -51,8 +51,9 @@ let make_session_token () =
 let setup_session world req =
     let token = make_session_token () in
     let user = "unknown user" in
+    let pid = req.client_pid in
     let client_app = Option.value req.client_application ~default:"unknown client" in
-    let () = Hashtbl.add sessions token (Session.make world client_app user) in
+    let () = Hashtbl.add sessions token (Session.make world client_app user pid) in
     {response_tmpl with output=(Some token)}
 
 let find_session token = Hashtbl.find sessions token