diff options
Diffstat (limited to 'src/vyconfd.ml')
| -rw-r--r-- | src/vyconfd.ml | 105 |
1 files changed, 99 insertions, 6 deletions
diff --git a/src/vyconfd.ml b/src/vyconfd.ml index 95915b3..885fd20 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 @@ -92,6 +95,10 @@ let teardown token = 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 exists world token (req: request_exists) = if Session.exists world (find_session token) req.path then response_tmpl else {response_tmpl with status=Fail} @@ -144,6 +151,82 @@ let validate world token (req: request_validate) = response_tmpl with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} +let set world token (req: request_set) = + try + let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in + let session = Session.set world (find_session token) req.path in + Hashtbl.replace sessions token session; + response_tmpl + with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} + +let delete world token (req: request_delete) = + try + let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in + let session = Session.delete world (find_session token) req.path in + Hashtbl.replace sessions token session; + 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 + 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%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 -> + (* partial commit *) + if not req_dry_run then + 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 let reftree = @@ -172,12 +255,15 @@ 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 - | _, Status -> response_tmpl + (match req with + | _, Prompt -> response_tmpl | _, Setup_session r -> setup_session world r | _, Reload_reftree r -> reload_reftree world r | None, _ -> {response_tmpl with status=Fail; output=(Some "Operation requires session token")} @@ -190,8 +276,15 @@ let rec handle_connection world ic oc () = | Some t, List_children r -> list_children world t r | Some t, Show_config r -> show_config world t r | 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, Load r -> load world t r + | Some t, Save r -> save world t r | _ -> failwith "Unimplemented" - end) |> Lwt.return + ) |> Lwt.return + end in let%lwt () = send_response oc resp in handle_connection world ic oc () |