# HG changeset patch
# User Rob Hoes <rob.hoes@xxxxxxxxxx>
# Date 1278671598 -3600
# Node ID db0b2881600350f6051dbfd2ca8b8dd7237fab4d
# Parent  d60a95ace2e413722fe60aa2161330d6dc56f60c
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@xxxxxxxxxx>

diff -r d60a95ace2e4 -r db0b28816003 ocaml/idl/datamodel.ml
--- a/ocaml/idl/datamodel.ml
+++ b/ocaml/idl/datamodel.ml
@@ -85,6 +85,7 @@
 let _subject = "subject"
 let _role = "role"
 let _secret = "secret"
+let _tunnel = "tunnel"
 
 
 (** All the various static role names *)
@@ -4004,13 +4005,15 @@
 	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 @@
        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 @@
 		blob;
 		message;
 		secret;
+		tunnel;
 	]
 
 (** These are the pairs of (object, field) which are bound together in the database schema *)
@@ -6063,6 +6099,8 @@
     (_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 @@
     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 -r d60a95ace2e4 -r db0b28816003 ocaml/xapi/OMakefile
--- a/ocaml/xapi/OMakefile
+++ b/ocaml/xapi/OMakefile
@@ -121,6 +121,7 @@
 	xapi_hooks \
 	xapi_bond \
 	xapi_vlan \
+	xapi_tunnel \
 	xapi_sr \
 	xapi_sm \
 	xapi_pbd \
diff -r d60a95ace2e4 -r db0b28816003 ocaml/xapi/api_server.ml
--- a/ocaml/xapi/api_server.ml
+++ b/ocaml/xapi/api_server.ml
@@ -71,6 +71,7 @@
 	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 -r d60a95ace2e4 -r db0b28816003 ocaml/xapi/message_forwarding.ml
--- a/ocaml/xapi/message_forwarding.ml
+++ b/ocaml/xapi/message_forwarding.ml
@@ -421,6 +421,12 @@
 			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 @@
       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 -r d60a95ace2e4 -r db0b28816003 ocaml/xapi/xapi_tunnel.ml
--- /dev/null
+++ b/ocaml/xapi/xapi_tunnel.ml
@@ -0,0 +1,24 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+module D = Debug.Debugger(struct let name="xapi" end) 
+open D
+
+let create ~__context ~transport_PIF ~network =
+	debug "CREATE TUNNEL";
+	Ref.make ()
+	
+let destroy ~__context ~self =
+	debug "DESTROY TUNNEL";
+	()
+
diff -r d60a95ace2e4 -r db0b28816003 ocaml/xapi/xapi_tunnel.mli
--- /dev/null
+++ b/ocaml/xapi/xapi_tunnel.mli
@@ -0,0 +1,25 @@
+(*
+ * Copyright (C) 2006-2010 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+(** Module that defines API functions for tunnels
+ * @group Networking
+ *)
+
+(** Create a tunnel with... *)
+val create :
+  __context:Context.t ->
+  transport_PIF:[ `PIF ] Ref.t ->
+  network:[ `network ] Ref.t -> [ `tunnel ] Ref.t
+  
+(** Destroy a tunnel. Removes the tunnel object as well as the tunnel access PIF. *)
+val destroy : __context:Context.t -> self:[ `tunnel ] Ref.t -> unit