Tunnelling: add datamodel objects

This includes a new "tunnel" class and fields in the PIF class to link PIFs to tunnels.

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

diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml
index 28bcfead0fb1ba522e2ada28ed97aea4361eb016..46fade1acfe58caed97d88b4d7858d55a4b800a8 100644 (file)
--- a/ocaml/idl/datamodel.ml
+++ b/ocaml/idl/datamodel.ml
@@ -85,6 +85,7 @@ let _auth = "auth"
 let _subject = "subject"
 let _role = "role"
 let _secret = "secret"
+let _tunnel = "tunnel"
 
 
 (** All the various static role names *)
@@ -4004,13 +4005,15 @@ let pif =
        field ~in_oss_since:None ~ty:String ~in_product_since:rel_miami ~qualifier:DynamicRO "netmask" "IP netmask" ~default_value:(Some (VString ""));
        field ~in_oss_since:None ~ty:String ~in_product_since:rel_miami ~qualifier:DynamicRO "gateway" "IP gateway" ~default_value:(Some (VString ""));
        field ~in_oss_since:None ~ty:String ~in_product_since:rel_miami ~qualifier:DynamicRO "DNS" "IP address of DNS servers to use" ~default_value:(Some (VString ""));
-       field ~in_oss_since:None ~ty:(Ref _bond) ~in_product_since:rel_miami ~qualifier:DynamicRO "bond_slave_of" "indicates which bond this interface is part of" ~default_value:(Some (VRef ""));
-       field ~in_oss_since:None ~ty:(Set(Ref _bond)) ~in_product_since:rel_miami ~qualifier:DynamicRO "bond_master_of" "indicates this PIF represents the results of a bond";  
-       field ~in_oss_since:None ~ty:(Ref _vlan) ~in_product_since:rel_miami ~qualifier:DynamicRO "VLAN_master_of" "indicates wich VLAN this interface receives untagged traffic from" ~default_value:(Some (VRef ""));
-       field ~in_oss_since:None ~ty:(Set(Ref _vlan)) ~in_product_since:rel_miami ~qualifier:DynamicRO "VLAN_slave_of" "indicates which VLANs this interface transmits tagged traffic to";
-       field ~in_oss_since:None ~ty:Bool ~in_product_since:rel_miami ~qualifier:DynamicRO "management" "indicates whether the control software is listening for connections on this interface" ~default_value:(Some (VBool false));
-       field ~in_product_since:rel_miami ~default_value:(Some (VMap [])) ~ty:(Map(String, String)) "other_config" "additional configuration";
-       field ~in_product_since:rel_orlando ~default_value:(Some (VBool false)) ~ty:Bool "disallow_unplug" "prevent this PIF from being unplugged; set this to notify the management tool-stack that the PIF has a special use and should not be unplugged under any circumstances (e.g. because you're running storage traffic over it)";
+       field ~in_oss_since:None ~ty:(Ref _bond) ~in_product_since:rel_miami ~qualifier:DynamicRO "bond_slave_of" "Indicates which bond this interface is part of" ~default_value:(Some (VRef ""));
+       field ~in_oss_since:None ~ty:(Set(Ref _bond)) ~in_product_since:rel_miami ~qualifier:DynamicRO "bond_master_of" "Indicates this PIF represents the results of a bond";  
+       field ~in_oss_since:None ~ty:(Ref _vlan) ~in_product_since:rel_miami ~qualifier:DynamicRO "VLAN_master_of" "Indicates wich VLAN this interface receives untagged traffic from" ~default_value:(Some (VRef ""));
+       field ~in_oss_since:None ~ty:(Set(Ref _vlan)) ~in_product_since:rel_miami ~qualifier:DynamicRO "VLAN_slave_of" "Indicates which VLANs this interface transmits tagged traffic to";
+       field ~in_oss_since:None ~ty:Bool ~in_product_since:rel_miami ~qualifier:DynamicRO "management" "Indicates whether the control software is listening for connections on this interface" ~default_value:(Some (VBool false));
+       field ~in_product_since:rel_miami ~default_value:(Some (VMap [])) ~ty:(Map(String, String)) "other_config" "Additional configuration";
+       field ~in_product_since:rel_orlando ~default_value:(Some (VBool false)) ~ty:Bool "disallow_unplug" "Prevent this PIF from being unplugged; set this to notify the management tool-stack that the PIF has a special use and should not be unplugged under any circumstances (e.g. because you're running storage traffic over it)";
+       field ~in_oss_since:None ~ty:(Set(Ref _tunnel)) ~lifecycle:[] ~qualifier:DynamicRO "tunnel_access_PIF_of" "Indicates to which tunnel this PIF gives access";
+       field ~in_oss_since:None ~ty:(Set(Ref _tunnel)) ~lifecycle:[] ~qualifier:DynamicRO "tunnel_transport_PIF_of" "Indicates to which tunnel this PIF provides transport";
       ]
        ()
 
