summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/commit.ml4
-rw-r--r--src/defaults.ml2
-rw-r--r--src/defaults.mli1
-rw-r--r--src/dune7
-rw-r--r--src/session.ml132
-rw-r--r--src/session.mli21
-rw-r--r--src/startup.ml32
-rw-r--r--src/startup.mli2
-rw-r--r--src/vycli.ml11
-rw-r--r--src/vyconf_cli.ml88
-rw-r--r--src/vyconf_client.ml31
-rw-r--r--src/vyconf_client.mli30
-rw-r--r--src/vyconf_client_session.ml3
-rw-r--r--src/vyconf_pbt.ml443
-rw-r--r--src/vyconf_pbt.mli154
-rw-r--r--src/vyconfd.ml126
16 files changed, 917 insertions, 170 deletions
diff --git a/src/commit.ml b/src/commit.ml
index 19c9844..0d675d8 100644
--- a/src/commit.ml
+++ b/src/commit.ml
@@ -85,12 +85,12 @@ end
module CS = Set.Make(CI)
let owner_args_from_data p o =
- let oa = Pcre.split o in
+ let oa = Pcre2.split o in
let owner = FilePath.basename (List.nth oa 0) in
if List.length oa < 2 then owner, None
else
let var = List.nth oa 1 in
- let res = Pcre.extract_all ~pat:"\\.\\./" var in
+ let res = Pcre2.extract_all ~pat:"\\.\\./" var in
let var_pos = Array.length res in
let arg_value = Vyos1x.Util.get_last_n p var_pos
in owner, arg_value
diff --git a/src/defaults.ml b/src/defaults.ml
index 9ce36e5..d8fc484 100644
--- a/src/defaults.ml
+++ b/src/defaults.ml
@@ -4,6 +4,7 @@ type vyconf_defaults = {
socket: string;
log_template: string;
log_level: string;
+ legacy_config_path: string;
}
let defaults = {
@@ -12,4 +13,5 @@ let defaults = {
socket = "/var/run/vyconfd.sock";
log_template = "$(date) $(name)[$(pid)]: $(message)";
log_level = "notice";
+ legacy_config_path = "/opt/vyatta/etc/config/config.boot";
}
diff --git a/src/defaults.mli b/src/defaults.mli
index 042eced..dc58606 100644
--- a/src/defaults.mli
+++ b/src/defaults.mli
@@ -4,6 +4,7 @@ type vyconf_defaults = {
socket: string;
log_template: string;
log_level: string;
+ legacy_config_path: string;
}
val defaults : vyconf_defaults
diff --git a/src/dune b/src/dune
index 63e1167..0c13950 100644
--- a/src/dune
+++ b/src/dune
@@ -49,6 +49,13 @@
(preprocess (pps lwt_ppx)))
(executable
+ (name vyconf_cli)
+ (public_name vyconf_cli)
+ (modules vyconf_cli)
+ (libraries vyconfd_client)
+ (preprocess (pps lwt_ppx)))
+
+(executable
(name validate)
(public_name validate)
(modules validate)
diff --git a/src/session.ml b/src/session.ml
index 602ab14..1ff9bae 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -1,7 +1,11 @@
module CT = Vyos1x.Config_tree
+module IC = Vyos1x.Internal.Make(CT)
+module CC = Commitd_client.Commit
+module CD = Vyos1x.Config_diff
module VT = Vyos1x.Vytree
module RT = Vyos1x.Reference_tree
module D = Directories
+module FP = FilePath
exception Session_error of string
@@ -23,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 =
@@ -69,6 +75,21 @@ let validate w _s path =
RT.validate_path D.(w.dirs.validators) w.reference_tree path
with RT.Validation_error x -> raise (Session_error x)
+let validate_tree w' t =
+ let validate_path w out path =
+ let res =
+ try
+ RT.validate_path D.(w.dirs.validators) w.reference_tree path;
+ out
+ with RT.Validation_error x -> out ^ x
+ in res
+ in
+ let paths = CT.value_paths_of_tree t in
+ let out = List.fold_left (validate_path w') "" paths in
+ match out with
+ | "" -> ()
+ | _ -> raise (Session_error out)
+
let split_path w _s path =
RT.split_path w.reference_tree path
@@ -79,19 +100,118 @@ let set w s path =
let value_behaviour = if RT.is_multi w.reference_tree refpath then CT.AddValue else CT.ReplaceValue in
let op = CfgSet (path, value, value_behaviour) in
let config =
- apply_cfg_op op s.proposed_config |>
- (fun c -> RT.set_tag_data w.reference_tree c path) |>
- (fun c -> RT.set_leaf_data w.reference_tree c path)
+ try
+ apply_cfg_op op s.proposed_config |>
+ (fun c -> RT.set_tag_data w.reference_tree c path) |>
+ (fun c -> RT.set_leaf_data w.reference_tree c path)
+ with
+ | CT.Useless_set ->
+ raise (Session_error (Printf.sprintf "Useless set, path: %s" (string_of_op op)))
+ | CT.Duplicate_value ->
+ raise (Session_error (Printf.sprintf "Duplicate value, path: %s" (string_of_op op)))
+
in
{s with proposed_config=config; changeset=(op :: s.changeset)}
let delete w s path =
- let _ = validate w s path in
let path, value = split_path w s path in
let op = CfgDelete (path, value) in
let config = apply_cfg_op op s.proposed_config in
{s with proposed_config=config; changeset=(op :: s.changeset)}
+let discard w s =
+ {s with proposed_config=w.running_config}
+
+let session_changed w s =
+ (* structural equality test requires consistent ordering, which is
+ * practised, but may be unreliable; test actual difference
+ *)
+ let diff = CD.diff_tree [] w.running_config s.proposed_config in
+ let add_tree = CT.get_subtree diff ["add"] in
+ let del_tree = CT.get_subtree diff ["del"] in
+ (del_tree <> CT.default) || (add_tree <> CT.default)
+
+let load w s file cached =
+ let ct =
+ if cached then
+ try
+ Ok (IC.read_internal file)
+ with Vyos1x.Internal.Read_error e ->
+ Error e
+ else
+ Vyos1x.Config_file.load_config file
+ in
+ match ct with
+ | Error e -> raise (Session_error (Printf.sprintf "Error loading config: %s" e))
+ | Ok config ->
+ validate_tree w config; {s with proposed_config=config;}
+
+let merge w s file destructive =
+ let ct = Vyos1x.Config_file.load_config file in
+ match ct with
+ | Error e -> raise (Session_error (Printf.sprintf "Error loading config: %s" e))
+ | Ok config ->
+ let () = validate_tree w config in
+ let merged = CD.tree_merge ~destructive:destructive s.proposed_config config
+ in
+ {s with proposed_config=merged;}
+
+let save w s file =
+ let ct = w.running_config in
+ let res = Vyos1x.Config_file.save_config ct file in
+ match res with
+ | Error e -> raise (Session_error (Printf.sprintf "Error saving config: %s" e))
+ | Ok () -> s
+
+let prepare_commit ?(dry_run=false) w s id =
+ let at = w.running_config in
+ let wt = s.proposed_config in
+ let rt = w.reference_tree in
+ let vc = w.vyconf_config in
+ let () =
+ try
+ IC.write_internal at (FP.concat vc.session_dir vc.running_cache)
+ with
+ Vyos1x.Internal.Write_error msg -> raise (Session_error msg)
+ in
+ let () =
+ try
+ IC.write_internal wt (FP.concat vc.session_dir vc.session_cache)
+ with
+ Vyos1x.Internal.Write_error msg -> raise (Session_error msg)
+ in
+ CC.make_commit_data ~dry_run:dry_run rt at wt id
+
+let get_config w s id =
+ let at = w.running_config in
+ let wt = s.proposed_config in
+ let vc = w.vyconf_config in
+ let running_cache = Printf.sprintf "%s_%s" vc.running_cache id in
+ let session_cache = Printf.sprintf "%s_%s" vc.session_cache id in
+ let () =
+ try
+ IC.write_internal at (FP.concat vc.session_dir running_cache)
+ with
+ Vyos1x.Internal.Write_error msg -> raise (Session_error msg)
+ in
+ let () =
+ try
+ IC.write_internal wt (FP.concat vc.session_dir session_cache)
+ with
+ Vyos1x.Internal.Write_error msg -> raise (Session_error msg)
+ in id
+
+let cleanup_config w id =
+ let remove_file file =
+ if Sys.file_exists file then
+ Sys.remove file
+ in
+ let vc = w.vyconf_config in
+ let running_cache = Printf.sprintf "%s_%s" vc.running_cache id in
+ let session_cache = Printf.sprintf "%s_%s" vc.session_cache id in
+ remove_file (FP.concat vc.session_dir running_cache);
+ remove_file (FP.concat vc.session_dir session_cache)
+
let get_value w s path =
if not (VT.exists s.proposed_config path) then
raise (Session_error ("Config path does not exist"))
diff --git a/src/session.mli b/src/session.mli
index 2166a80..1a9b79f 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
@@ -32,6 +33,16 @@ val set : world -> session_data -> string list -> session_data
val delete : world -> session_data -> string list -> session_data
+val discard : world -> session_data -> session_data
+
+val session_changed : world -> session_data -> bool
+
+val load : world -> session_data -> string -> bool -> session_data
+
+val merge : world -> session_data -> string -> bool -> session_data
+
+val save : world -> session_data -> string -> session_data
+
val get_value : world -> session_data -> string list -> string
val get_values : world -> session_data -> string list -> string list
@@ -42,4 +53,10 @@ val list_children : world -> session_data -> string list -> string list
val string_of_op : cfg_op -> string
+val prepare_commit : ?dry_run:bool -> world -> session_data -> string -> Commitd_client.Commit.commit_data
+
+val get_config : world -> session_data -> string -> string
+
+val cleanup_config : world -> string -> unit
+
val show_config : world -> session_data -> string list -> Vyconf_connect.Vyconf_pbt.request_config_format -> string
diff --git a/src/startup.ml b/src/startup.ml
index 76599b0..20882cb 100644
--- a/src/startup.ml
+++ b/src/startup.ml
@@ -78,44 +78,16 @@ let create_server accept_connection sock =
Lwt_unix.accept sock >>= accept_connection >>= serve
in serve
-(* strip commponent version string *)
-let strip_version s =
- let rex = Pcre.regexp ~flags:[`MULTILINE;`DOTALL] "(^//.*)" in
- let res = Pcre.split ~max:0 ~rex s in
- match res with
- | h :: _ -> h
- | [] -> panic "Failure applying regex to config string"
-
-(** Load the appliance configuration file *)
-let load_config file =
- try
- let chan = open_in file in
- let s = really_input_string chan (in_channel_length chan) in
- let config = strip_version s |> Vyos1x.Parser.from_string in
- Ok config
- with
- | Sys_error msg -> Error msg
- | Vyos1x.Util.Syntax_error (opt, msg) ->
- begin
- match opt with
- | None ->
- let out = Printf.sprintf "Parse error: %s\n" msg
- in Error out
- | Some (line, pos) ->
- let out = Printf.sprintf "Parse error: %s line %d pos %d\n" msg line pos
- in Error out
- end
-
(** Load the appliance configuration file or the fallback config *)
let load_config_failsafe main fallback =
- let res = load_config main in
+ let res = Vyos1x.Config_file.load_config main in
match res with
| Ok config -> config
| Error msg ->
Lwt_log.error
(Printf.sprintf "Failed to load config file %s: %s. Attempting to load fallback config %s" main msg fallback) |>
Lwt.ignore_result;
- let res = load_config fallback in
+ let res = Vyos1x.Config_file.load_config fallback in
begin
match res with
| Ok config -> config
diff --git a/src/startup.mli b/src/startup.mli
index dc84736..1415953 100644
--- a/src/startup.mli
+++ b/src/startup.mli
@@ -14,8 +14,6 @@ val create_server :
(Lwt_unix.file_descr * Lwt_unix.sockaddr -> unit Lwt.t) ->
Lwt_unix.file_descr -> unit -> 'a Lwt.t
-val load_config : string -> (Vyos1x.Config_tree.t, string) result
-
val load_config_failsafe : string -> string -> Vyos1x.Config_tree.t
val load_interface_definitions : string -> (Vyos1x.Reference_tree.t, string) result
diff --git a/src/vycli.ml b/src/vycli.ml
index bd14713..174d6f4 100644
--- a/src/vycli.ml
+++ b/src/vycli.ml
@@ -2,7 +2,7 @@ open Vyconfd_client.Vyconf_client
open Vyconf_connect.Vyconf_pbt
type op_t =
- | OpStatus
+ | OpPrompt
| OpSetupSession
| OpTeardownSession
| OpShowConfig
@@ -35,7 +35,7 @@ let args = [
("--exists", Arg.Unit (fun () -> op := Some OpExists), "Check if specified path exists");
("--list-children", Arg.Unit (fun () -> op := Some OpListChildren), "List children of the node at the specified path");
("--show-config", Arg.Unit (fun () -> op := Some OpShowConfig), "Show the configuration at the specified path");
- ("--status", Arg.Unit (fun () -> op := Some OpStatus), "Send a status/keepalive message");
+ ("--prompt", Arg.Unit (fun () -> op := Some OpPrompt), "Send a status/keepalive message");
("--validate", Arg.Unit (fun () -> op := Some OpValidate), "Validate path");
("--reload-reftree", Arg.Unit (fun () -> op := Some OpReloadReftree), "Reload reference tree");
]
@@ -59,15 +59,16 @@ let main socket op path out_format config_format =
| Some o ->
begin
match o with
- | OpStatus ->
- let%lwt resp = get_status client in
+ | OpPrompt ->
+ let%lwt resp = prompt client in
begin
match resp.status with
| Success -> Ok "" |> Lwt.return
| _ -> 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_cli.ml b/src/vyconf_cli.ml
new file mode 100644
index 0000000..0d1535e
--- /dev/null
+++ b/src/vyconf_cli.ml
@@ -0,0 +1,88 @@
+open Vyconfd_client.Vyconf_client
+open Vyconf_connect.Vyconf_pbt
+
+type op_t =
+ | OpSet
+ | OpDelete
+ | OpDiscard
+ | OpShowConfig
+ | OpSessionChanged
+
+let op_of_string s =
+ match s with
+ | "vy_set" -> OpSet
+ | "vy_delete" -> OpDelete
+ | "vy_discard" -> OpDiscard
+ | "vy_show" -> OpShowConfig
+ | "vy_session_changed" -> OpSessionChanged
+ | _ -> failwith (Printf.sprintf "Unknown operation %s" s)
+
+let config_format_of_string s =
+ match s with
+ | "curly" -> Curly
+ | "json" -> Json
+ | _ -> failwith (Printf.sprintf "Unknown config format %s, should be curly or json" s)
+
+let output_format_of_string s =
+ match s with
+ | "plain" -> Out_plain
+ | "json" -> Out_json
+ | _ -> failwith (Printf.sprintf "Unknown output format %s, should be plain or json" s)
+
+let in_cli_config_session () =
+ let env = Unix.environment () in
+ let res = Array.find_opt (fun c -> String.starts_with ~prefix:"_OFR_CONFIGURE" c) env
+ in
+ match res with
+ | Some _ -> true
+ | None -> false
+
+let get_session () =
+ let pid = Int32.of_int (Unix.getppid()) in
+ let socket = "/var/run/vyconfd.sock" in
+ let config_format = config_format_of_string "curly" in
+ let out_format = output_format_of_string "plain" in
+ let%lwt client =
+ create socket out_format config_format
+ in
+ let%lwt resp = session_of_pid client pid in
+ match resp with
+ | Error _ -> setup_session client "vyconf_cli" pid
+ | _ as c -> c |> Lwt.return
+
+let close_session () =
+ let%lwt client = get_session () in
+ match client with
+ | Ok c ->
+ teardown_session c
+ | Error e -> Error e |> Lwt.return
+
+let main op path =
+ let%lwt client = get_session () in
+ let%lwt result =
+ match client with
+ | Ok c ->
+ begin
+ match op with
+ | OpSet -> set c path
+ | OpDelete -> delete c path
+ | OpDiscard -> discard c
+ | OpShowConfig -> show_config c path
+ | OpSessionChanged -> session_changed c
+ end
+ | Error e -> Error e |> Lwt.return
+ in
+ let () =
+ if not (in_cli_config_session ()) then
+ close_session () |> Lwt.ignore_result
+ in
+ match result with
+ | Ok s -> let%lwt () = Lwt_io.write Lwt_io.stdout s in Lwt.return 0
+ | Error e -> let%lwt () = Lwt_io.write Lwt_io.stderr (Printf.sprintf "%s\n" e) in Lwt.return 1
+
+let () =
+ let path_list = Array.to_list (Array.sub Sys.argv 1 (Array.length Sys.argv - 1))
+ in
+ let op_str = FilePath.basename Sys.argv.(0) in
+ let op = op_of_string op_str in
+ let result = Lwt_main.run (main op path_list) in exit result
diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
index 7380760..05b5548 100644
--- a/src/vyconf_client.ml
+++ b/src/vyconf_client.ml
@@ -48,15 +48,15 @@ let do_request client req =
let%lwt resp = Vyconf_connect.Message.read client.ic in
decode_pb_response (Pbrt.Decoder.of_bytes resp) |> Lwt.return
-let get_status client =
- let req = Status in
+let prompt client =
+ let req = Prompt in
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 ->
@@ -65,6 +65,13 @@ let setup_session ?(on_behalf_of=None) client client_app =
| None -> Error "setup_session did not return a session token!") |> Lwt.return
| _ -> Error (Option.value resp.error ~default:"Unknown error") |> Lwt.return
+let session_of_pid client pid =
+ let req = Session_of_pid {client_pid=pid} in
+ let%lwt resp = do_request client req in
+ (match resp.output with
+ | Some token -> Ok {client with session=(Some token)}
+ | None -> Error "no such session") |> Lwt.return
+
let teardown_session ?(on_behalf_of=None) client =
let id = on_behalf_of |> (function None -> None | Some x -> (Some (Int32.of_int x))) in
let req = Teardown {on_behalf_of=id} in
@@ -134,6 +141,22 @@ let delete client path =
| Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
| _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+let session_changed client =
+ let req = Session_changed {dummy=None;} in
+ let%lwt resp = do_request client req in
+ match resp.status with
+ | Success -> Lwt.return (Ok "")
+ | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
+ | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+
+let discard client =
+ let req = Discard {dummy=None;} in
+ let%lwt resp = do_request client req in
+ match resp.status with
+ | Success -> Lwt.return (Ok "")
+ | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
+ | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+
let commit client =
let req =
Commit {confirm=None; confirm_timeout=None; comment=None; dry_run=None}
diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli
index 5fd4df4..762495d 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -1,33 +1,16 @@
type t
-type status =
- | Success
- | Fail
- | Invalid_path
- | Invalid_value
- | Commit_in_progress
- | Configuration_locked
- | Internal_error
- | Permission_denied
- | Path_already_exists
-
-type response = {
- status : status;
- output : string option;
- error : string option;
- warning : string option;
-}
-
-
val create : ?token:(string option) -> string -> Vyconf_connect.Vyconf_pbt.request_output_format -> Vyconf_connect.Vyconf_pbt.request_config_format -> t Lwt.t
val get_token : t -> (string, string) result Lwt.t
val shutdown : t -> t Lwt.t
-val get_status : t -> response Lwt.t
+val prompt : t -> Vyconf_connect.Vyconf_pbt.response Lwt.t
+
+val setup_session : ?on_behalf_of:(int option) -> t -> string -> int32 -> (t, string) result Lwt.t
-val setup_session : ?on_behalf_of:(int option) -> t -> string -> (t, string) result Lwt.t
+val session_of_pid : t -> int32 -> (t, string) result Lwt.t
val teardown_session : ?on_behalf_of:(int option) -> t -> (string, string) result Lwt.t
@@ -47,7 +30,10 @@ val set : t -> string list -> (string, string) result Lwt.t
val delete : t -> string list -> (string, string) result Lwt.t
-val commit : t -> (string, string) result Lwt.t
+val session_changed : t -> (string, string) result Lwt.t
+
+val discard : t -> (string, string) result Lwt.t
+val commit : t -> (string, string) result Lwt.t
val reload_reftree : ?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 48a8e87..913fcea 100644
--- a/src/vyconf_pbt.ml
+++ b/src/vyconf_pbt.ml
@@ -8,13 +8,26 @@ type request_output_format =
| Out_plain
| Out_json
-type request_status = unit
+type request_prompt = unit
type request_setup_session = {
+ client_pid : int32;
client_application : string option;
on_behalf_of : int32 option;
}
+type request_session_of_pid = {
+ client_pid : int32;
+}
+
+type request_session_update_pid = {
+ client_pid : int32;
+}
+
+type request_get_config = {
+ dummy : int32 option;
+}
+
type request_teardown = {
on_behalf_of : int32 option;
}
@@ -32,6 +45,14 @@ type request_delete = {
path : string list;
}
+type request_discard = {
+ dummy : int32 option;
+}
+
+type request_session_changed = {
+ dummy : int32 option;
+}
+
type request_rename = {
edit_level : string list;
from : string;
@@ -62,11 +83,13 @@ type request_rollback = {
type request_load = {
location : string;
+ cached : bool;
format : request_config_format option;
}
type request_merge = {
location : string;
+ destructive : bool;
format : request_config_format option;
}
@@ -118,7 +141,7 @@ type request_reload_reftree = {
}
type request =
- | Status
+ | Prompt
| Setup_session of request_setup_session
| Set of request_set
| Delete of request_delete
@@ -136,18 +159,24 @@ type request =
| List_children of request_list_children
| Run_op_mode of request_run_op_mode
| Confirm
- | Configure of request_enter_configuration_mode
- | Exit_configure
+ | Enter_configuration_mode of request_enter_configuration_mode
+ | Exit_configuration_mode
| Validate of request_validate
| Teardown of request_teardown
| Reload_reftree of request_reload_reftree
+ | Load of request_load
+ | Discard of request_discard
+ | Session_changed of request_session_changed
+ | Session_of_pid of request_session_of_pid
+ | Session_update_pid of request_session_update_pid
+ | Get_config of request_get_config
type request_envelope = {
token : string option;
request : request;
}
-type status =
+type errnum =
| Success
| Fail
| Invalid_path
@@ -157,9 +186,10 @@ type status =
| Internal_error
| Permission_denied
| Path_already_exists
+ | Uncommited_changes
type response = {
- status : status;
+ status : errnum;
output : string option;
error : string option;
warning : string option;
@@ -169,16 +199,36 @@ let rec default_request_config_format () = (Curly:request_config_format)
let rec default_request_output_format () = (Out_plain:request_output_format)
-let rec default_request_status = ()
+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;
}
+let rec default_request_session_of_pid
+ ?client_pid:((client_pid:int32) = 0l)
+ () : request_session_of_pid = {
+ client_pid;
+}
+
+let rec default_request_session_update_pid
+ ?client_pid:((client_pid:int32) = 0l)
+ () : request_session_update_pid = {
+ client_pid;
+}
+
+let rec default_request_get_config
+ ?dummy:((dummy:int32 option) = None)
+ () : request_get_config = {
+ dummy;
+}
+
let rec default_request_teardown
?on_behalf_of:((on_behalf_of:int32 option) = None)
() : request_teardown = {
@@ -205,6 +255,18 @@ let rec default_request_delete
path;
}
+let rec default_request_discard
+ ?dummy:((dummy:int32 option) = None)
+ () : request_discard = {
+ dummy;
+}
+
+let rec default_request_session_changed
+ ?dummy:((dummy:int32 option) = None)
+ () : request_session_changed = {
+ dummy;
+}
+
let rec default_request_rename
?edit_level:((edit_level:string list) = [])
?from:((from:string) = "")
@@ -253,17 +315,21 @@ let rec default_request_rollback
let rec default_request_load
?location:((location:string) = "")
+ ?cached:((cached:bool) = false)
?format:((format:request_config_format option) = None)
() : request_load = {
location;
+ cached;
format;
}
let rec default_request_merge
?location:((location:string) = "")
+ ?destructive:((destructive:bool) = false)
?format:((format:request_config_format option) = None)
() : request_merge = {
location;
+ destructive;
format;
}
@@ -339,7 +405,7 @@ let rec default_request_reload_reftree
on_behalf_of;
}
-let rec default_request (): request = Status
+let rec default_request (): request = Prompt
let rec default_request_envelope
?token:((token:string option) = None)
@@ -349,10 +415,10 @@ let rec default_request_envelope
request;
}
-let rec default_status () = (Success:status)
+let rec default_errnum () = (Success:errnum)
let rec default_response
- ?status:((status:status) = default_status ())
+ ?status:((status:errnum) = default_errnum ())
?output:((output:string option) = None)
?error:((error:string option) = None)
?warning:((warning:string option) = None)
@@ -364,15 +430,41 @@ 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;
}
+type request_session_of_pid_mutable = {
+ mutable client_pid : int32;
+}
+
+let default_request_session_of_pid_mutable () : request_session_of_pid_mutable = {
+ client_pid = 0l;
+}
+
+type request_session_update_pid_mutable = {
+ mutable client_pid : int32;
+}
+
+let default_request_session_update_pid_mutable () : request_session_update_pid_mutable = {
+ client_pid = 0l;
+}
+
+type request_get_config_mutable = {
+ mutable dummy : int32 option;
+}
+
+let default_request_get_config_mutable () : request_get_config_mutable = {
+ dummy = None;
+}
+
type request_teardown_mutable = {
mutable on_behalf_of : int32 option;
}
@@ -407,6 +499,22 @@ let default_request_delete_mutable () : request_delete_mutable = {
path = [];
}
+type request_discard_mutable = {
+ mutable dummy : int32 option;
+}
+
+let default_request_discard_mutable () : request_discard_mutable = {
+ dummy = None;
+}
+
+type request_session_changed_mutable = {
+ mutable dummy : int32 option;
+}
+
+let default_request_session_changed_mutable () : request_session_changed_mutable = {
+ dummy = None;
+}
+
type request_rename_mutable = {
mutable edit_level : string list;
mutable from : string;
@@ -465,21 +573,25 @@ let default_request_rollback_mutable () : request_rollback_mutable = {
type request_load_mutable = {
mutable location : string;
+ mutable cached : bool;
mutable format : request_config_format option;
}
let default_request_load_mutable () : request_load_mutable = {
location = "";
+ cached = false;
format = None;
}
type request_merge_mutable = {
mutable location : string;
+ mutable destructive : bool;
mutable format : request_config_format option;
}
let default_request_merge_mutable () : request_merge_mutable = {
location = "";
+ destructive = false;
format = None;
}
@@ -580,14 +692,14 @@ let default_request_envelope_mutable () : request_envelope_mutable = {
}
type response_mutable = {
- mutable status : status;
+ mutable status : errnum;
mutable output : string option;
mutable error : string option;
mutable warning : string option;
}
let default_response_mutable () : response_mutable = {
- status = default_status ();
+ status = default_errnum ();
output = None;
error = None;
warning = None;
@@ -607,7 +719,7 @@ let rec pp_request_output_format fmt (v:request_output_format) =
| Out_plain -> Format.fprintf fmt "Out_plain"
| Out_json -> Format.fprintf fmt "Out_json"
-let rec pp_request_status fmt (v:request_status) =
+let rec pp_request_prompt fmt (v:request_prompt) =
let pp_i fmt () =
Pbrt.Pp.pp_unit fmt ()
in
@@ -615,11 +727,30 @@ let rec pp_request_status fmt (v:request_status) =
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 ()
+let rec pp_request_session_of_pid fmt (v:request_session_of_pid) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "client_pid" Pbrt.Pp.pp_int32 fmt v.client_pid;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
+let rec pp_request_session_update_pid fmt (v:request_session_update_pid) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "client_pid" Pbrt.Pp.pp_int32 fmt v.client_pid;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
+let rec pp_request_get_config fmt (v:request_get_config) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "dummy" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.dummy;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
let rec pp_request_teardown fmt (v:request_teardown) =
let pp_i fmt () =
Pbrt.Pp.pp_record_field ~first:true "on_behalf_of" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.on_behalf_of;
@@ -645,6 +776,18 @@ let rec pp_request_delete fmt (v:request_delete) =
in
Pbrt.Pp.pp_brk pp_i fmt ()
+let rec pp_request_discard fmt (v:request_discard) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "dummy" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.dummy;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
+let rec pp_request_session_changed fmt (v:request_session_changed) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "dummy" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.dummy;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
let rec pp_request_rename fmt (v:request_rename) =
let pp_i fmt () =
Pbrt.Pp.pp_record_field ~first:true "edit_level" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.edit_level;
@@ -686,6 +829,7 @@ let rec pp_request_rollback fmt (v:request_rollback) =
let rec pp_request_load fmt (v:request_load) =
let pp_i fmt () =
Pbrt.Pp.pp_record_field ~first:true "location" Pbrt.Pp.pp_string fmt v.location;
+ Pbrt.Pp.pp_record_field ~first:false "cached" Pbrt.Pp.pp_bool fmt v.cached;
Pbrt.Pp.pp_record_field ~first:false "format" (Pbrt.Pp.pp_option pp_request_config_format) fmt v.format;
in
Pbrt.Pp.pp_brk pp_i fmt ()
@@ -693,6 +837,7 @@ let rec pp_request_load fmt (v:request_load) =
let rec pp_request_merge fmt (v:request_merge) =
let pp_i fmt () =
Pbrt.Pp.pp_record_field ~first:true "location" Pbrt.Pp.pp_string fmt v.location;
+ Pbrt.Pp.pp_record_field ~first:false "destructive" Pbrt.Pp.pp_bool fmt v.destructive;
Pbrt.Pp.pp_record_field ~first:false "format" (Pbrt.Pp.pp_option pp_request_config_format) fmt v.format;
in
Pbrt.Pp.pp_brk pp_i fmt ()
@@ -772,7 +917,7 @@ let rec pp_request_reload_reftree fmt (v:request_reload_reftree) =
let rec pp_request fmt (v:request) =
match v with
- | Status -> Format.fprintf fmt "Status"
+ | Prompt -> Format.fprintf fmt "Prompt"
| Setup_session x -> Format.fprintf fmt "@[<hv2>Setup_session(@,%a)@]" pp_request_setup_session x
| Set x -> Format.fprintf fmt "@[<hv2>Set(@,%a)@]" pp_request_set x
| Delete x -> Format.fprintf fmt "@[<hv2>Delete(@,%a)@]" pp_request_delete x
@@ -790,11 +935,17 @@ let rec pp_request fmt (v:request) =
| List_children x -> Format.fprintf fmt "@[<hv2>List_children(@,%a)@]" pp_request_list_children x
| Run_op_mode x -> Format.fprintf fmt "@[<hv2>Run_op_mode(@,%a)@]" pp_request_run_op_mode x
| Confirm -> Format.fprintf fmt "Confirm"
- | Configure x -> Format.fprintf fmt "@[<hv2>Configure(@,%a)@]" pp_request_enter_configuration_mode x
- | Exit_configure -> Format.fprintf fmt "Exit_configure"
+ | Enter_configuration_mode x -> Format.fprintf fmt "@[<hv2>Enter_configuration_mode(@,%a)@]" pp_request_enter_configuration_mode x
+ | Exit_configuration_mode -> Format.fprintf fmt "Exit_configuration_mode"
| Validate x -> Format.fprintf fmt "@[<hv2>Validate(@,%a)@]" pp_request_validate x
| Teardown x -> Format.fprintf fmt "@[<hv2>Teardown(@,%a)@]" pp_request_teardown x
| Reload_reftree x -> Format.fprintf fmt "@[<hv2>Reload_reftree(@,%a)@]" pp_request_reload_reftree x
+ | Load x -> Format.fprintf fmt "@[<hv2>Load(@,%a)@]" pp_request_load x
+ | Discard x -> Format.fprintf fmt "@[<hv2>Discard(@,%a)@]" pp_request_discard x
+ | Session_changed x -> Format.fprintf fmt "@[<hv2>Session_changed(@,%a)@]" pp_request_session_changed x
+ | Session_of_pid x -> Format.fprintf fmt "@[<hv2>Session_of_pid(@,%a)@]" pp_request_session_of_pid x
+ | Session_update_pid x -> Format.fprintf fmt "@[<hv2>Session_update_pid(@,%a)@]" pp_request_session_update_pid x
+ | Get_config x -> Format.fprintf fmt "@[<hv2>Get_config(@,%a)@]" pp_request_get_config x
let rec pp_request_envelope fmt (v:request_envelope) =
let pp_i fmt () =
@@ -803,7 +954,7 @@ let rec pp_request_envelope fmt (v:request_envelope) =
in
Pbrt.Pp.pp_brk pp_i fmt ()
-let rec pp_status fmt (v:status) =
+let rec pp_errnum fmt (v:errnum) =
match v with
| Success -> Format.fprintf fmt "Success"
| Fail -> Format.fprintf fmt "Fail"
@@ -814,10 +965,11 @@ let rec pp_status fmt (v:status) =
| Internal_error -> Format.fprintf fmt "Internal_error"
| Permission_denied -> Format.fprintf fmt "Permission_denied"
| Path_already_exists -> Format.fprintf fmt "Path_already_exists"
+ | Uncommited_changes -> Format.fprintf fmt "Uncommited_changes"
let rec pp_response fmt (v:response) =
let pp_i fmt () =
- Pbrt.Pp.pp_record_field ~first:true "status" pp_status fmt v.status;
+ Pbrt.Pp.pp_record_field ~first:true "status" pp_errnum fmt v.status;
Pbrt.Pp.pp_record_field ~first:false "output" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.output;
Pbrt.Pp.pp_record_field ~first:false "error" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.error;
Pbrt.Pp.pp_record_field ~first:false "warning" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.warning;
@@ -838,20 +990,41 @@ let rec encode_pb_request_output_format (v:request_output_format) encoder =
| Out_plain -> Pbrt.Encoder.int_as_varint (0) encoder
| Out_json -> Pbrt.Encoder.int_as_varint 1 encoder
-let rec encode_pb_request_status (v:request_status) encoder =
+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;
+ ()
+
+let rec encode_pb_request_session_of_pid (v:request_session_of_pid) encoder =
+ Pbrt.Encoder.int32_as_varint v.client_pid encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
+ ()
+
+let rec encode_pb_request_session_update_pid (v:request_session_update_pid) encoder =
+ Pbrt.Encoder.int32_as_varint v.client_pid encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
+ ()
+
+let rec encode_pb_request_get_config (v:request_get_config) encoder =
+ begin match v.dummy with
+ | Some x ->
+ Pbrt.Encoder.int32_as_varint x encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
| None -> ();
end;
()
@@ -892,6 +1065,24 @@ let rec encode_pb_request_delete (v:request_delete) encoder =
) v.path encoder;
()
+let rec encode_pb_request_discard (v:request_discard) encoder =
+ begin match v.dummy with
+ | Some x ->
+ Pbrt.Encoder.int32_as_varint x encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
+ | None -> ();
+ end;
+ ()
+
+let rec encode_pb_request_session_changed (v:request_session_changed) encoder =
+ begin match v.dummy with
+ | Some x ->
+ Pbrt.Encoder.int32_as_varint x encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
+ | None -> ();
+ end;
+ ()
+
let rec encode_pb_request_rename (v:request_rename) encoder =
Pbrt.List_util.rev_iter_with (fun x encoder ->
Pbrt.Encoder.string x encoder;
@@ -958,10 +1149,12 @@ let rec encode_pb_request_rollback (v:request_rollback) encoder =
let rec encode_pb_request_load (v:request_load) encoder =
Pbrt.Encoder.string v.location encoder;
Pbrt.Encoder.key 1 Pbrt.Bytes encoder;
+ Pbrt.Encoder.bool v.cached encoder;
+ Pbrt.Encoder.key 2 Pbrt.Varint encoder;
begin match v.format with
| Some x ->
encode_pb_request_config_format x encoder;
- Pbrt.Encoder.key 2 Pbrt.Varint encoder;
+ Pbrt.Encoder.key 3 Pbrt.Varint encoder;
| None -> ();
end;
()
@@ -969,10 +1162,12 @@ let rec encode_pb_request_load (v:request_load) encoder =
let rec encode_pb_request_merge (v:request_merge) encoder =
Pbrt.Encoder.string v.location encoder;
Pbrt.Encoder.key 1 Pbrt.Bytes encoder;
+ Pbrt.Encoder.bool v.destructive encoder;
+ Pbrt.Encoder.key 2 Pbrt.Varint encoder;
begin match v.format with
| Some x ->
encode_pb_request_config_format x encoder;
- Pbrt.Encoder.key 2 Pbrt.Varint encoder;
+ Pbrt.Encoder.key 3 Pbrt.Varint encoder;
| None -> ();
end;
()
@@ -1084,7 +1279,7 @@ let rec encode_pb_request_reload_reftree (v:request_reload_reftree) encoder =
let rec encode_pb_request (v:request) encoder =
begin match v with
- | Status ->
+ | Prompt ->
Pbrt.Encoder.key 1 Pbrt.Bytes encoder;
Pbrt.Encoder.empty_nested encoder
| Setup_session x ->
@@ -1138,10 +1333,10 @@ let rec encode_pb_request (v:request) encoder =
| Confirm ->
Pbrt.Encoder.key 18 Pbrt.Bytes encoder;
Pbrt.Encoder.empty_nested encoder
- | Configure x ->
+ | Enter_configuration_mode x ->
Pbrt.Encoder.nested encode_pb_request_enter_configuration_mode x encoder;
Pbrt.Encoder.key 19 Pbrt.Bytes encoder;
- | Exit_configure ->
+ | Exit_configuration_mode ->
Pbrt.Encoder.key 20 Pbrt.Bytes encoder;
Pbrt.Encoder.empty_nested encoder
| Validate x ->
@@ -1153,6 +1348,24 @@ let rec encode_pb_request (v:request) encoder =
| Reload_reftree x ->
Pbrt.Encoder.nested encode_pb_request_reload_reftree x encoder;
Pbrt.Encoder.key 23 Pbrt.Bytes encoder;
+ | Load x ->
+ Pbrt.Encoder.nested encode_pb_request_load x encoder;
+ Pbrt.Encoder.key 24 Pbrt.Bytes encoder;
+ | Discard x ->
+ Pbrt.Encoder.nested encode_pb_request_discard x encoder;
+ Pbrt.Encoder.key 25 Pbrt.Bytes encoder;
+ | Session_changed x ->
+ Pbrt.Encoder.nested encode_pb_request_session_changed x encoder;
+ Pbrt.Encoder.key 26 Pbrt.Bytes encoder;
+ | Session_of_pid x ->
+ Pbrt.Encoder.nested encode_pb_request_session_of_pid x encoder;
+ Pbrt.Encoder.key 27 Pbrt.Bytes encoder;
+ | Session_update_pid x ->
+ Pbrt.Encoder.nested encode_pb_request_session_update_pid x encoder;
+ Pbrt.Encoder.key 28 Pbrt.Bytes encoder;
+ | Get_config x ->
+ Pbrt.Encoder.nested encode_pb_request_get_config x encoder;
+ Pbrt.Encoder.key 29 Pbrt.Bytes encoder;
end
let rec encode_pb_request_envelope (v:request_envelope) encoder =
@@ -1166,7 +1379,7 @@ let rec encode_pb_request_envelope (v:request_envelope) encoder =
Pbrt.Encoder.key 2 Pbrt.Bytes encoder;
()
-let rec encode_pb_status (v:status) encoder =
+let rec encode_pb_errnum (v:errnum) encoder =
match v with
| Success -> Pbrt.Encoder.int_as_varint (0) encoder
| Fail -> Pbrt.Encoder.int_as_varint 1 encoder
@@ -1177,9 +1390,10 @@ let rec encode_pb_status (v:status) encoder =
| Internal_error -> Pbrt.Encoder.int_as_varint 6 encoder
| Permission_denied -> Pbrt.Encoder.int_as_varint 7 encoder
| Path_already_exists -> Pbrt.Encoder.int_as_varint 8 encoder
+ | Uncommited_changes -> Pbrt.Encoder.int_as_varint 9 encoder
let rec encode_pb_response (v:response) encoder =
- encode_pb_status v.status encoder;
+ encode_pb_errnum v.status encoder;
Pbrt.Encoder.key 1 Pbrt.Varint encoder;
begin match v.output with
| Some x ->
@@ -1217,36 +1431,102 @@ let rec decode_pb_request_output_format d =
| 1 -> (Out_json:request_output_format)
| _ -> Pbrt.Decoder.malformed_variant "request_output_format"
-let rec decode_pb_request_status d =
+let rec decode_pb_request_prompt d =
match Pbrt.Decoder.key d with
| None -> ();
| Some (_, pk) ->
- Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(request_status)" pk
+ Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(request_prompt)" pk
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)
+let rec decode_pb_request_session_of_pid d =
+ let v = default_request_session_of_pid_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.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_session_of_pid), field(1)" 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;
+ } : request_session_of_pid)
+
+let rec decode_pb_request_session_update_pid d =
+ let v = default_request_session_update_pid_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.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_session_update_pid), field(1)" 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;
+ } : request_session_update_pid)
+
+let rec decode_pb_request_get_config d =
+ let v = default_request_get_config_mutable () in
+ let continue__= ref true in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ ); continue__ := false
+ | Some (1, Pbrt.Varint) -> begin
+ v.dummy <- Some (Pbrt.Decoder.int32_as_varint d);
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_get_config), field(1)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ ({
+ dummy = v.dummy;
+ } : request_get_config)
+
let rec decode_pb_request_teardown d =
let v = default_request_teardown_mutable () in
let continue__= ref true in
@@ -1328,6 +1608,42 @@ let rec decode_pb_request_delete d =
path = v.path;
} : request_delete)
+let rec decode_pb_request_discard d =
+ let v = default_request_discard_mutable () in
+ let continue__= ref true in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ ); continue__ := false
+ | Some (1, Pbrt.Varint) -> begin
+ v.dummy <- Some (Pbrt.Decoder.int32_as_varint d);
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_discard), field(1)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ ({
+ dummy = v.dummy;
+ } : request_discard)
+
+let rec decode_pb_request_session_changed d =
+ let v = default_request_session_changed_mutable () in
+ let continue__= ref true in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ ); continue__ := false
+ | Some (1, Pbrt.Varint) -> begin
+ v.dummy <- Some (Pbrt.Decoder.int32_as_varint d);
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_session_changed), field(1)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ ({
+ dummy = v.dummy;
+ } : request_session_changed)
+
let rec decode_pb_request_rename d =
let v = default_request_rename_mutable () in
let continue__= ref true in
@@ -1484,6 +1800,7 @@ let rec decode_pb_request_rollback d =
let rec decode_pb_request_load d =
let v = default_request_load_mutable () in
let continue__= ref true in
+ let cached_is_set = ref false in
let location_is_set = ref false in
while !continue__ do
match Pbrt.Decoder.key d with
@@ -1495,21 +1812,29 @@ let rec decode_pb_request_load d =
| Some (1, pk) ->
Pbrt.Decoder.unexpected_payload "Message(request_load), field(1)" pk
| Some (2, Pbrt.Varint) -> begin
- v.format <- Some (decode_pb_request_config_format d);
+ v.cached <- Pbrt.Decoder.bool d; cached_is_set := true;
end
| Some (2, pk) ->
Pbrt.Decoder.unexpected_payload "Message(request_load), field(2)" pk
+ | Some (3, Pbrt.Varint) -> begin
+ v.format <- Some (decode_pb_request_config_format d);
+ end
+ | Some (3, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_load), field(3)" pk
| Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
done;
+ begin if not !cached_is_set then Pbrt.Decoder.missing_field "cached" end;
begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end;
({
location = v.location;
+ cached = v.cached;
format = v.format;
} : request_load)
let rec decode_pb_request_merge d =
let v = default_request_merge_mutable () in
let continue__= ref true in
+ let destructive_is_set = ref false in
let location_is_set = ref false in
while !continue__ do
match Pbrt.Decoder.key d with
@@ -1521,15 +1846,22 @@ let rec decode_pb_request_merge d =
| Some (1, pk) ->
Pbrt.Decoder.unexpected_payload "Message(request_merge), field(1)" pk
| Some (2, Pbrt.Varint) -> begin
- v.format <- Some (decode_pb_request_config_format d);
+ v.destructive <- Pbrt.Decoder.bool d; destructive_is_set := true;
end
| Some (2, pk) ->
Pbrt.Decoder.unexpected_payload "Message(request_merge), field(2)" pk
+ | Some (3, Pbrt.Varint) -> begin
+ v.format <- Some (decode_pb_request_config_format d);
+ end
+ | Some (3, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_merge), field(3)" pk
| Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
done;
+ begin if not !destructive_is_set then Pbrt.Decoder.missing_field "destructive" end;
begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end;
({
location = v.location;
+ destructive = v.destructive;
format = v.format;
} : request_merge)
@@ -1767,7 +2099,7 @@ let rec decode_pb_request d =
| None -> Pbrt.Decoder.malformed_variant "request"
| Some (1, _) -> begin
Pbrt.Decoder.empty_nested d ;
- (Status : request)
+ (Prompt : request)
end
| Some (2, _) -> (Setup_session (decode_pb_request_setup_session (Pbrt.Decoder.nested d)) : request)
| Some (3, _) -> (Set (decode_pb_request_set (Pbrt.Decoder.nested d)) : request)
@@ -1789,14 +2121,20 @@ let rec decode_pb_request d =
Pbrt.Decoder.empty_nested d ;
(Confirm : request)
end
- | Some (19, _) -> (Configure (decode_pb_request_enter_configuration_mode (Pbrt.Decoder.nested d)) : request)
+ | Some (19, _) -> (Enter_configuration_mode (decode_pb_request_enter_configuration_mode (Pbrt.Decoder.nested d)) : request)
| Some (20, _) -> begin
Pbrt.Decoder.empty_nested d ;
- (Exit_configure : request)
+ (Exit_configuration_mode : request)
end
| Some (21, _) -> (Validate (decode_pb_request_validate (Pbrt.Decoder.nested d)) : request)
| Some (22, _) -> (Teardown (decode_pb_request_teardown (Pbrt.Decoder.nested d)) : request)
| Some (23, _) -> (Reload_reftree (decode_pb_request_reload_reftree (Pbrt.Decoder.nested d)) : request)
+ | Some (24, _) -> (Load (decode_pb_request_load (Pbrt.Decoder.nested d)) : request)
+ | Some (25, _) -> (Discard (decode_pb_request_discard (Pbrt.Decoder.nested d)) : request)
+ | Some (26, _) -> (Session_changed (decode_pb_request_session_changed (Pbrt.Decoder.nested d)) : request)
+ | Some (27, _) -> (Session_of_pid (decode_pb_request_session_of_pid (Pbrt.Decoder.nested d)) : request)
+ | Some (28, _) -> (Session_update_pid (decode_pb_request_session_update_pid (Pbrt.Decoder.nested d)) : request)
+ | Some (29, _) -> (Get_config (decode_pb_request_get_config (Pbrt.Decoder.nested d)) : request)
| Some (n, payload_kind) -> (
Pbrt.Decoder.skip d payload_kind;
loop ()
@@ -1832,18 +2170,19 @@ let rec decode_pb_request_envelope d =
request = v.request;
} : request_envelope)
-let rec decode_pb_status d =
+let rec decode_pb_errnum d =
match Pbrt.Decoder.int_as_varint d with
- | 0 -> (Success:status)
- | 1 -> (Fail:status)
- | 2 -> (Invalid_path:status)
- | 3 -> (Invalid_value:status)
- | 4 -> (Commit_in_progress:status)
- | 5 -> (Configuration_locked:status)
- | 6 -> (Internal_error:status)
- | 7 -> (Permission_denied:status)
- | 8 -> (Path_already_exists:status)
- | _ -> Pbrt.Decoder.malformed_variant "status"
+ | 0 -> (Success:errnum)
+ | 1 -> (Fail:errnum)
+ | 2 -> (Invalid_path:errnum)
+ | 3 -> (Invalid_value:errnum)
+ | 4 -> (Commit_in_progress:errnum)
+ | 5 -> (Configuration_locked:errnum)
+ | 6 -> (Internal_error:errnum)
+ | 7 -> (Permission_denied:errnum)
+ | 8 -> (Path_already_exists:errnum)
+ | 9 -> (Uncommited_changes:errnum)
+ | _ -> Pbrt.Decoder.malformed_variant "errnum"
let rec decode_pb_response d =
let v = default_response_mutable () in
@@ -1854,7 +2193,7 @@ let rec decode_pb_response d =
| None -> (
); continue__ := false
| Some (1, Pbrt.Varint) -> begin
- v.status <- decode_pb_status d; status_is_set := true;
+ v.status <- decode_pb_errnum d; status_is_set := true;
end
| Some (1, pk) ->
Pbrt.Decoder.unexpected_payload "Message(response), field(1)" pk
diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli
index 7189a7a..c9a7530 100644
--- a/src/vyconf_pbt.mli
+++ b/src/vyconf_pbt.mli
@@ -15,13 +15,26 @@ type request_output_format =
| Out_plain
| Out_json
-type request_status = unit
+type request_prompt = unit
type request_setup_session = {
+ client_pid : int32;
client_application : string option;
on_behalf_of : int32 option;
}
+type request_session_of_pid = {
+ client_pid : int32;
+}
+
+type request_session_update_pid = {
+ client_pid : int32;
+}
+
+type request_get_config = {
+ dummy : int32 option;
+}
+
type request_teardown = {
on_behalf_of : int32 option;
}
@@ -39,6 +52,14 @@ type request_delete = {
path : string list;
}
+type request_discard = {
+ dummy : int32 option;
+}
+
+type request_session_changed = {
+ dummy : int32 option;
+}
+
type request_rename = {
edit_level : string list;
from : string;
@@ -69,11 +90,13 @@ type request_rollback = {
type request_load = {
location : string;
+ cached : bool;
format : request_config_format option;
}
type request_merge = {
location : string;
+ destructive : bool;
format : request_config_format option;
}
@@ -125,7 +148,7 @@ type request_reload_reftree = {
}
type request =
- | Status
+ | Prompt
| Setup_session of request_setup_session
| Set of request_set
| Delete of request_delete
@@ -143,18 +166,24 @@ type request =
| List_children of request_list_children
| Run_op_mode of request_run_op_mode
| Confirm
- | Configure of request_enter_configuration_mode
- | Exit_configure
+ | Enter_configuration_mode of request_enter_configuration_mode
+ | Exit_configuration_mode
| Validate of request_validate
| Teardown of request_teardown
| Reload_reftree of request_reload_reftree
+ | Load of request_load
+ | Discard of request_discard
+ | Session_changed of request_session_changed
+ | Session_of_pid of request_session_of_pid
+ | Session_update_pid of request_session_update_pid
+ | Get_config of request_get_config
type request_envelope = {
token : string option;
request : request;
}
-type status =
+type errnum =
| Success
| Fail
| Invalid_path
@@ -164,9 +193,10 @@ type status =
| Internal_error
| Permission_denied
| Path_already_exists
+ | Uncommited_changes
type response = {
- status : status;
+ status : errnum;
output : string option;
error : string option;
warning : string option;
@@ -181,16 +211,35 @@ val default_request_config_format : unit -> request_config_format
val default_request_output_format : unit -> request_output_format
(** [default_request_output_format ()] is the default value for type [request_output_format] *)
-val default_request_status : unit
-(** [default_request_status ()] is the default value for type [request_status] *)
+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 ->
request_setup_session
(** [default_request_setup_session ()] is the default value for type [request_setup_session] *)
+val default_request_session_of_pid :
+ ?client_pid:int32 ->
+ unit ->
+ request_session_of_pid
+(** [default_request_session_of_pid ()] is the default value for type [request_session_of_pid] *)
+
+val default_request_session_update_pid :
+ ?client_pid:int32 ->
+ unit ->
+ request_session_update_pid
+(** [default_request_session_update_pid ()] is the default value for type [request_session_update_pid] *)
+
+val default_request_get_config :
+ ?dummy:int32 option ->
+ unit ->
+ request_get_config
+(** [default_request_get_config ()] is the default value for type [request_get_config] *)
+
val default_request_teardown :
?on_behalf_of:int32 option ->
unit ->
@@ -216,6 +265,18 @@ val default_request_delete :
request_delete
(** [default_request_delete ()] is the default value for type [request_delete] *)
+val default_request_discard :
+ ?dummy:int32 option ->
+ unit ->
+ request_discard
+(** [default_request_discard ()] is the default value for type [request_discard] *)
+
+val default_request_session_changed :
+ ?dummy:int32 option ->
+ unit ->
+ request_session_changed
+(** [default_request_session_changed ()] is the default value for type [request_session_changed] *)
+
val default_request_rename :
?edit_level:string list ->
?from:string ->
@@ -256,6 +317,7 @@ val default_request_rollback :
val default_request_load :
?location:string ->
+ ?cached:bool ->
?format:request_config_format option ->
unit ->
request_load
@@ -263,6 +325,7 @@ val default_request_load :
val default_request_merge :
?location:string ->
+ ?destructive:bool ->
?format:request_config_format option ->
unit ->
request_merge
@@ -345,11 +408,11 @@ val default_request_envelope :
request_envelope
(** [default_request_envelope ()] is the default value for type [request_envelope] *)
-val default_status : unit -> status
-(** [default_status ()] is the default value for type [status] *)
+val default_errnum : unit -> errnum
+(** [default_errnum ()] is the default value for type [errnum] *)
val default_response :
- ?status:status ->
+ ?status:errnum ->
?output:string option ->
?error:string option ->
?warning:string option ->
@@ -366,12 +429,21 @@ val pp_request_config_format : Format.formatter -> request_config_format -> unit
val pp_request_output_format : Format.formatter -> request_output_format -> unit
(** [pp_request_output_format v] formats v *)
-val pp_request_status : Format.formatter -> request_status -> unit
-(** [pp_request_status v] formats v *)
+val pp_request_prompt : Format.formatter -> request_prompt -> unit
+(** [pp_request_prompt v] formats v *)
val pp_request_setup_session : Format.formatter -> request_setup_session -> unit
(** [pp_request_setup_session v] formats v *)
+val pp_request_session_of_pid : Format.formatter -> request_session_of_pid -> unit
+(** [pp_request_session_of_pid v] formats v *)
+
+val pp_request_session_update_pid : Format.formatter -> request_session_update_pid -> unit
+(** [pp_request_session_update_pid v] formats v *)
+
+val pp_request_get_config : Format.formatter -> request_get_config -> unit
+(** [pp_request_get_config v] formats v *)
+
val pp_request_teardown : Format.formatter -> request_teardown -> unit
(** [pp_request_teardown v] formats v *)
@@ -384,6 +456,12 @@ val pp_request_set : Format.formatter -> request_set -> unit
val pp_request_delete : Format.formatter -> request_delete -> unit
(** [pp_request_delete v] formats v *)
+val pp_request_discard : Format.formatter -> request_discard -> unit
+(** [pp_request_discard v] formats v *)
+
+val pp_request_session_changed : Format.formatter -> request_session_changed -> unit
+(** [pp_request_session_changed v] formats v *)
+
val pp_request_rename : Format.formatter -> request_rename -> unit
(** [pp_request_rename v] formats v *)
@@ -444,8 +522,8 @@ val pp_request : Format.formatter -> request -> unit
val pp_request_envelope : Format.formatter -> request_envelope -> unit
(** [pp_request_envelope v] formats v *)
-val pp_status : Format.formatter -> status -> unit
-(** [pp_status v] formats v *)
+val pp_errnum : Format.formatter -> errnum -> unit
+(** [pp_errnum v] formats v *)
val pp_response : Format.formatter -> response -> unit
(** [pp_response v] formats v *)
@@ -459,12 +537,21 @@ val encode_pb_request_config_format : request_config_format -> Pbrt.Encoder.t ->
val encode_pb_request_output_format : request_output_format -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_output_format v encoder] encodes [v] with the given [encoder] *)
-val encode_pb_request_status : request_status -> Pbrt.Encoder.t -> unit
-(** [encode_pb_request_status v encoder] encodes [v] with the given [encoder] *)
+val encode_pb_request_prompt : request_prompt -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_prompt v encoder] encodes [v] with the given [encoder] *)
val encode_pb_request_setup_session : request_setup_session -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_setup_session v encoder] encodes [v] with the given [encoder] *)
+val encode_pb_request_session_of_pid : request_session_of_pid -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_session_of_pid v encoder] encodes [v] with the given [encoder] *)
+
+val encode_pb_request_session_update_pid : request_session_update_pid -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_session_update_pid v encoder] encodes [v] with the given [encoder] *)
+
+val encode_pb_request_get_config : request_get_config -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_get_config v encoder] encodes [v] with the given [encoder] *)
+
val encode_pb_request_teardown : request_teardown -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_teardown v encoder] encodes [v] with the given [encoder] *)
@@ -477,6 +564,12 @@ val encode_pb_request_set : request_set -> Pbrt.Encoder.t -> unit
val encode_pb_request_delete : request_delete -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_delete v encoder] encodes [v] with the given [encoder] *)
+val encode_pb_request_discard : request_discard -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_discard v encoder] encodes [v] with the given [encoder] *)
+
+val encode_pb_request_session_changed : request_session_changed -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_session_changed v encoder] encodes [v] with the given [encoder] *)
+
val encode_pb_request_rename : request_rename -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_rename v encoder] encodes [v] with the given [encoder] *)
@@ -537,8 +630,8 @@ val encode_pb_request : request -> Pbrt.Encoder.t -> unit
val encode_pb_request_envelope : request_envelope -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_envelope v encoder] encodes [v] with the given [encoder] *)
-val encode_pb_status : status -> Pbrt.Encoder.t -> unit
-(** [encode_pb_status v encoder] encodes [v] with the given [encoder] *)
+val encode_pb_errnum : errnum -> Pbrt.Encoder.t -> unit
+(** [encode_pb_errnum v encoder] encodes [v] with the given [encoder] *)
val encode_pb_response : response -> Pbrt.Encoder.t -> unit
(** [encode_pb_response v encoder] encodes [v] with the given [encoder] *)
@@ -552,12 +645,21 @@ val decode_pb_request_config_format : Pbrt.Decoder.t -> request_config_format
val decode_pb_request_output_format : Pbrt.Decoder.t -> request_output_format
(** [decode_pb_request_output_format decoder] decodes a [request_output_format] binary value from [decoder] *)
-val decode_pb_request_status : Pbrt.Decoder.t -> request_status
-(** [decode_pb_request_status decoder] decodes a [request_status] binary value from [decoder] *)
+val decode_pb_request_prompt : Pbrt.Decoder.t -> request_prompt
+(** [decode_pb_request_prompt decoder] decodes a [request_prompt] binary value from [decoder] *)
val decode_pb_request_setup_session : Pbrt.Decoder.t -> request_setup_session
(** [decode_pb_request_setup_session decoder] decodes a [request_setup_session] binary value from [decoder] *)
+val decode_pb_request_session_of_pid : Pbrt.Decoder.t -> request_session_of_pid
+(** [decode_pb_request_session_of_pid decoder] decodes a [request_session_of_pid] binary value from [decoder] *)
+
+val decode_pb_request_session_update_pid : Pbrt.Decoder.t -> request_session_update_pid
+(** [decode_pb_request_session_update_pid decoder] decodes a [request_session_update_pid] binary value from [decoder] *)
+
+val decode_pb_request_get_config : Pbrt.Decoder.t -> request_get_config
+(** [decode_pb_request_get_config decoder] decodes a [request_get_config] binary value from [decoder] *)
+
val decode_pb_request_teardown : Pbrt.Decoder.t -> request_teardown
(** [decode_pb_request_teardown decoder] decodes a [request_teardown] binary value from [decoder] *)
@@ -570,6 +672,12 @@ val decode_pb_request_set : Pbrt.Decoder.t -> request_set
val decode_pb_request_delete : Pbrt.Decoder.t -> request_delete
(** [decode_pb_request_delete decoder] decodes a [request_delete] binary value from [decoder] *)
+val decode_pb_request_discard : Pbrt.Decoder.t -> request_discard
+(** [decode_pb_request_discard decoder] decodes a [request_discard] binary value from [decoder] *)
+
+val decode_pb_request_session_changed : Pbrt.Decoder.t -> request_session_changed
+(** [decode_pb_request_session_changed decoder] decodes a [request_session_changed] binary value from [decoder] *)
+
val decode_pb_request_rename : Pbrt.Decoder.t -> request_rename
(** [decode_pb_request_rename decoder] decodes a [request_rename] binary value from [decoder] *)
@@ -630,8 +738,8 @@ val decode_pb_request : Pbrt.Decoder.t -> request
val decode_pb_request_envelope : Pbrt.Decoder.t -> request_envelope
(** [decode_pb_request_envelope decoder] decodes a [request_envelope] binary value from [decoder] *)
-val decode_pb_status : Pbrt.Decoder.t -> status
-(** [decode_pb_status decoder] decodes a [status] binary value from [decoder] *)
+val decode_pb_errnum : Pbrt.Decoder.t -> errnum
+(** [decode_pb_errnum decoder] decodes a [errnum] binary value from [decoder] *)
val decode_pb_response : Pbrt.Decoder.t -> response
(** [decode_pb_response decoder] decodes a [response] binary value from [decoder] *)
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index fc47bf6..a0be019 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -24,6 +24,7 @@ let daemonize = ref true
let config_file = ref defaults.config_file
let basepath = ref "/"
let log_file = ref None
+let legacy_config_path = ref false
(* Global data *)
let sessions : (string, Session.session_data) Hashtbl.t = Hashtbl.create 10
@@ -39,23 +40,54 @@ let args = [
(Printf.sprintf "<string> Configuration file, default is %s" defaults.config_file));
("--log-file", Arg.String (fun s -> log_file := Some s), "<string> Log file");
("--base-path", Arg.String (fun s -> basepath := s), "<string> Appliance base path");
- ("--version", Arg.Unit (fun () -> print_endline @@ Version.version_info (); exit 0), "Print version and exit")
+ ("--version", Arg.Unit (fun () -> print_endline @@ Version.version_info (); exit 0), "Print version and exit");
+ ("--legacy-config-path", Arg.Unit (fun () -> legacy_config_path := true),
+ (Printf.sprintf "Load config file from legacy path %s" defaults.legacy_config_path));
]
let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]"
let response_tmpl = {status=Success; output=None; error=None; warning=None}
+let find_session token = Hashtbl.find sessions token
+
+let find_session_by_pid pid =
+ let exception E of string in
+ let find_k k v acc =
+ if v.Session.client_pid = pid then
+ raise_notrace (E k)
+ else acc
+ in
+ try
+ Hashtbl.fold find_k sessions None
+ with E x -> Some x
+
let make_session_token () =
Sha1.string (string_of_int (Random.bits ())) |> Sha1.to_hex
-let setup_session world req =
+let setup_session world (req: request_setup_session) =
let token = make_session_token () in
+ let pid = req.client_pid in
let user = "unknown user" 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
+let session_of_pid _world (req: request_session_of_pid) =
+ let pid = req.client_pid in
+ let extant = find_session_by_pid pid in
+ {response_tmpl with output=extant}
+
+let session_update_pid _world token (req: request_session_update_pid) =
+ let pid = req.client_pid in
+ try
+ begin
+ let s = Hashtbl.find sessions token in
+ if s.client_pid <> pid then
+ let session = {s with client_pid=pid} in
+ Hashtbl.replace sessions token session
+ end;
+ {response_tmpl with output=(Some token)}
+ with Not_found -> {response_tmpl with status=Fail; output=None}
let enter_conf_mode req token =
let open Session in
@@ -88,13 +120,25 @@ let exit_conf_mode world token =
in Hashtbl.replace sessions token session;
response_tmpl
-let teardown token =
+let teardown world token =
try
- Hashtbl.remove sessions token;
+ let () = Hashtbl.remove sessions token in
+ let () = Session.cleanup_config world token in
{response_tmpl with status=Success}
with Not_found ->
{response_tmpl with status=Fail; error=(Some "Session not found")}
+let session_changed world token (_req: request_session_changed) =
+ if Session.session_changed world (find_session token) then response_tmpl
+ else {response_tmpl with status=Fail}
+
+let get_config world token (_req: request_get_config) =
+ try
+ let id =
+ Session.get_config world (find_session token) token
+ in {response_tmpl with output=(Some id)}
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
let exists world token (req: request_exists) =
if Session.exists world (find_session token) req.path then response_tmpl
else {response_tmpl with status=Fail}
@@ -163,17 +207,43 @@ let delete world token (req: request_delete) =
response_tmpl
with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+let discard world token (_req: request_discard) =
+ try
+ let session = Session.discard world (find_session token)
+ in
+ Hashtbl.replace sessions token session;
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let load world token (req: request_load) =
+ try
+ let session = Session.load world (find_session token) req.location req.cached
+ in
+ Hashtbl.replace sessions token session;
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let merge world token (req: request_merge) =
+ try
+ let session = Session.merge world (find_session token) req.location req.destructive
+ in
+ Hashtbl.replace sessions token session;
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let save world token (req: request_save) =
+ try
+ let _ = Session.save world (find_session token) req.location
+ in
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
let commit world token (req: request_commit) =
let s = find_session token in
- let at = world.Session.running_config in
- let wt = s.proposed_config in
- let rt = world.reference_tree in
- let vc = world.vyconf_config in
- let () = IC.write_internal at (FP.concat vc.session_dir vc.running_cache) in
- let () = IC.write_internal wt (FP.concat vc.session_dir vc.session_cache) in
-
let req_dry_run = Option.value req.dry_run ~default:false in
- let commit_data = CC.make_commit_data ~dry_run:req_dry_run rt at wt token in
+
+ let commit_data = Session.prepare_commit ~dry_run:req_dry_run world s token
+ in
let%lwt received_commit_data = VC.do_commit commit_data in
let%lwt result_commit_data =
Lwt.return (CC.commit_update received_commit_data)
@@ -236,13 +306,15 @@ let rec handle_connection world ic oc () =
| _ as req ->
begin
(match req with
- | _, Status -> response_tmpl
+ | _, Prompt -> response_tmpl
| _, Setup_session r -> setup_session world r
+ | _, Session_of_pid r -> session_of_pid world r
| _, Reload_reftree r -> reload_reftree world r
| None, _ -> {response_tmpl with status=Fail; output=(Some "Operation requires session token")}
- | Some t, Teardown _ -> teardown t
- | Some t, Configure r -> enter_conf_mode r t
- | Some t, Exit_configure -> exit_conf_mode world t
+ | Some t, Session_update_pid r -> session_update_pid world t r
+ | Some t, Teardown _ -> teardown world t
+ | Some t, Enter_configuration_mode r -> enter_conf_mode r t
+ | Some t, Exit_configuration_mode -> exit_conf_mode world t
| Some t, Exists r -> exists world t r
| Some t, Get_value r -> get_value world t r
| Some t, Get_values r -> get_values world t r
@@ -251,6 +323,12 @@ let rec handle_connection world ic oc () =
| Some t, Validate r -> validate world t r
| Some t, Set r -> set world t r
| Some t, Delete r -> delete world t r
+ | Some t, Discard r -> discard world t r
+ | Some t, Session_changed r -> session_changed world t r
+ | Some t, Get_config r -> get_config world t r
+ | Some t, Load r -> load world t r
+ | Some t, Merge r -> merge world t r
+ | Some t, Save r -> save world t r
| _ -> failwith "Unimplemented"
) |> Lwt.return
end
@@ -306,8 +384,14 @@ let () =
let dirs = Directories.make !basepath vc in
Startup.check_validators_dir dirs;
let world = make_world vc dirs in
- let config = Startup.load_config_failsafe
- (FP.concat vc.config_dir vc.primary_config)
- (FP.concat vc.config_dir vc.fallback_config) in
+ let primary_config =
+ match !legacy_config_path with
+ | true -> defaults.legacy_config_path
+ | false -> (FP.concat vc.config_dir vc.primary_config)
+ in
+ let failsafe_config = (FP.concat vc.config_dir vc.fallback_config) in
+ let config =
+ Startup.load_config_failsafe primary_config failsafe_config
+ in
let world = Session.{world with running_config=config} in
Lwt_main.run @@ main_loop !basepath world ()
generated by cgit v1.2.3 (git 2.39.1) at 2025-08-23 01:04:50 +0000