T8313: add copy/rename request handlers

3 files changed, 69 insertions, 0 deletions

diff --git a/src/session.ml b/src/session.ml
index 53a8c7f..7658028 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -267,6 +267,53 @@ let aux_delete w s path name tagval =
 let discard _w s =
     { s with changeset = []; }
 
+let copy w s p1 p2 =
+    if Vyos1x.Util.is_empty p1
+    then raise (Session_error "Cannot copy an empty path")
+    else
+    if Vyos1x.Util.is_empty p2
+    then raise (Session_error "Cannot copy to an empty path")
+    else
+    let p1_total = s.edit_level @ p1 in
+    let p2_total = s.edit_level @ p2 in
+    let ct = get_proposed_config w s in
+    if not ((VT.exists[@alert "-exn"]) ct p1_total)
+    then
+    let p1_str = Vyos1x.Util.string_of_list p1_total in
+    let out = Printf.sprintf "Configuration path \"%s\" does not exist" p1_str in
+    raise (Session_error out)
+    else
+    let _ = validate w s p2_total in
+    let ct' = (VT.copy[@alert "-exn"]) ct p1_total p2_total in
+    let changeset' = get_changeset w s ct ct' in
+    { s with changeset = changeset' @ s.changeset }
+
+let rename w s p1 p2 =
+    if Vyos1x.Util.is_empty p1
+    then raise (Session_error "Cannot rename an empty path")
+    else
+    let p2_last =
+      match Vyos1x.Util.get_last p2 with
+      | None -> raise (Session_error "Cannot rename to an empty value")
+      | Some v -> v
+    in
+    if (Vyos1x.Util.drop_last p1) <> (Vyos1x.Util.drop_last p2)
+    then raise (Session_error "Cannot rename a node: paths are inconsistent")
+    else
+    let p1_total = s.edit_level @ p1 in
+    let p2_total = s.edit_level @ p2 in
+    let ct = get_proposed_config w s in
+    if not ((VT.exists[@alert "-exn"]) ct p1_total)
+    then
+    let p1_str = Vyos1x.Util.string_of_list p1_total in
+    let out = Printf.sprintf "Configuration path \"%s\" does not exist" p1_str in
+    raise (Session_error out)
+    else
+    let _ = validate w s p2_total in
+    let ct' = (VT.rename[@alert "-exn"]) ct p1_total p2_last in
+    let changeset' = get_changeset w s ct ct' in
+    { s with changeset = changeset' @ s.changeset }
+
 let edit_env_str s =
     (* To maintain consistency with classic CLI, we return env variable for
        PS1 on changes to edit level.
diff --git a/src/session.mli b/src/session.mli
index 08df1db..cb51075 100644
--- a/src/session.mli
+++ b/src/session.mli
@@ -100,3 +100,7 @@ val reference_path_exists : world -> session_data -> string list -> bool
 val get_path_type : ?legacy_format:bool -> world -> session_data -> string list -> string
 
 val get_completion_env : ?legacy_format:bool -> world -> session_data -> string list -> string
+
+val copy : world -> session_data -> string list -> string list -> session_data
+
+val rename : world -> session_data -> string list -> string list -> session_data
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 6029f95..45f0aad 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -263,6 +263,22 @@ let discard world token (_req: request_discard) =
         response_tmpl
     with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
 
+let copy world token (req: request_copy) =
+    try
+        let session = Session.copy world (find_session token) req.source req.destination
+        in
+        Hashtbl.replace sessions token session;
+        response_tmpl
+    with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let rename world token (req: request_rename) =
+    try
+        let session = Session.rename world (find_session token) req.source req.destination
+        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
@@ -505,6 +521,8 @@ let rec handle_connection world ic oc () =
                     | Some t, Reference_path_exists r -> reference_path_exists world t r
                     | Some t, Get_path_type r -> get_path_type world t r
                     | Some t, Get_completion_env r -> get_completion_env world t r
+                    | Some t, Copy r -> copy world t r
+                    | Some t, Rename r -> rename world t r
                     | _ -> failwith "Unimplemented"
                     ) |> Lwt.return
                end