@@ -4099,6 +4102,38 @@ let vlan =
        field ~in_product_since:rel_miami ~default_value:(Some (VMap [])) ~ty:(Map(String, String)) "other_config" "additional configuration";    
      ])
     ()
+    
+let tunnel_create = call
+       ~name:"create"
+       ~doc:"Create a tunnel"
+       ~params:[ Ref _pif, "transport_PIF", "PIF which receives the tagged traffic";
+               Ref _network, "network", "Network to receive the tunnelled traffic" ]
+       ~result:(Ref _tunnel, "The reference of the created tunnel object")
+       ~lifecycle:[]
+       ~allowed_roles:_R_POOL_OP
+       ()
+
+let tunnel_destroy = call
+       ~name:"destroy"
+       ~doc:"Destroy a tunnel"
+       ~params:[Ref _tunnel, "self", "tunnel to destroy"]
+       ~lifecycle:[]
+       ~allowed_roles:_R_POOL_OP
+       ()
+
+let tunnel = 
+       create_obj ~in_db:true ~lifecycle:[] ~in_oss_since:None ~persist:PersistEverything ~gen_constructor_destructor:false ~name:_tunnel ~descr:"A tunnel for network traffic" ~gen_events:true
+       ~doccomments:[]
+       ~messages_default_allowed_roles:_R_POOL_OP
+       ~messages:[ tunnel_create; tunnel_destroy ]
+       ~contents:([
+               uid _tunnel ~lifecycle:[];
+               field ~qualifier:StaticRO ~ty:(Ref _pif) ~lifecycle:[] "access_PIF" "The interface through which the tunnel is accessed" ~default_value:(Some (VRef ""));
+               field ~qualifier:StaticRO ~ty:(Ref _pif) ~lifecycle:[] "transport_PIF" "The interface used by the tunnel" ~default_value:(Some (VRef ""));
+               field ~ty:(Map(String, String)) ~lifecycle:[] "status" "Status information about the tunnel" ~default_value:(Some (VMap [VString "active", VString "false"]));
+               field ~lifecycle:[] ~default_value:(Some (VMap [])) ~ty:(Map(String, String)) "other_config" "Additional configuration";          
+       ])
+       ()
 
  let pbd_set_device_config = call
    ~name:"set_device_config"
@@ -6045,6 +6080,7 @@ let all_system =
                blob;
                message;
                secret;
+               tunnel;
        ]
 
 (** These are the pairs of (object, field) which are bound together in the database schema *)
@@ -6063,6 +6099,8 @@ let all_relations =
     (_pif, "bond_slave_of"), (_bond, "slaves");
     (_bond, "master"), (_pif, "bond_master_of");
     (_vlan, "tagged_PIF"), (_pif, "VLAN_slave_of");
