T7910: add request show_sessions to list all session records

5 files changed, 113 insertions, 2 deletions

diff --git a/src/session.ml b/src/session.ml
index 4156b73..4f4f299 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -38,7 +38,7 @@ type session_data = {
     client_pid: int32;
     client_user: string;
     client_sudo_user: string;
-}
+} [@@deriving yojson]
 
 let make _world client_app sudo_user user pid = {
     modified = false;
diff --git a/src/session.mli b/src/session.mli
index ea838c9..ebe67b3 100644
--- a/src/session.mli
+++ b/src/session.mli
@@ -24,7 +24,7 @@ type session_data = {
     client_pid: int32;
     client_user: string;
     client_sudo_user: string;
-}
+} [@@deriving yojson]
 
 exception Session_error of string
 
diff --git a/src/vyconf_pbt.ml b/src/vyconf_pbt.ml
index 1fbbf75..d84d94f 100644
--- a/src/vyconf_pbt.ml
+++ b/src/vyconf_pbt.ml
@@ -154,6 +154,11 @@ type request_reload_reftree = {
   on_behalf_of : int32 option;
 }
 
+type request_show_sessions = {
+  exclude_self : bool;
+  exclude_other : bool;
+}
+
 type request =
   | Prompt
   | Setup_session of request_setup_session
@@ -186,6 +191,7 @@ type request =
   | Get_config of request_get_config
   | Aux_set of request_aux_set
   | Aux_delete of request_aux_delete
+  | Show_sessions of request_show_sessions
 
 type request_envelope = {
   token : string option;
@@ -445,6 +451,14 @@ let rec default_request_reload_reftree
   on_behalf_of;
 }
 
+let rec default_request_show_sessions 
+  ?exclude_self:((exclude_self:bool) = false)
+  ?exclude_other:((exclude_other:bool) = false)
+  () : request_show_sessions  = {
+  exclude_self;
+  exclude_other;
+}
+
 let rec default_request (): request = Prompt
 
 let rec default_request_envelope 
@@ -749,6 +763,16 @@ let default_request_reload_reftree_mutable () : request_reload_reftree_mutable =
   on_behalf_of = None;
 }
 
+type request_show_sessions_mutable = {
+  mutable exclude_self : bool;
+  mutable exclude_other : bool;
+}
+
+let default_request_show_sessions_mutable () : request_show_sessions_mutable = {
+  exclude_self = false;
+  exclude_other = false;
+}
+
 type request_envelope_mutable = {
   mutable token : string option;
   mutable request : request;
@@ -1001,6 +1025,13 @@ let rec pp_request_reload_reftree fmt (v:request_reload_reftree) =
   in
   Pbrt.Pp.pp_brk pp_i fmt ()
 
+let rec pp_request_show_sessions fmt (v:request_show_sessions) = 
+  let pp_i fmt () =
+    Pbrt.Pp.pp_record_field ~first:true "exclude_self" Pbrt.Pp.pp_bool fmt v.exclude_self;
+    Pbrt.Pp.pp_record_field ~first:false "exclude_other" Pbrt.Pp.pp_bool fmt v.exclude_other;
+  in
+  Pbrt.Pp.pp_brk pp_i fmt ()
+
 let rec pp_request fmt (v:request) =
   match v with
   | Prompt  -> Format.fprintf fmt "Prompt"
@@ -1034,6 +1065,7 @@ let rec pp_request fmt (v:request) =
   | Get_config x -> Format.fprintf fmt "@[<hv2>Get_config(@,%a)@]" pp_request_get_config x
   | Aux_set x -> Format.fprintf fmt "@[<hv2>Aux_set(@,%a)@]" pp_request_aux_set x
   | Aux_delete x -> Format.fprintf fmt "@[<hv2>Aux_delete(@,%a)@]" pp_request_aux_delete x
+  | Show_sessions x -> Format.fprintf fmt "@[<hv2>Show_sessions(@,%a)@]" pp_request_show_sessions x
 
 let rec pp_request_envelope fmt (v:request_envelope) = 
   let pp_i fmt () =
@@ -1411,6 +1443,13 @@ let rec encode_pb_request_reload_reftree (v:request_reload_reftree) encoder =
   end;
   ()
 
+let rec encode_pb_request_show_sessions (v:request_show_sessions) encoder = 
+  Pbrt.Encoder.bool v.exclude_self encoder;
+  Pbrt.Encoder.key 1 Pbrt.Varint encoder; 
+  Pbrt.Encoder.bool v.exclude_other encoder;
+  Pbrt.Encoder.key 2 Pbrt.Varint encoder; 
+  ()
+
 let rec encode_pb_request (v:request) encoder = 
   begin match v with
   | Prompt ->
@@ -1506,6 +1545,9 @@ let rec encode_pb_request (v:request) encoder =
   | Aux_delete x ->
     Pbrt.Encoder.nested encode_pb_request_aux_delete x encoder;
     Pbrt.Encoder.key 31 Pbrt.Bytes encoder; 
+  | Show_sessions x ->
+    Pbrt.Encoder.nested encode_pb_request_show_sessions x encoder;
+    Pbrt.Encoder.key 32 Pbrt.Bytes encoder; 
   end
 
 let rec encode_pb_request_envelope (v:request_envelope) encoder = 
@@ -2309,6 +2351,34 @@ let rec decode_pb_request_reload_reftree d =
     on_behalf_of = v.on_behalf_of;
   } : request_reload_reftree)
 
