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.ml86
-rw-r--r--src/session.mli15
-rw-r--r--src/vycli.ml3
-rw-r--r--src/vyconf_cli.ml88
-rw-r--r--src/vyconf_client.ml27
-rw-r--r--src/vyconf_client.mli9
-rw-r--r--src/vyconf_client_session.ml3
-rw-r--r--src/vyconf_pbt.ml257
-rw-r--r--src/vyconf_pbt.mli71
-rw-r--r--src/vyconfd.ml95
14 files changed, 610 insertions, 58 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 24a8153..1ff9bae 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -1,8 +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
@@ -24,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 =
@@ -99,8 +104,12 @@ let set w s path =
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 ->
+ 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)}
@@ -122,13 +131,31 @@ let session_changed w s =
let del_tree = CT.get_subtree diff ["del"] in
(del_tree <> CT.default) || (add_tree <> CT.default)
-let load w s file =
- let ct = Vyos1x.Config_file.load_config file in
+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
@@ -136,6 +163,55 @@ let save w s file =
| 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 9b8c5a0..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
@@ -36,7 +37,9 @@ val discard : world -> session_data -> session_data
val session_changed : world -> session_data -> bool
-val load : world -> session_data -> string -> session_data
+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
@@ -50,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/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_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 c4811c5..05b5548 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 ->
@@ -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 9c25c60..762495d 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -8,7 +8,9 @@ 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 session_of_pid : t -> int32 -> (t, string) result Lwt.t
val teardown_session : ?on_behalf_of:(int option) -> t -> (string, string) result Lwt.t
@@ -28,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 5518e27..913fcea 100644
--- a/src/vyconf_pbt.ml
+++ b/src/vyconf_pbt.ml
@@ -11,10 +11,23 @@ type request_output_format =
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;
}
@@ -70,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;
}
@@ -144,14 +159,17 @@ 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;
@@ -168,6 +186,7 @@ type errnum =
| Internal_error
| Permission_denied
| Path_already_exists
+ | Uncommited_changes
type response = {
status : errnum;
@@ -183,13 +202,33 @@ 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;
}
+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 = {
@@ -276,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;
}
@@ -387,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;
}
@@ -504,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;
}
@@ -654,11 +727,30 @@ 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 ()
+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;
@@ -737,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 ()
@@ -744,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 ()
@@ -841,14 +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 () =
@@ -868,6 +965,7 @@ let rec pp_errnum fmt (v:errnum) =
| 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 () =
@@ -896,16 +994,37 @@ 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;
()
@@ -1030,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;
()
@@ -1041,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;
()
@@ -1210,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 ->
@@ -1234,6 +1357,15 @@ let rec encode_pb_request (v:request) 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 =
@@ -1258,6 +1390,7 @@ let rec encode_pb_errnum (v:errnum) 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_errnum v.status encoder;
@@ -1307,27 +1440,93 @@ 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)
+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
@@ -1601,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
@@ -1612,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
@@ -1638,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)
@@ -1906,10 +2121,10 @@ 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)
@@ -1917,6 +2132,9 @@ let rec decode_pb_request d =
| 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 ()
@@ -1963,6 +2181,7 @@ let rec decode_pb_errnum d =
| 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 =
diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli
index 5f768f8..c9a7530 100644
--- a/src/vyconf_pbt.mli
+++ b/src/vyconf_pbt.mli
@@ -18,10 +18,23 @@ type request_output_format =
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;
}
@@ -77,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;
}
@@ -151,14 +166,17 @@ 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;
@@ -175,6 +193,7 @@ type errnum =
| Internal_error
| Permission_denied
| Path_already_exists
+ | Uncommited_changes
type response = {
status : errnum;
@@ -196,12 +215,31 @@ 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 ->
@@ -279,6 +317,7 @@ val default_request_rollback :
val default_request_load :
?location:string ->
+ ?cached:bool ->
?format:request_config_format option ->
unit ->
request_load
@@ -286,6 +325,7 @@ val default_request_load :
val default_request_merge :
?location:string ->
+ ?destructive:bool ->
?format:request_config_format option ->
unit ->
request_merge
@@ -395,6 +435,15 @@ val pp_request_prompt : Format.formatter -> request_prompt -> unit
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 *)
@@ -494,6 +543,15 @@ val encode_pb_request_prompt : request_prompt -> Pbrt.Encoder.t -> unit
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] *)
@@ -593,6 +651,15 @@ val decode_pb_request_prompt : Pbrt.Decoder.t -> request_prompt
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] *)
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 885fd20..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,9 +120,10 @@ 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")}
@@ -99,6 +132,13 @@ 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}
@@ -177,7 +217,15 @@ let discard world token (_req: request_discard) =
let load world token (req: request_load) =
try
- let session = Session.load world (find_session token) req.location
+ 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
@@ -192,15 +240,10 @@ let save world token (req: request_save) =
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)
@@ -265,11 +308,13 @@ let rec handle_connection world ic oc () =
(match req with
| _, 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
@@ -280,7 +325,9 @@ let rec handle_connection world ic oc () =
| 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
@@ -337,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-22 06:03:57 +0000