diff options
Diffstat (limited to 'src/vyconfd.ml')
| -rw-r--r-- | src/vyconfd.ml | 57 |
1 files changed, 44 insertions, 13 deletions
diff --git a/src/vyconfd.ml b/src/vyconfd.ml index 76f7205..d3e4216 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -4,8 +4,11 @@ open Vyconf_connect.Vyconf_pbt open Vyconfd_config.Defaults open Vyconfd_config.Vyconf_config -module FP = FilePath module CT = Vyos1x.Config_tree +module IC = Vyos1x.Internal.Make(CT) +module CC = Commitd_client.Commit +module VC = Commitd_client.Vycall_client +module FP = FilePath module Gen = Vyos1x.Generate module Session = Vyconfd_config.Session module Directories = Vyconfd_config.Directories @@ -161,13 +164,38 @@ let delete world token (req: request_delete) = with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} let commit world token (_req: request_commit) = - try - let success, msg_str = Session.commit world (find_session token) token in - match success with - | true -> {response_tmpl with status=Success; output=(Some msg_str)} - | false -> {response_tmpl with status=Fail; output=(Some msg_str)} - with Session.Session_error msg -> - {response_tmpl with status=Internal_error; error=(Some msg)} + 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 commit_data = CC.make_commit_data rt at wt 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) + in + match result_commit_data.init with + | None -> + let out = "Empty init" in + Lwt.return {response_tmpl with status=Internal_error; error=(Some out)} + | Some init_data -> + let res, out = + init_data.success, init_data.out + in + match res with + | false -> + Lwt.return {response_tmpl with status=Internal_error; error=(Some out)} + | true -> + world.Session.running_config <- result_commit_data.config_result; + let success, msg_str = + result_commit_data.result.success, result_commit_data.result.out + in + match success with + | true -> Lwt.return {response_tmpl with status=Success; output=(Some msg_str)} + | false -> Lwt.return {response_tmpl with status=Fail; output=(Some msg_str)} let reload_reftree world (_req: request_reload_reftree) = let config = world.Session.vyconf_config in @@ -197,11 +225,14 @@ let rec handle_connection world ic oc () = with Pbrt.Decoder.Failure e -> Lwt.return (Error (Pbrt.Decoder.error_to_string e)) in let%lwt resp = - (match req with - | Error msg -> {response_tmpl with status=Fail; error=(Some (Printf.sprintf "Decoding error: %s" msg))} + match req with + | Error msg -> Lwt.return {response_tmpl with status=Fail; error=(Some (Printf.sprintf "Decoding error: %s" msg))} | Ok req -> + match req with + | Some t, Commit r -> commit world t r + | _ as req -> begin - match req with + (match req with | _, Status -> response_tmpl | _, Setup_session r -> setup_session world r | _, Reload_reftree r -> reload_reftree world r @@ -217,9 +248,9 @@ 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, Commit r -> commit world t r | _ -> failwith "Unimplemented" - end) |> Lwt.return + ) |> Lwt.return + end in let%lwt () = send_response oc resp in handle_connection world ic oc () |