+let rec decode_pb_request_show_sessions d =
+  let v = default_request_show_sessions_mutable () in
+  let continue__= ref true in
+  let exclude_other_is_set = ref false in
+  let exclude_self_is_set = ref false in
+  while !continue__ do
+    match Pbrt.Decoder.key d with
+    | None -> (
+    ); continue__ := false
+    | Some (1, Pbrt.Varint) -> begin
+      v.exclude_self <- Pbrt.Decoder.bool d; exclude_self_is_set := true;
+    end
+    | Some (1, pk) -> 
+      Pbrt.Decoder.unexpected_payload "Message(request_show_sessions), field(1)" pk
+    | Some (2, Pbrt.Varint) -> begin
+      v.exclude_other <- Pbrt.Decoder.bool d; exclude_other_is_set := true;
+    end
+    | Some (2, pk) -> 
+      Pbrt.Decoder.unexpected_payload "Message(request_show_sessions), field(2)" pk
+    | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+  done;
+  begin if not !exclude_other_is_set then Pbrt.Decoder.missing_field "exclude_other" end;
+  begin if not !exclude_self_is_set then Pbrt.Decoder.missing_field "exclude_self" end;
+  ({
+    exclude_self = v.exclude_self;
+    exclude_other = v.exclude_other;
+  } : request_show_sessions)
+
 let rec decode_pb_request d = 
   let rec loop () = 
     let ret:request = match Pbrt.Decoder.key d with
@@ -2353,6 +2423,7 @@ let rec decode_pb_request d =
       | Some (29, _) -> (Get_config (decode_pb_request_get_config (Pbrt.Decoder.nested d)) : request) 
       | Some (30, _) -> (Aux_set (decode_pb_request_aux_set (Pbrt.Decoder.nested d)) : request) 
       | Some (31, _) -> (Aux_delete (decode_pb_request_aux_delete (Pbrt.Decoder.nested d)) : request) 
