# HG changeset patch
# User Rob Hoes <rob.hoes@xxxxxxxxxx>
# Date 1258733582 0
# Node ID 2b994a4fda1ef278a1291562f9867b360862ac8f
# Parent 7a31678e878cef08b4d5b53b64ef72bbb5b08a05
[ocamldoc] Added docs for networking modules
Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/doc/ocamldoc.js
--- a/ocaml/doc/ocamldoc.js Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/doc/ocamldoc.js Fri Nov 20 16:13:02 2009 +0000
@@ -156,7 +156,7 @@
html += '<div class="field-description">';
if (v.info.description != undefined)
- html += v.info.description + '</div>';
+ html += transform_links(v.info.description) + '</div>';
else
html += '<span class="empty">to be completed!</span></div>';
@@ -192,7 +192,7 @@
html += '<div class="field-name">' + name + '</div>';
html += '<div class="field-description">';
if (v.info.description != undefined)
- html += v.info.description + '</div>';
+ html += transform_links(v.info.description) + '</div>';
else
html += '<span class="empty">to be completed!</span></div>';
html += '<table class="field-table">';
@@ -216,7 +216,7 @@
html += '<tr><td>' + cons[c].name + '</td>'
html += '<td>' + cons[c].type + '</td>'
if (cons[c].description != undefined)
- html += '<td>' + cons[c].description + '</td>';
+ html += '<td>' + transform_links(cons[c].description) +
'</td>';
else
html += '<td><span class="empty">to be
completed!</span></td></tr>';
html += '</tr>';
@@ -234,7 +234,7 @@
html += '<tr><td>' + fields[c].name + '</td>'
html += '<td>' + fields[c].type + '</td>'
if (fields[c].description != undefined)
- html += '<td>' + fields[c].description + '</td>';
+ html += '<td>' + transform_links(fields[c].description)
+ '</td>';
else
html += '<td><span class="empty">to be
completed!</span></td></tr>';
html += '</tr>';
@@ -253,7 +253,7 @@
html += '<div class="field-name">' + name + '</div>';
html += '<div class="field-description">';
if (v.info.description != undefined)
- html += v.info.description + '</div>';
+ html += transform_links(v.info.description) + '</div>';
else
html += '<span class="empty">to be completed!</span></div>';
if (v.kind.type == 'variant')
@@ -276,7 +276,7 @@
html += '<div class="field-name">' + name + '</div>';
html += '<div class="field-description">';
if (v.info.description != undefined)
- html += v.info.description + '</div>';
+ html += transform_links(v.info.description) + '</div>';
else
html += '<span class="empty">to be completed!</span></div>';
if (v.kind.type == 'variant')
@@ -299,7 +299,7 @@
html += '<div class="field-name">' + name + '</div>';
html += '<div class="field-description">';
if (v.info.description != undefined)
- html += v.info.description + '</div>';
+ html += transform_links(v.info.description) + '</div>';
else
html += '<span class="empty">to be completed!</span></div>';
html += '<table class="field-table">';
@@ -313,7 +313,7 @@
function comment(m)
{
- append_content('<div>' + m + '</div>');
+ append_content('<div>' + transform_links(m) + '</div>');
}
function parse_structure(structure)
@@ -460,8 +460,12 @@
modules = component_modules[component];
for (j in modules) {
html += '<tr><td><a href="?c=' + component + '&m=' +
modules[j].name + '">' + modules[j].name + '</a></td>\n';
- if (modules[j].description != "")
- html += '<td>' + modules[j].description +
'</td></tr>\n';
+ if (modules[j].description != "") {
+ d = modules[j].description;
+ if ((i = d.indexOf('.')) > -1)
+ d = d.substr(0, i);
+ html += '<td>' + d + '.</td></tr>\n';
+ }
else
html += '<td><span class="empty">to be
completed!</span></td></tr>';
}
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/doc/odoc_json.ml
--- a/ocaml/doc/odoc_json.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/doc/odoc_json.ml Fri Nov 20 16:13:02 2009 +0000
@@ -218,7 +218,7 @@
(Printf.sprintf "</%s>" tag)
and print_t_list l =
- String.concat " " (List.map print_one_t l)
+ String.concat "" (List.map print_one_t l)
(* the actual generator class *)
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/doc/style.css
--- a/ocaml/doc/style.css Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/doc/style.css Fri Nov 20 16:13:02 2009 +0000
@@ -1,4 +1,16 @@
-/* A style for ocamldoc. Daniel C. Buenzli */
+/*
+ * 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.
+ */
body {
padding: 0;
@@ -70,11 +82,6 @@
height: 1em;
}
-/*
-pre, p, div, span, img, table, td, ol, ul, li
- { padding: 0em; border: 0em; margin: 0em }
-*/
-
h1, h2, h3, h4, h5, h6, h7, h8, h9 {
border: 0em;
font-weight: bold;
@@ -111,10 +118,6 @@
margin-top: 0;
}
-/*.navbar { padding-bottom : 1em; margin-bottom: 1em }
-
-p { padding: 1em 0ex 0em 0em }
-*/
a, a:link, a:visited, a:active, a:hover { color : inherit; text-decoration:
none;}
a:hover { color : inherit; text-decoration : underline }
@@ -126,49 +129,32 @@
border: 1px thin #666;
}
-pre { margin: 3ex 0em 1ex 0em; }
-.keyword { font-weight: bold; color: black }
-.keywordsign { color : black }
-.code { font-family: Courier New, monospace; }
-.info { margin: 0em 0em 0em 2em }
-.comment { color : red }
-.constructor { color : #072 }
-.type { color : black }
-.string { color : #bc8f8f }
-.warning { color : Red ; font-weight : bold }
-
-div.sig_block {margin-left: 2em}
-.typetable { border-style : hidden }
-.indextable { border-style : hidden }
-.paramstable { border-style : hidden ; padding: 5pt 5pt}
-
.superscript { font-size : 80% }
.subscript { font-size : 80% }
#menu {
-margin: 1.5em .7em 0;
-list-style-type: none;
-text-align: center;
-float: right;
-clear: right;
+ margin: 1.5em .7em 0;
+ list-style-type: none;
+ text-align: center;
+ float: right;
+ clear: right;
}
#menu li {
-display: block;
-float: left;
+ display: block;
+ float: left;
}
#menu li a {
-padding: 15px 0 0 2em;
-font-size: 1.3em;
-font-weight: bold;
+ padding: 15px 0 0 2em;
+ font-size: 1.3em;
+ font-weight: bold;
}
-#menu li a:hover,
-#personal #menu-personal a, #research #menu-research a, #links #menu-links a
+#menu li a:hover
{
-color: #fff;
-text-decoration: none;
+ color: #fff;
+ text-decoration: none;
}
.grey {
@@ -214,6 +200,10 @@
background-color: orange;
}
+.code {
+ font-family: Courier New, monospace;
+}
+
.field, .field2
{
margin: 0em 0;
@@ -250,3 +240,4 @@
font-size: 70%;
text-align: right;
}
+
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/netdev/netdev.ml
--- a/ocaml/netdev/netdev.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/netdev/netdev.ml Fri Nov 20 16:13:02 2009 +0000
@@ -315,4 +315,5 @@
read_id_from (getpath name "device/vendor"),
read_id_from (getpath name "device/device")
+(** Indicates whether the given interface is a physical interface *)
let is_physical name = try Unix.access (getpath name "device") [ Unix.F_OK ];
true with _ -> false
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/dbsync_slave.ml
--- a/ocaml/xapi/dbsync_slave.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/dbsync_slave.ml Fri Nov 20 16:13:02 2009 +0000
@@ -111,7 +111,7 @@
end else
Db.Host.remove_from_other_config ~__context ~self:host
~key:Xapi_globs.host_no_local_storage
-(** copy bonded and vlan pifs from master *)
+(** Copy Bonds from master *)
let copy_bonds_from_master ~__context =
if Pool_role.is_master () then () (* if master do nothing *)
else
@@ -195,7 +195,8 @@
let master_bonds = List.filter (fun (_, b) -> List.mem
b.API.bond_master (List.map fst all_master_pifs)) all_bonds in
List.iter (Helpers.log_exn_continue "resynchronising bonds on slave"
maybe_create_bond_for_me)
(List.map snd master_bonds))
-
+
+(** Copy VLANs from master *)
let copy_vlans_from_master ~__context =
if Pool_role.is_master () then () (* if master do nothing *)
else
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/helpers.ml
--- a/ocaml/xapi/helpers.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/helpers.ml Fri Nov 20 16:13:02 2009 +0000
@@ -33,6 +33,7 @@
let log_exn_continue msg f x = try f x with e -> debug "Ignoring exception: %s
while %s" (ExnHelper.string_of_exn e) msg
+(** Construct a descriptive network name (used as name_label) for a give
network interface. *)
let choose_network_name_for_pif device =
Printf.sprintf "Pool-wide network associated with %s" device
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/nm.ml
--- a/ocaml/xapi/nm.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/nm.ml Fri Nov 20 16:13:02 2009 +0000
@@ -23,17 +23,16 @@
let interface_reconfigure_script =
"/opt/xensource/libexec/interface-reconfigure"
+(* Make sure inventory file has all current interfaces on the local host, so
+ * they will all be brought up again at start up. *)
let update_inventory ~__context =
- (* make sure inventory file has all current interfaces on the local host, so
- * they will all be brought up again at start up *)
let pifs = List.filter (fun pif -> Db.PIF.get_currently_attached ~__context
~self:pif &&
Db.PIF.get_host ~__context ~self:pif = Helpers.get_localhost ~__context)
(Db.PIF.get_all ~__context) in
let get_netw pif = Db.PIF.get_network ~__context ~self:pif in
let bridges = List.map (fun pif -> Db.Network.get_bridge ~__context
~self:(get_netw pif)) pifs in
Xapi_inventory.update Xapi_inventory._current_interfaces (String.concat " "
bridges)
-(** Call the interface reconfigure script.
- For development ignore the exn if it doesn't exist *)
+(* Call the interface reconfigure script. For development ignore the exn if it
doesn't exist *)
let reconfigure_pif ~__context (pif: API.ref_PIF) args =
try
Helpers.call_api_functions ~__context
@@ -46,9 +45,6 @@
raise (Api_errors.Server_error(Api_errors.pif_configuration_error, [
Ref.string_of pif; stderr ]))
-(* The management_interface argument determines whether this PIF is _going_ to
become the management
- interface in the future.
-*)
let bring_pif_up ~__context ?(management_interface=false) (pif: API.ref_PIF) =
with_local_lock
(fun () ->
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/nm.mli
--- a/ocaml/xapi/nm.mli Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/nm.mli Fri Nov 20 16:13:02 2009 +0000
@@ -11,12 +11,17 @@
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
+(** Helper module to plug and unplug PIFs *)
-(** Call out to the script to bring up a PIF on this host. The script will be
skipped if
- PIF.currently_attached is still marked as true UNLESS management_interface
is set. *)
+(** Calls the [interface-reconfigure] script to bring up a PIF on this host.
The script will be skipped if
+ * PIF.currently_attached is still marked as [true] {i unless}
[management_interface] is set.
+ * The [management_interface] argument determines whether this PIF is {i
going} to become the management
+ * interface in the future.
+ *)
val bring_pif_up : __context:Context.t -> ?management_interface:bool ->
API.ref_PIF -> unit
-(** Call out to the script to take down a PIF on this host *)
+(** Calls the [interface-reconfigure] script to take down a PIF on this host *)
val bring_pif_down : __context:Context.t -> API.ref_PIF -> unit
+(** Execute a given function under the control of a mutex *)
val with_local_lock : (unit -> 'a) -> 'a
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_bond.ml
--- a/ocaml/xapi/xapi_bond.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/xapi_bond.ml Fri Nov 20 16:13:02 2009 +0000
@@ -27,9 +27,6 @@
else name in
choose 0
-
-(** Create a PIF to represent the bond master and a Bond record to represent
the bond.
- Return a reference to the bond record. *)
let create ~__context ~network ~members ~mAC =
let host = Db.PIF.get_host ~__context ~self:(List.hd members) in
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_bond.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ocaml/xapi/xapi_bond.mli Fri Nov 20 16:13:02 2009 +0000
@@ -0,0 +1,28 @@
+(*
+ * 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 that defines API functions for Bonds *)
+
+(** Create a PIF to represent the bond master and a Bond record to represent
the bond.
+ * Return a reference to the bond record. The given network must not have any
local
+ * PIFs on it yet.
+ *)
+val create :
+ __context:Context.t ->
+ network:[ `network ] Ref.t ->
+ members:[ `PIF ] Ref.t list -> mAC:string -> [ `Bond ] Ref.t
+
+(** Destroy the bond master (PIF) and the Bond objects, unless the bond master
+ * is the management interface, or used as VLAN master. *)
+val destroy : __context:Context.t -> self:[ `Bond ] Ref.t -> unit
+
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_fist.ml
--- a/ocaml/xapi/xapi_fist.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/xapi_fist.ml Fri Nov 20 16:13:02 2009 +0000
@@ -26,55 +26,70 @@
Some (Unixext.read_whole_file_to_string ("/tmp/fist_" ^ name))
with _ -> None
+(** Insert 2 * Xapi_globs.max_clock_skew into the heartbeat messages *)
let insert_clock_skew () = fistpoint "insert_clock_skew"
-(** Insert 2 * Xapi_globs.max_clock_skew into the heartbeat messages *)
+(** Force the use of the more conservative binpacker *)
let choose_approximate_planner () = fistpoint "choose_approximate_planner"
-(** Force the use of the more conservative binpacker *)
+
+(** Pretend that disabling HA via the statefile (ie via ha_set_pool_state
invalid) doesn't work *)
let disable_ha_via_statefile () = fistpoint "disable_ha_via_statefile"
-(** Pretend that disabling HA via the statefile (ie via ha_set_pool_state
invalid) doesn't work *)
+
+(** Make the current node throw an error during the
ha_disable_failover_decisions call *)
let disable_ha_disable_failover () = fistpoint "disable_ha_disable_failover"
-(** Make the current node throw an error during the
ha_disable_failover_decisions call *)
+
+(** Make the current node fail during the HA enable step *)
let fail_healthcheck () = fistpoint "fail_healthcheck"
-(** Make the current node fail during the HA enable step *)
+
let reconfigure_host () = fistpoint "reconfigure_host"
+
+(** Raise MTC_EXIT_CAN_NOT_ACCESS_STATEFILE *)
let ha_cannot_access_statefile () = fistpoint "ha_cannot_access_statefile"
-(** Raise MTC_EXIT_CAN_NOT_ACCESS_STATEFILE *)
+
+(** Simulate a misc xHA daemon startup failure *)
let ha_daemon_startup_failed () = fistpoint "ha_daemon_startup_failed"
-(** Simulate a misc xHA daemon startup failure *)
+
+(** Make individual HA failover VM.starts fail with a probability of 2/3 *)
let simulate_restart_failure () = fistpoint "simulate_restart_failure"
-(** Make individual HA failover VM.starts fail with a probability of 2/3 *)
+
+(** Throw an error in the failed VM restart logic when trying to compute a
plan (it should fall back to best-effort) *)
let simulate_planner_failure () = fistpoint "simulate_planner_failure"
-(** Throw an error in the failed VM restart logic when trying to compute a
plan (it should fall back to best-effort) *)
+
+(** Skip the check to prevent chaining of VLANs *)
let allow_vlan_on_vlan () = fistpoint "allow_vlan_on_vlan"
-(** Skip the check to prevent chaining of VLANs *)
+
+(** Skip the check to prevent untagged VLAN PIFs being forgotten (block added
in CA-24056; conflicts with repro advice in CA-23042) *)
let allow_forget_of_vlan_pif () = fistpoint "allow_forget_of_vlan_pif"
-(** Skip the check to prevent untagged VLAN PIFs being forgotten (block added
in CA-24056; conflicts with repro advice in CA-23042) *)
+
+(** Pretend that VMs need no memory while starting or running. *)
let disable_memory_checks () = fistpoint "disable_memory_checks"
-(** Pretend that VMs need no memory while starting or running. *)
+
+(** Disable randomisation within the host selection algorithm. *)
let deterministic_host_selection () = fistpoint "deterministic_host_selection"
-(** Disable randomisation within the host selection algorithm. *)
+(** Used to simulate a very slow planner to test Pool.ha_prevent_restarts_for
*)
let simulate_blocking_planner () = fistpoint "simulate_blocking_planner"
-(** Used to simulate a very slow planner to test Pool.ha_prevent_restarts_for
*)
+(** Used to simulate an initial VBD.unplug failure *)
let simulate_vbd_unplug_failure () = fistpoint "simulate_vbd_unplug_failure"
-(** Used to simulate an initial VBD.unplug failure *)
(** {2 RRD fist points}
- * nb, these are evaluated once at run time and not again - no dynamic
changing here :-) *)
+ * NB: these are evaluated once at run time and not again - no dynamic
changing here :-) *)
+(** Reduce blob sync period to 5 minutes *)
let reduce_blob_sync_interval = fistpoint "reduce_blob_sync_interval"
-(** Reduce blob sync period to 5 minutes *)
+
let reduce_rrd_backup_interval = fistpoint "reduce_rrd_backup_interval"
let reduce_rra_times = fistpoint "reduce_rra_times"
(** {2 Licensing fist points} *)
+(** Reduce the v6-licensing grace period from 30 days to 15 minutes *)
let reduce_grace_period () = fistpoint "reduce_grace_period"
-(** Reduce the v6-licensing grace period from 30 days to 15 minutes *)
+
+(** Reduce the v6-licensing upgrade grace period from 4 days to 15 minutes *)
let reduce_upgrade_grace_period () = fistpoint "reduce_upgrade_grace_period"
-(** Reduce the v6-licensing upgrade grace period from 4 days to 15 minutes *)
+
+(** Set the expiry date of a v6-license to the one in the file *)
let set_expiry_date () = fistpoint_read "set_expiry_date"
-(** Set the expiry date of a v6-license to the one in the file *)
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_network.ml
--- a/ocaml/xapi/xapi_network.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/xapi_network.ml Fri Nov 20 16:13:02 2009 +0000
@@ -20,16 +20,10 @@
open Db_filter
+(* REMOVE: unused function that does not return anything useful anyway
let get_allowed_messages ~__context ~self = []
+*)
-(* Instantiate the Network (ie bridge) on this host provided it wouldn't
- destroy existing Networks (e.g. slaves of a bond) in use by something (VIF
- or management interface).
- Note special-case handling of new management interfaces: we skip the
- check for the existing management interface (essential otherwise switching
- from a bond slave to a bond master would fail) and we make sure to call
- Nm.bring_pif_up with the management_interface argument so it can make sure
- the default gateway is set up correctly *)
let attach_internal ?(management_interface=false) ~__context ~self () =
let host = Helpers.get_localhost () in
let shafted_pifs, local_pifs =
@@ -64,9 +58,7 @@
debug "Trying to attach PIF: %s" uuid;
Nm.bring_pif_up ~__context ~management_interface pif
) local_pifs
-
-
let detach bridge_name =
Xapi_network_real.maybe_shutdown_guest_installer_network bridge_name;
if Netdev.Bridge.exists bridge_name then begin
@@ -79,7 +71,6 @@
Netdev.Bridge.del bridge_name
end
-(** Network.attach external call *)
let attach ~__context ~network ~host = attach_internal ~__context
~self:network ()
let counter = ref 0
@@ -116,7 +107,6 @@
debug "Skipping network GC")
-(** Internal fn used by slave to create new network records on master during
pool join operation *)
let pool_introduce ~__context ~name_label ~name_description ~other_config
~bridge =
let r = Ref.make() and uuid = Uuid.make_uuid() in
Db.Network.create ~__context ~ref:r ~uuid:(Uuid.to_string uuid)
@@ -124,7 +114,6 @@
~name_label ~name_description ~bridge ~other_config ~blobs:[] ~tags:[];
r
-(** Attempt to create a bridge with a unique name *)
let create ~__context ~name_label ~name_description ~other_config ~tags =
Mutex.execute mutex (fun () ->
let networks = Db.Network.get_all ~__context in
@@ -141,8 +130,6 @@
r in
loop ())
-(** WARNING WARNING WARNING: called with the master dispatcher lock; do
nothing but basic DB calls
- here without being really sure *)
let destroy ~__context ~self =
let vifs = Db.Network.get_VIFs ~__context ~self in
let connected = List.filter
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_network.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ocaml/xapi/xapi_network.mli Fri Nov 20 16:13:02 2009 +0000
@@ -0,0 +1,47 @@
+(** Module that defines API functions for Network objects *)
+
+(** Instantiate the bridge associated to this network on the localhost, and
bring
+ up the PIFs on the localhost that are on this network, provided it wouldn't
+ destroy existing Networks (e.g. slaves of a bond) in use by something (VIF
or management interface).
+ Note special-case handling of new management interfaces: we skip the
+ check for the existing management interface (essential otherwise switching
+ from a bond slave to a bond master would fail) and we make sure to call
+ {!Nm.bring_pif_up} with the [management_interface] argument so it can make
sure
+ the default gateway is set up correctly *)
+val attach_internal :
+ ?management_interface:bool ->
+ __context:Context.t -> self:[ `network ] Ref.t -> unit -> unit
+
+(** Remove the bridge associated to this network *)
+val detach : string -> unit
+
+(** Makes the network immediately available on a particular host
(Network.attach is hidden from docs) *)
+val attach :
+ __context:Context.t -> network:[ `network ] Ref.t -> host:'a -> unit
+
+val network_gc_func : unit -> unit
+
+(** Internal fn used by slave to create new network records on master during
pool join operation *)
+val pool_introduce :
+ __context:Context.t ->
+ name_label:string ->
+ name_description:string ->
+ other_config:(string * string) list -> bridge:string -> [ `network ] Ref.t
+
+(** Attempt to create a bridge with a unique name *)
+val create :
+ __context:Context.t ->
+ name_label:string ->
+ name_description:string ->
+ other_config:(string * string) list ->
+ tags:string list -> [ `network ] Ref.t
+
+(** WARNING WARNING WARNING: called with the master dispatcher lock; do
nothing but basic DB calls
+ here without being really sure *)
+val destroy : __context:Context.t -> self:[ `network ] Ref.t -> unit
+
+(** Create a placeholder for a named binary blob of data that is associated
with this pool *)
+val create_new_blob :
+ __context:Context.t ->
+ network:[ `network ] Ref.t ->
+ name:string -> mime_type:string -> [ `blob ] Ref.t
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_network_attach_helpers.ml
--- a/ocaml/xapi/xapi_network_attach_helpers.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/xapi_network_attach_helpers.ml Fri Nov 20 16:13:02 2009 +0000
@@ -11,9 +11,12 @@
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
+(** Assertion helpers used when attaching a network *)
+
module D=Debug.Debugger(struct let name="xapi" end)
open D
+(** Raises an exception if the network has VIFs in use on the host *)
let assert_network_has_no_vifs_in_use_on_me ~__context ~host ~network =
(* Check if there are any active VIFs on VMs resident on me *)
let vifs = Db.Network.get_VIFs ~__context ~self:network in
@@ -29,11 +32,23 @@
end)
vifs
+(** Raises an exception when the [disallow_unplug] flag is set *)
(* nice triple negative ;) *)
let assert_pif_disallow_unplug_not_set ~__context pif =
if (Db.PIF.get_disallow_unplug ~__context ~self:pif) then
raise (Api_errors.Server_error(Api_errors.pif_does_not_allow_unplug, [
Ref.string_of pif ]))
+(** Raises an exception if the network cannot be attached.
+ * Returns a list of {i shafted} PIFs and a list of {i local} PIFs.
+
+ * Cannot attach this network if it has a PIF AND this PIF 'shafts'
+ * some other PIF which is attached to a network which is 'in-use'.
+ * Bringing a bond master up, or a VLAN on a bond, shafts the bond slaves;
+ * similarly, bringing a bond slave up shafts its master + that master's VLANs;
+ * but sibling slaves don't shaft each other.
+ *
+ * There should be only one local PIF by construction.
+ *)
let assert_can_attach_network_on_host ~__context ~self ~host
~overide_management_if_check =
(* Cannot attach this network if it has a PIF AND this PIF 'shafts'
some other PIF which is attached to a network which is 'in-use'.
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_pif.ml
--- a/ocaml/xapi/xapi_pif.ml Fri Nov 20 16:13:02 2009 +0000
+++ b/ocaml/xapi/xapi_pif.ml Fri Nov 20 16:13:02 2009 +0000
@@ -22,14 +22,6 @@
if String.startswith "eth" device
then ("xenbr" ^ (String.sub device 3 (String.length device - 3)))
else ("br" ^ device)
-
-let calculate_pifs_required_at_start_of_day ~__context =
- List.filter (fun (_,pifr) ->
- true
- && (pifr.API.pIF_host = !Xapi_globs.localhost_ref) (* this host only *)
- && not (Db.is_valid_ref pifr.API.pIF_bond_slave_of) (* not enslaved by a
bond *)
- )
- (Db.PIF.get_all_records ~__context)
let read_bridges_from_inventory () =
try String.split ' ' (Xapi_inventory.lookup
Xapi_inventory._current_interfaces) with _ -> []
@@ -149,7 +141,6 @@
~io_read_kbs:0. ~io_write_kbs:0. ~last_updated:(Date.of_float 0.)
~other_config:[] in
metrics
-(* Pool_introduce is an internal call used by pool-join to copy slave-to-be
pif records to pool master *)
let pool_introduce ~__context
~device ~network ~host ~mAC ~mTU ~vLAN ~physical ~ip_configuration_mode
~iP ~netmask ~gateway ~dNS ~bond_slave_of ~vLAN_master_of ~management
~other_config ~disallow_unplug =
@@ -165,11 +156,8 @@
let db_introduce = pool_introduce
-(* Perform a database delete on the master *)
let db_forget ~__context ~self = Db.PIF.destroy ~__context ~self
-(* This signals the monitor thread to tell it that it should write to the
database to sync it with the current
- dom0 networking config. *)
let mark_pif_as_dirty device vLAN =
Threadext.Mutex.execute Rrd_shared.mutex
(fun () ->
@@ -177,8 +165,7 @@
Condition.broadcast Rrd_shared.condition
)
-
-(* Internal 'introduce' is passed a pre-built table 't' *)
+(* Internal [introduce] is passed a pre-built table [t] *)
let introduce_internal ?network ?(physical=true) ~t ~__context ~host ~mAC ~mTU
~device ~vLAN ~vLAN_master_of () =
let is_vlan = vLAN >= 0L in
@@ -199,11 +186,12 @@
~ip_configuration_mode:`None ~iP:"" ~netmask:"" ~gateway:"" ~dNS:""
~bond_slave_of:Ref.null ~vLAN_master_of ~management:false ~other_config:[]
~disallow_unplug:false in
- (* If I'm a slave and this pif represents my management interface then
- leave it alone: if the interface goes down (through a call to "up" then
+ (* If I'm a pool slave and this pif represents my management interface then
+ leave it alone: if the interface goes down (through a call to "up") then
I loose my connection to the master's database and the call to "up"
(which uses the API and requires the database) blocks until the slave
restarts in emergency mode *)
+ (* Rob: nothing seems to be done with the pool slave case mentioned in this
comment...? *)
if is_my_management_pif ~__context ~self:pif then begin
debug "NIC is the management interface";
Db.PIF.set_management ~__context ~self:pif ~value:true;
@@ -220,7 +208,7 @@
(* return ref of newly created pif record *)
pif
-(* Internal 'forget' is passed a pre-built table 't' *)
+(* Internal [forget] is passed a pre-built table [t] *)
let forget_internal ~t ~__context ~self =
Nm.bring_pif_down ~__context self;
(* NB we are allowed to forget an interface which still exists *)
@@ -233,7 +221,6 @@
Db.PIF_metrics.destroy ~__context ~self:metrics with _ -> ());
Db.PIF.destroy ~__context ~self
-(* Look over all this host's PIFs and reset the management flag *)
let update_management_flags ~__context ~host =
let management_intf = Xapi_inventory.lookup
Xapi_inventory._management_interface in
let all_pifs = Db.PIF.get_all ~__context in
@@ -308,6 +295,7 @@
(* Dummy MAC used by the VLAN *)
let vlan_mac = "fe:ff:ff:ff:ff:ff"
+(* should be moved to Xapi_vlan.ml after removing create_VLAN and destroy *)
(* Used both externally and by PIF.create_VLAN *)
let vLAN_create ~__context ~tagged_PIF ~tag ~network =
let host = Db.PIF.get_host ~__context ~self:tagged_PIF in
@@ -340,6 +328,7 @@
let () = Db.VLAN.create ~__context ~ref:vlan ~uuid:vlan_uuid ~tagged_PIF
~untagged_PIF ~tag ~other_config:[] in
vlan
+(* DEPRECATED! *)
let create_VLAN ~__context ~device ~network ~host ~vLAN =
(* Find the "base PIF" (same device, no VLAN tag) *)
let other_pifs = Db.Host.get_PIFs ~__context ~self:host in
@@ -353,6 +342,7 @@
let vlan = vLAN_create ~__context ~tagged_PIF:base_pif ~tag:vLAN ~network in
Db.VLAN.get_untagged_PIF ~__context ~self:vlan
+(* DEPRECATED! But called by vLAN_destroy!! *)
let destroy ~__context ~self =
debug "PIF.destroy uuid = %s" (Db.PIF.get_uuid ~__context ~self);
assert_not_in_bond ~__context ~self;
@@ -378,6 +368,7 @@
Db.VLAN.destroy ~__context ~self:vlan with _ -> ());
Db.PIF.destroy ~__context ~self
+(* should be moved to Xapi_vlan.ml after removing create_VLAN and destroy *)
let vLAN_destroy ~__context ~self =
debug "VLAN.destroy uuid = %s" (Db.VLAN.get_uuid ~__context ~self);
let untagged_PIF = Db.VLAN.get_untagged_PIF ~__context ~self in
@@ -442,6 +433,14 @@
let network = Db.PIF.get_network ~__context ~self in
let host = Db.PIF.get_host ~__context ~self in
Xapi_network.attach ~__context ~network ~host
+
+let calculate_pifs_required_at_start_of_day ~__context =
+ List.filter (fun (_,pifr) ->
+ true
+ && (pifr.API.pIF_host = !Xapi_globs.localhost_ref) (* this host only *)
+ && not (Db.is_valid_ref pifr.API.pIF_bond_slave_of) (* not enslaved by a
bond *)
+ )
+ (Db.PIF.get_all_records ~__context)
let start_of_day_best_effort_bring_up() =
Server_helpers.exec_with_new_task "Bringing up physical PIFs"
@@ -453,3 +452,4 @@
plug ~__context ~self:pif) pif)
(calculate_pifs_required_at_start_of_day ~__context)
)
+
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_pif.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ocaml/xapi/xapi_pif.mli Fri Nov 20 16:13:02 2009 +0000
@@ -0,0 +1,199 @@
+(** Module that defines API functions for PIF objects *)
+
+(** {2 API functions} *)
+
+(** Create a new PIF record in the database only *)
+val db_introduce :
+ __context:Context.t ->
+ device:string ->
+ network:[ `network ] Ref.t ->
+ host:[ `host ] Ref.t ->
+ mAC:string ->
+ mTU:int64 ->
+ vLAN:int64 ->
+ physical:bool ->
+ ip_configuration_mode:[< `DHCP | `None | `Static ] ->
+ iP:string ->
+ netmask:string ->
+ gateway:string ->
+ dNS:string ->
+ bond_slave_of:'a ->
+ vLAN_master_of:[ `VLAN ] Ref.t ->
+ management:bool ->
+ other_config:(string * string) list ->
+ disallow_unplug:bool -> [ `PIF ] Ref.t
+
+(** Perform a database delete of the PIF record on the pool master. *)
+val db_forget : __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+
+(** Create a new PIF record for a new NIC *)
+val introduce :
+ __context:Context.t ->
+ host:[ `host ] Ref.t ->
+ mAC:string -> device:Rrd_shared.StringSet.elt -> API.ref_PIF
+
+(** Destroy the PIF record from the database, but only if the interface is no
longer used. *)
+val forget : __context:Context.t -> self:API.ref_PIF -> unit
+
+(** Scan for physical interfaces on this host and ensure PIF records, and
+ * corresponding networks are present and up-to-date. Uses
{!introduce_internal}. *)
+val scan : __context:Context.t -> host:[ `host ] Ref.t -> unit
+
+(** External facing call to create a new VLAN interface
+ * @deprecated since Miami; use [VLAN.create] instead *)
+val create_VLAN :
+ __context:Context.t ->
+ device:string ->
+ network:[ `network ] Ref.t ->
+ host:[ `host ] Ref.t -> vLAN:int64 -> [ `PIF ] Ref.t
+
+(** External facing call to destroy a VLAN or Bond interface
+ * @deprecated since Miami; use [VLAN.destroy] or [Bond.destroy] instead *)
+val destroy : __context:Context.t -> self:API.ref_PIF -> unit
+
+(** Change the IP configuration of a PIF *)
+val reconfigure_ip :
+ __context:Context.t ->
+ self:API.ref_PIF ->
+ mode:[< `DHCP | `None | `Static > `None `Static ] ->
+ iP:string -> netmask:string -> gateway:string -> dNS:string -> unit
+
+(** Attempt to bring down the PIF: disconnect the underlying network interface
from
+ * its bridge and disable the interface. *)
+val unplug : __context:Context.t -> self:API.ref_PIF -> unit
+
+(** Attempt to bring up the PIF: enable the network underlying interface and
attach the network
+ * (bridge) it is on. *)
+val plug : __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+
+
+(** {2 Miscellaneous Helper Functions} *)
+
+(** Constructs a bridge name from a device (network interface) name by
replacing
+ * [eth] by [xenbr], or prepending [br] if the device name does not start
with [eth].
+ *)
+val bridge_naming_convention : string -> string
+
+(** Return the list of bridges in the CURRENT_INTERFACES field in the
inventory file. *)
+val read_bridges_from_inventory : unit -> string list
+
+(** If a network for the given bridge already exists, then return a reference
to this network,
+ * otherwise create a new network and return its reference.
+ *)
+val find_or_create_network :
+ string -> string -> __context:Context.t -> [ `network ] Ref.t
+
+(** Compute the set difference a - b *)
+val set_difference : 'a list -> 'a list -> 'a list
+
+(** Convenient lookup tables for scanning etc *)
+type tables = {
+ mac_to_pif_table : (string * API.ref_PIF) list; (** MAC address to PIF
reference (all PIFs) *)
+ mac_to_phy_table : (string * string) list; (** MAC address to
physical-interface name (all physical interfaces) *)
+}
+
+(** Construct and return lookup {!tables} with information about the network
interfaces *)
+val make_tables : __context:Context.t -> host:[ `host ] Ref.t -> tables
+
+(** Return true if this PIF is my management interface, according to
xensource-inventory *)
+val is_my_management_pif : __context:Context.t -> self:[ `PIF ] Ref.t -> bool
+
+(** Make a new metrics objects and return reference to it *)
+val make_pif_metrics : __context:Context.t -> [ `PIF_metrics ] Ref.t
+
+(** Pool_introduce is an internal call used by pool-join to copy slave-to-be
pif records to pool master *)
+val pool_introduce :
+ __context:Context.t ->
+ device:string ->
+ network:[ `network ] Ref.t ->
+ host:[ `host ] Ref.t ->
+ mAC:string ->
+ mTU:int64 ->
+ vLAN:int64 ->
+ physical:bool ->
+ ip_configuration_mode:[< `DHCP | `None | `Static ] ->
+ iP:string ->
+ netmask:string ->
+ gateway:string ->
+ dNS:string ->
+ bond_slave_of:'a ->
+ vLAN_master_of:[ `VLAN ] Ref.t ->
+ management:bool ->
+ other_config:(string * string) list ->
+ disallow_unplug:bool -> [ `PIF ] Ref.t
+
+(** This signals the monitor thread to tell it that it should write to the
database
+ * to sync it with the current dom0 networking config. *)
+val mark_pif_as_dirty : Rrd_shared.StringSet.elt -> int64 -> unit
+
+(** Create a new PIF record with the given details. Also create a network for
the
+ * new PIF, or reuses an existing one if the name matches the convention
prescribed
+ * by the function {!bridge_naming_convention}. Also check whether the new PIF
+ * is to be the management PIF (according to {!is_my_management_pif}) and set
the
+ * flags accordingly. *)
+val introduce_internal :
+ ?network:[ `network ] Ref.t ->
+ ?physical:bool ->
+ t:tables ->
+ __context:Context.t ->
+ host:[ `host ] Ref.t ->
+ mAC:Rrd_shared.StringSet.elt ->
+ mTU:int64 ->
+ device:Rrd_shared.StringSet.elt ->
+ vLAN:int64 -> vLAN_master_of:[ `VLAN ] Ref.t -> unit -> [ `PIF ] Ref.t
+
+(** Brings down the network interface and removes the PIF object. *)
+val forget_internal :
+ t:tables -> __context:Context.t -> self:API.ref_PIF -> unit
+
+(** Look over all this host's PIFs and reset the management flag.
+ * The management interface is ultimately defined by the inventory file,
+ * which holds the bridge of the management interface in the
MANAGEMENT_INTERFACE field. *)
+val update_management_flags :
+ __context:Context.t -> host:[ `host ] Ref.t -> unit
+
+(** Set up a VLAN. Called via the VLAN.create API call.
+ * Should be moved to Xapi_vlan.ml after removing [create_VLAN] and
[destroy]. *)
+val vLAN_create :
+ __context:Context.t ->
+ tagged_PIF:[ `PIF ] Ref.t ->
+ tag:int64 -> network:[ `network ] Ref.t -> [ `VLAN ] Ref.t
+
+(** External facing call to destroy a VLAN mux/demuxer.
+ * Called via the VLAN.destroy API call.
+ * Should be moved to Xapi_vlan.ml after removing [create_VLAN] and
[destroy]. *)
+val vLAN_destroy : __context:Context.t -> self:[ `VLAN ] Ref.t -> unit
+
+(** Returns the set of PIF references + records which we want to be plugged in
by the end of the
+ start of day code. These are the PIFs on the localhost that are not bond
slaves.
+ For PIFs that have [disallow_unplug] set to true, and the management
interface, will
+ actually be brought up ahead of time by the init scripts, so we don't have
to plug them in.
+ These are written to the xensource-inventory file when HA is enabled so
that HA can bring up
+ interfaces required by storage NICs etc. (these interface are not filtered
out at the moment).
+ *)
+val calculate_pifs_required_at_start_of_day :
+ __context:'a -> ('b Ref.t * API.pIF_t) list
+
+(** Attempt to bring up (plug) the required PIFs when the host starts up.
+ * Uses {!calculate_pifs_required_at_start_of_day}. *)
+val start_of_day_best_effort_bring_up : unit -> unit
+
+
+(** {2 Assertion Helper Functions} *)
+
+val assert_not_in_bond : __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+val assert_no_vlans : __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+val assert_not_management_pif :
+ __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+val assert_not_slave_management_pif :
+ __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+val assert_no_protection_enabled :
+ __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+val abort_if_network_attached_to_protected_vms :
+ __context:Context.t -> self:[ `PIF ] Ref.t -> unit
+
+(** Ensure none of the PIFs on the given host are on the given network. *)
+val assert_no_other_local_pifs :
+ __context:Context.t ->
+ host:[ `host ] Ref.t -> network:[ `network ] Ref.t -> unit
+
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_vif.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ocaml/xapi/xapi_vif.mli Fri Nov 20 16:13:02 2009 +0000
@@ -0,0 +1,37 @@
+(** Module that defines API functions for VIF objects *)
+
+(** {2 API functions} *)
+
+(** Hotplug the VIF, dynamically attaching it to the running VM *)
+val plug : __context:Context.t -> self:API.ref_VIF -> unit
+
+(** Hot-unplug the VIF, dynamically unattaching it to the running VM *)
+val unplug : __context:Context.t -> self:API.ref_VIF -> unit
+
+(** Create a new VIF instance *)
+val create :
+ __context:Context.t ->
+ device:string ->
+ network:[ `network ] Ref.t ->
+ vM:[ `VM ] Ref.t ->
+ mAC:string ->
+ mTU:int64 ->
+ other_config:(string * string) list ->
+ qos_algorithm_type:string ->
+ qos_algorithm_params:(string * string) list -> API.ref_VIF
+
+(** Destroy the specified VIF instance *)
+val destroy : __context:Context.t -> self:[ `VIF ] Ref.t -> unit
+
+(** {2 Helper Functions} *)
+
+val assert_operation_valid :
+ __context:Context.t -> self:[ `VIF ] Ref.t -> op:API.vif_operations -> unit
+val update_allowed_operations :
+ __context:Context.t -> self:[ `VIF ] Ref.t -> unit
+val dynamic_create :
+ __context:Context.t -> vif:API.ref_VIF -> Locking_helpers.token -> unit
+val destroy_vif :
+ __context:Context.t -> xs:Xs.xsh -> 'a -> [ `VIF ] Ref.t -> 'b -> unit
+val dynamic_destroy :
+ __context:Context.t -> vif:[ `VIF ] Ref.t -> Locking_helpers.token -> unit
diff -r 7a31678e878c -r 2b994a4fda1e ocaml/xapi/xapi_vlan.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ocaml/xapi/xapi_vlan.mli Fri Nov 20 16:13:02 2009 +0000
@@ -0,0 +1,25 @@
+(*
+ * 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 that defines API functions for VLANs *)
+
+(** Create a VLAN with the given [tag] using the [tagged_PIF] as VLAN slave.
+ * Creates a new PIF object as VLAN master (untagged PIF) and connects it to
the
+ * given [network]. No other PIFs on the same host may be connected to this
network. *)
+val create :
+ __context:Context.t ->
+ tagged_PIF:[ `PIF ] Ref.t ->
+ tag:int64 -> network:[ `network ] Ref.t -> [ `VLAN ] Ref.t
+
+(** Destroy a VLAN. Removes the VLAN object as well as the VLAN master PIF. *)
+val destroy : __context:Context.t -> self:[ `VLAN ] Ref.t -> unit
18 files changed, 468 insertions(+), 119 deletions(-)
ocaml/doc/ocamldoc.js | 24 ++-
ocaml/doc/odoc_json.ml | 2
ocaml/doc/style.css | 71 ++++------
ocaml/netdev/netdev.ml | 1
ocaml/xapi/dbsync_slave.ml | 5
ocaml/xapi/helpers.ml | 1
ocaml/xapi/nm.ml | 10 -
ocaml/xapi/nm.mli | 11 +
ocaml/xapi/xapi_bond.ml | 3
ocaml/xapi/xapi_bond.mli | 28 ++++
ocaml/xapi/xapi_fist.ml | 55 +++++---
ocaml/xapi/xapi_network.ml | 17 --
ocaml/xapi/xapi_network.mli | 47 ++++++
ocaml/xapi/xapi_network_attach_helpers.ml | 15 ++
ocaml/xapi/xapi_pif.ml | 36 ++---
ocaml/xapi/xapi_pif.mli | 199 +++++++++++++++++++++++++++++
ocaml/xapi/xapi_vif.mli | 37 +++++
ocaml/xapi/xapi_vlan.mli | 25 +++
xen-api.hg-3.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home