+    (_tunnel, "access_PIF"), (_pif, "tunnel_access_PIF_of");
+    (_tunnel, "transport_PIF"), (_pif, "tunnel_transport_PIF_of");
 
     (_pbd, "host"), (_host, "PBDs");
     (_pbd, "SR"), (_sr, "PBDs");
@@ -6142,7 +6180,7 @@ let no_async_messages_for = [ _session; _event; (* _alert; *) _task; _data_sourc
     or SR *)
 let expose_get_all_messages_for = [ _task; (* _alert; *) _host; _host_metrics; _hostcpu; _sr; _vm; _vm_metrics; _vm_guest_metrics;
        _network; _vif; _vif_metrics; _pif; _pif_metrics; _pbd; _vdi; _vbd; _vbd_metrics; _console; 
-       _crashdump; _host_crashdump; _host_patch; _pool; _sm; _pool_patch; _bond; _vlan; _blob; _subject; _role; _secret ]
+       _crashdump; _host_crashdump; _host_patch; _pool; _sm; _pool_patch; _bond; _vlan; _blob; _subject; _role; _secret; _tunnel ]
 
 
 let no_task_id_for = [ _task; (* _alert; *) _event ]

diff --git a/ocaml/xapi/OMakefile b/ocaml/xapi/OMakefile
index 34bd35580db1ecfad664860b1f478d861529cebd..fa45089be0dc60c4a0938ece6d1da57f6b37eefa 100644 (file)
--- a/ocaml/xapi/OMakefile
+++ b/ocaml/xapi/OMakefile
@@ -121,6 +121,7 @@ XAPI_MODULES = $(COMMON) \
        xapi_hooks \
        xapi_bond \
        xapi_vlan \
+       xapi_tunnel \
        xapi_sr \
        xapi_sm \
        xapi_pbd \

diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml
index 23a36e412429852ee749cc2121ffb5aa45d2e980..ce8427ffd7d108f96f5f2df9a91689d87b879dbe 100644 (file)
--- a/ocaml/xapi/api_server.ml
+++ b/ocaml/xapi/api_server.ml
@@ -71,6 +71,7 @@ module Actions = struct
        module Blob = Xapi_blob
        module Message = Xapi_message
        module Secret = Xapi_secret
+       module Tunnel = Xapi_tunnel
 end
 
 (** Use the server functor to make an XML-RPC dispatcher. *)

diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml
index 957a53df13ed9bced45a1d0bc8558d8cc860be1d..176a322f8d258b24077f6b126ea1facc4abf0cc7 100644 (file)
--- a/ocaml/xapi/message_forwarding.ml
+++ b/ocaml/xapi/message_forwarding.ml
@@ -421,6 +421,12 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
                        Ref.string_of vlan
                with _ -> "invalid"
 
+       let tunnel_uuid ~__context tunnel =
+               try if Pool_role.is_master () then
+                       Db.Tunnel.get_uuid __context tunnel
+               else
+                       Ref.string_of tunnel
+               with _ -> "invalid"
 
        let bond_uuid ~__context bond =
                try if Pool_role.is_master () then
@@ -2332,6 +2338,21 @@ end
       let local_fn = Local.VLAN.destroy ~self in
   do_op_on ~local_fn ~__context ~host:(Db.PIF.get_host ~__context ~self:(Db.VLAN.get_tagged_PIF ~__context ~self)) (fun session_id rpc -> Client.VLAN.destroy rpc session_id self)
   end