+      | Some (32, _) -> (Show_sessions (decode_pb_request_show_sessions (Pbrt.Decoder.nested d)) : request) 
       | Some (n, payload_kind) -> (
         Pbrt.Decoder.skip d payload_kind; 
         loop () 
diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli
index d63962e..b5b056a 100644
--- a/src/vyconf_pbt.mli
+++ b/src/vyconf_pbt.mli
@@ -161,6 +161,11 @@ type request_reload_reftree = {
   on_behalf_of : int32 option;
 }
 
+type request_show_sessions = {
+  exclude_self : bool;
+  exclude_other : bool;
+}
+
 type request =
   | Prompt
   | Setup_session of request_setup_session
@@ -193,6 +198,7 @@ type request =
   | Get_config of request_get_config
   | Aux_set of request_aux_set
   | Aux_delete of request_aux_delete
+  | Show_sessions of request_show_sessions
 
 type request_envelope = {
   token : string option;
@@ -432,6 +438,13 @@ val default_request_reload_reftree :
   request_reload_reftree
 (** [default_request_reload_reftree ()] is the default value for type [request_reload_reftree] *)
 
+val default_request_show_sessions : 
+  ?exclude_self:bool ->
+  ?exclude_other:bool ->
+  unit ->
+  request_show_sessions
+(** [default_request_show_sessions ()] is the default value for type [request_show_sessions] *)
+
 val default_request : unit -> request
 (** [default_request ()] is the default value for type [request] *)
 
@@ -556,6 +569,9 @@ val pp_request_exit_configuration_mode : Format.formatter -> request_exit_config
 val pp_request_reload_reftree : Format.formatter -> request_reload_reftree -> unit 
 (** [pp_request_reload_reftree v] formats v *)
 
+val pp_request_show_sessions : Format.formatter -> request_show_sessions -> unit 
+(** [pp_request_show_sessions v] formats v *)
+
 val pp_request : Format.formatter -> request -> unit 
 (** [pp_request v] formats v *)
 
@@ -670,6 +686,9 @@ val encode_pb_request_exit_configuration_mode : request_exit_configuration_mode
 val encode_pb_request_reload_reftree : request_reload_reftree -> Pbrt.Encoder.t -> unit
 (** [encode_pb_request_reload_reftree v encoder] encodes [v] with the given [encoder] *)
 
+val encode_pb_request_show_sessions : request_show_sessions -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_show_sessions v encoder] encodes [v] with the given [encoder] *)
+
 val encode_pb_request : request -> Pbrt.Encoder.t -> unit
 (** [encode_pb_request v encoder] encodes [v] with the given [encoder] *)
 
@@ -784,6 +803,9 @@ val decode_pb_request_exit_configuration_mode : Pbrt.Decoder.t -> request_exit_c
 val decode_pb_request_reload_reftree : Pbrt.Decoder.t -> request_reload_reftree
 (** [decode_pb_request_reload_reftree decoder] decodes a [request_reload_reftree] binary value from [decoder] *)
 
+val decode_pb_request_show_sessions : Pbrt.Decoder.t -> request_show_sessions
+(** [decode_pb_request_show_sessions decoder] decodes a [request_show_sessions] binary value from [decoder] *)
+
 val decode_pb_request : Pbrt.Decoder.t -> request
 (** [decode_pb_request decoder] decodes a [request] binary value from [decoder] *)
 
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index caaee9c..182ad03 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -186,6 +186,23 @@ let show_config world token (req: request_show_config) =
         {response_tmpl with output=(Some conf_str)}
     with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
 
+let show_sessions _world token (req: request_show_sessions) =
+    let g d s =
+        (Session.session_data_to_yojson d) :: s
+    in
+    let f k d s =
+        match k with
+        | t when t = token ->
+            if req.exclude_self then s
+            else g d s
+        | _ ->
+            if req.exclude_other then s
+            else g d s
+    in
+    let tmp = Hashtbl.fold f sessions [] in
+    let res = Yojson.Safe.to_string @@ `List tmp in
+    {response_tmpl with output=(Some res)}
+
 let validate world token (req: request_validate) =
     try
         let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in
@@ -384,6 +401,7 @@ let rec handle_connection world ic oc () =
                     | Some t, Load r -> load world t r
                     | Some t, Merge r -> merge world t r
                     | Some t, Save r -> save world t r
+                    | Some t, Show_sessions r -> show_sessions world t r
                     | _ -> failwith "Unimplemented"
                     ) |> Lwt.return
                end