Tunnelling: add CLI support (xe tunnel-...)

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>

diff --git a/ocaml/client_records/records.ml b/ocaml/client_records/records.ml
index a7fdeea94a21290d06424c80180dff9e92292a60..9b8afbadad7324f1055e7752c8fbbbf158906f8f 100644 (file)
--- a/ocaml/client_records/records.ml
+++ b/ocaml/client_records/records.ml
@@ -156,6 +156,29 @@ let vlan_record rpc session_id vlan =
        make_field ~name:"tag"          ~get:(fun () -> Int64.to_string (x ()).API.vLAN_tag) ();
       ]
   }
+  
+let tunnel_record rpc session_id tunnel = 
+  let _ref = ref tunnel in
+  let empty_record = ToGet (fun () -> Client.Tunnel.get_record rpc session_id !_ref) in
+  let record = ref empty_record in
+  let x () = lzy_get record in
+  { setref=(fun r -> _ref := r; record := empty_record );
+    setrefrec=(fun (a,b) -> _ref := a; record := Got b);
+    record=x;
+    getref=(fun () -> !_ref);
+    fields=
+      [
+       make_field ~name:"uuid"         ~get:(fun () -> (x ()).API.tunnel_uuid) ();
+       make_field ~name:"access-PIF"   ~get:(fun () -> get_uuid_from_ref (x ()).API.tunnel_access_PIF) ();
+       make_field ~name:"transport-PIF" ~get:(fun () -> get_uuid_from_ref (x ()).API.tunnel_transport_PIF) ();
+       make_field ~name:"status"        ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.tunnel_status) ();
+       make_field ~name:"other-config" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.tunnel_other_config)
+               ~add_to_map:(fun k v -> Client.Tunnel.add_to_other_config rpc session_id tunnel k v)
+               ~remove_from_map:(fun k -> Client.Tunnel.remove_from_other_config rpc session_id tunnel k) 
+               ~get_map:(fun () -> (x ()).API.tunnel_other_config) ();
+
+      ]
+  }
 
 let message_record rpc session_id message = 
   let _ref = ref message in

diff --git a/ocaml/xapi/cli_frontend.ml b/ocaml/xapi/cli_frontend.ml
index 4780599a5a6c7cfdc29f69e7d08db8e2255ed84d..a954b3ff046971b646034295178e0e8eaf34e27c 100644 (file)
--- a/ocaml/xapi/cli_frontend.ml
+++ b/ocaml/xapi/cli_frontend.ml
@@ -1353,6 +1353,24 @@ there are two or more empty CD devices, please use the command 'vbd-insert' and
       implementation=No_fd Cli_operations.vlan_destroy;
       flags=[];
     };
+    
+   "tunnel-create",
+   {
+     reqd=["pif-uuid"; "network-uuid"];
+     optn=[];
+     help="Create a new tunnel on a host.";
+     implementation= No_fd Cli_operations.tunnel_create;
+     flags=[];
+   };
+
+   "tunnel-destroy",
+    {
+      reqd=["uuid"];
+      optn=[];
+      help="Destroy a tunnel.";
+      implementation=No_fd Cli_operations.tunnel_destroy;
+      flags=[];
+    };
 
    "pif-unplug",
     {

diff --git a/ocaml/xapi/cli_operations.ml b/ocaml/xapi/cli_operations.ml
index 381f43133ae647170ae25d334ca2920a010009eb..476ba208514c89bc0f2e8444386dd6862d168503 100644 (file)
--- a/ocaml/xapi/cli_operations.ml
+++ b/ocaml/xapi/cli_operations.ml
@@ -679,7 +679,8 @@ let gen_cmds rpc session_id =
        (make_param_funs (Client.Pool.get_all) (Client.Pool.get_all_records_where) (Client.Pool.get_by_uuid) (pool_record) "pool" [] ["uuid";"name-label";"name-description";"master";"default-SR"] rpc session_id) @ 
        (make_param_funs (Client.PIF.get_all) (Client.PIF.get_all_records_where) (Client.PIF.get_by_uuid) (pif_record) "pif" [] ["uuid";"device";"VLAN";"mac";"network-uuid"; "currently-attached"] rpc session_id) @ 
        (make_param_funs (Client.Bond.get_all) (Client.Bond.get_all_records_where) (Client.Bond.get_by_uuid) (bond_record) "bond" [] ["uuid";"master";"slaves"] rpc session_id) @ 
-       (make_param_funs (Client.VLAN.get_all) (Client.VLAN.get_all_records_where) (Client.VLAN.get_by_uuid) (vlan_record) "vlan" [] ["uuid";"tagged-PIF";"untagged-PIF"; "tag"] rpc session_id) @ 
+       (make_param_funs (Client.VLAN.get_all) (Client.VLAN.get_all_records_where) (Client.VLAN.get_by_uuid) (vlan_record) "vlan" [] ["uuid";"tagged-PIF";"untagged-PIF"; "tag"] rpc session_id) @
+       (make_param_funs (Client.Tunnel.get_all) (Client.Tunnel.get_all_records_where) (Client.Tunnel.get_by_uuid) (tunnel_record) "tunnel" [] ["uuid";"transport-PIF";"access-PIF";"status"] rpc session_id) @  
        (make_param_funs (Client.VIF.get_all) (Client.VIF.get_all_records_where) (Client.VIF.get_by_uuid) (vif_record) "vif" [] ["uuid";"device";"vm-uuid";"network-uuid"] rpc session_id)  @
        (make_param_funs (Client.Network.get_all) (Client.Network.get_all_records_where) (Client.Network.get_by_uuid) (net_record) "network" [] ["uuid";"name-label";"name-description";"bridge"] rpc session_id) @
        (make_param_funs (Client.Console.get_all) (Client.Console.get_all_records_where) (Client.Console.get_by_uuid) (console_record) "console" [] ["uuid";"vm-uuid";"vm-name-label";"protocol";"location"] rpc session_id) @
@@ -3208,6 +3209,18 @@ let vlan_destroy printer rpc session_id params =
        let pif = Client.PIF.get_by_uuid rpc session_id uuid in
        Client.PIF.destroy rpc session_id pif
 
+let tunnel_create printer rpc session_id params = 
+       let network = Client.Network.get_by_uuid rpc session_id (List.assoc "network-uuid" params) in
+       let pif = Client.PIF.get_by_uuid rpc session_id (List.assoc "pif-uuid" params) in
+       let tunnel = Client.Tunnel.create rpc session_id pif network in
+       let pif' = Client.Tunnel.get_access_PIF rpc session_id tunnel in
+       let uuid = Client.PIF.get_uuid rpc session_id pif' in
+       printer (Cli_printer.PList [uuid])
+  
+let tunnel_destroy printer rpc session_id params =
+       let uuid = List.assoc "uuid" params in
+       let tunnel = Client.Tunnel.get_by_uuid rpc session_id uuid in
+       Client.Tunnel.destroy rpc session_id tunnel
 
 let pif_reconfigure_ip printer rpc session_id params = 
   let read_optional_case_insensitive key =