+  
+       module Tunnel = struct
+               let create ~__context ~transport_PIF ~network = 
+                       info "Tunnel.create: network = '%s'" (network_uuid ~__context network);
+                       let local_fn = Local.Tunnel.create ~transport_PIF ~network in
+                       do_op_on ~local_fn ~__context ~host:(Db.PIF.get_host ~__context ~self:transport_PIF)
+                               (fun session_id rpc -> Client.Tunnel.create rpc session_id transport_PIF network)
+         
+               let destroy ~__context ~self = 
+                       info "Tunnel.destroy: tunnel = '%s'" (tunnel_uuid ~__context self);
+                       let local_fn = Local.Tunnel.destroy ~self in
+                       do_op_on ~local_fn ~__context ~host:(Db.PIF.get_host ~__context
+                               ~self:(Db.Tunnel.get_transport_PIF ~__context ~self))
+                               (fun session_id rpc -> Client.Tunnel.destroy rpc session_id self)
+       end
 
   module Bond = struct
     let create ~__context ~network ~members ~mAC = 

diff --git a/ocaml/xapi/xapi_tunnel.ml b/ocaml/xapi/xapi_tunnel.ml
index de796683846272ca9ca1ceb76ab5b7363cdccec8..29850f453d2d55077bedf7723fb046ea9cf5b9c6 100644 (file)
--- a/ocaml/xapi/xapi_tunnel.ml
+++ b/ocaml/xapi/xapi_tunnel.ml
@@ -14,42 +14,11 @@
 module D = Debug.Debugger(struct let name="xapi" end) 
 open D
 
-let choose_tunnel_device_name ~__context ~host = 
-       let pifs = List.filter (fun self -> Db.PIF.get_host ~__context ~self = host) (Db.PIF.get_all ~__context) in
-       let devices = List.map (fun self -> Db.PIF.get_device ~__context ~self) pifs in
-       let rec choose n = 
-               let name = Printf.sprintf "tunnel%d" n in
-               if List.mem name devices
-               then choose (n + 1)
-               else name in
-       choose 0
-
 let create ~__context ~transport_PIF ~network =
-       let pool = Helpers.get_pool ~__context in
-       let host = Db.PIF.get_host ~__context ~self:transport_PIF in
-       Xapi_pif.assert_no_other_local_pifs ~__context ~host ~network;
-       if Netdev.network.Netdev.kind <> Netdev.Vswitch then
-               raise (Api_errors.Server_error (Api_errors.openvswitch_not_active, []));
-       if Db.PIF.get_tunnel_access_PIF_of ~__context ~self:transport_PIF <> [] then
-               raise (Api_errors.Server_error (Api_errors.is_tunnel_access_pif, [Ref.string_of transport_PIF]));
-       let tunnel = Ref.make () in
-       let access_PIF = Ref.make () in
-       let device = choose_tunnel_device_name ~__context ~host in
-       let device_name = device in
-       let mAC = Xapi_vif_helpers.gen_mac (0, Uuid.to_string (Uuid.make_uuid ())) in
-       Db.PIF.create ~__context ~ref:access_PIF ~uuid:(Uuid.to_string (Uuid.make_uuid ()))
-               ~device ~device_name ~network ~host ~mAC ~mTU:(-1L) ~vLAN:(-1L) ~metrics:Ref.null
-               ~physical:false ~currently_attached:false 
-               ~ip_configuration_mode:`None ~iP:"" ~netmask:"" ~gateway:"" ~dNS:"" ~bond_slave_of:Ref.null 
-               ~vLAN_master_of:Ref.null ~management:false ~other_config:[] ~disallow_unplug:false;
-       Db.Tunnel.create ~__context ~ref:tunnel ~uuid:(Uuid.to_string (Uuid.make_uuid ()))
-               ~access_PIF ~transport_PIF ~status:["active", "false"] ~other_config:[];
-       Xapi_pif.plug ~__context ~self:access_PIF;
-       tunnel
+       debug "CREATE TUNNEL";
+       Ref.make ()
        
 let destroy ~__context ~self =
-       let pif = Db.Tunnel.get_access_PIF ~__context ~self in
-       Xapi_pif.unplug ~__context ~self:pif;
-       Db.PIF.destroy ~__context ~self:pif;
-       Db.Tunnel.destroy ~__context ~self
+       debug "DESTROY TUNNEL";
+       ()