# HG changeset patch # User Rob Hoes # Date 1258733582 0 # Node ID 2b994a4fda1ef278a1291562f9867b360862ac8f # Parent 7a31678e878cef08b4d5b53b64ef72bbb5b08a05 [ocamldoc] Added docs for networking modules Signed-off-by: Rob Hoes 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 += '
'; if (v.info.description != undefined) - html += v.info.description + '
'; + html += transform_links(v.info.description) + ''; else html += 'to be completed!'; @@ -192,7 +192,7 @@ html += '
' + name + '
'; html += '
'; if (v.info.description != undefined) - html += v.info.description + '
'; + html += transform_links(v.info.description) + ''; else html += 'to be completed!'; html += ''; @@ -216,7 +216,7 @@ html += '' html += '' if (cons[c].description != undefined) - html += ''; + html += ''; else html += ''; html += ''; @@ -234,7 +234,7 @@ html += '' html += '' if (fields[c].description != undefined) - html += ''; + html += ''; else html += ''; html += ''; @@ -253,7 +253,7 @@ html += '
' + name + '
'; html += '
'; if (v.info.description != undefined) - html += v.info.description + '
'; + html += transform_links(v.info.description) + ''; else html += 'to be completed!'; if (v.kind.type == 'variant') @@ -276,7 +276,7 @@ html += '
' + name + '
'; html += '
'; if (v.info.description != undefined) - html += v.info.description + '
'; + html += transform_links(v.info.description) + ''; else html += 'to be completed!'; if (v.kind.type == 'variant') @@ -299,7 +299,7 @@ html += '
' + name + '
'; html += '
'; if (v.info.description != undefined) - html += v.info.description + '
'; + html += transform_links(v.info.description) + ''; else html += 'to be completed!'; html += '
' + cons[c].name + '' + cons[c].type + '' + cons[c].description + '' + transform_links(cons[c].description) + 'to be completed!
' + fields[c].name + '' + fields[c].type + '' + fields[c].description + '' + transform_links(fields[c].description) + 'to be completed!
'; @@ -313,7 +313,7 @@ function comment(m) { - append_content('
' + m + '
'); + append_content('
' + transform_links(m) + '
'); } function parse_structure(structure) @@ -460,8 +460,12 @@ modules = component_modules[component]; for (j in modules) { html += '\n'; - if (modules[j].description != "") - html += '\n'; + if (modules[j].description != "") { + d = modules[j].description; + if ((i = d.indexOf('.')) > -1) + d = d.substr(0, i); + html += '\n'; + } else html += ''; } 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 "" 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
' + modules[j].name + '' + modules[j].description + '
' + d + '.
to be completed!