Skip to content

Commit

Permalink
Merge pull request xapi-project#1348 from mcclurmc/pr1510-clearwater-lcm
Browse files Browse the repository at this point in the history
CLEARWATER-LCM: PR-1510 LACP XenAPI Improvements
  • Loading branch information
robhoes committed Sep 5, 2013
2 parents 296108f + 0acbcb3 commit 241bb6b
Show file tree
Hide file tree
Showing 3 changed files with 84 additions and 32 deletions.
57 changes: 43 additions & 14 deletions ocaml/network/network_utils.ml
Expand Up @@ -689,51 +689,80 @@ module Ovs = struct
vsctl ~log:true ["port-to-br"; name]

let make_bond_properties name properties =
let known_props = ["mode"; "hashing-algorithm"; "updelay"; "downdelay"; "miimon"; "use_carrier"; "rebalance-interval"] in
let known_props = ["mode"; "hashing-algorithm"; "updelay"; "downdelay";
"miimon"; "use_carrier"; "rebalance-interval";
"lacp-time"; "lacp-aggregation-key"] in
let mode_args =
let mode = if List.mem_assoc "mode" properties then List.assoc "mode" properties else "balance-slb" in
let halgo = if List.mem_assoc "hashing-algorithm" properties then List.assoc "hashing-algorithm" properties else "" in
let mode = if List.mem_assoc "mode" properties
then List.assoc "mode" properties else "balance-slb" in
let halgo = if List.mem_assoc "hashing-algorithm" properties
then List.assoc "hashing-algorithm" properties else "" in
if mode = "lacp" then "lacp=active" ::
(if halgo = "src_mac" then ["bond_mode=balance-slb"]
else if halgo = "tcpudp_ports" then ["bond_mode=balance-tcp"]
else begin
debug "bond %s has invalid bond-hashing-algorithm '%s'; defaulting to balance-tcp" name halgo;
debug "bond %s has invalid bond-hashing-algorithm '%s'; defaulting to balance-tcp"
name halgo;
["bond_mode=balance-tcp"]
end)
else
["lacp=off"; "bond_mode=" ^ mode]
in
let get_prop (prop, ovs_key) =
(* "legacy" converter for bond properties *)
let get_prop_legacy (prop, ovs_key) =
if List.mem_assoc prop properties then
let value = List.assoc prop properties in
let value' = try int_of_string value with _ -> -1 in
if value' < 0 then begin
debug "bond %s has invalid %s '%s'" name prop value;
debug "bond %s has invalid %s '%s'\n" name prop value;
[]
end else if prop = "use_carrier" then
[ovs_key ^ "=" ^ (if value' > 0 then "carrier" else "miimon")]
else
[ovs_key ^ "=" ^ (string_of_int value')]
else
[]
and get_prop (prop, ovs_key) =
if List.mem_assoc prop properties
then let value = List.assoc prop properties in
[ovs_key ^ "=\"" ^ value ^ "\""]
else []
in
let extra_args = List.flatten (List.map get_prop ["updelay", "bond_updelay"; "downdelay", "bond_downdelay";
"miimon", "other-config:bond-miimon-interval"; "use_carrier", "other-config:bond-detect-mode";
"rebalance-interval", "other-config:bond-rebalance-interval"]) in
let other_args = List.filter_map (fun (k, v) ->
(* Don't add new properties here, these use the legacy converter *)
let extra_args_legacy = List.flatten (List.map get_prop_legacy
["updelay", "bond_updelay"; "downdelay", "bond_downdelay";
"miimon", "other-config:bond-miimon-interval";
"use_carrier", "other-config:bond-detect-mode";
"rebalance-interval", "other-config:bond-rebalance-interval";])
and extra_args = List.flatten (List.map get_prop
["lacp-time", "other-config:lacp-time";])
and per_iface_args = List.flatten (List.map get_prop
["lacp-aggregation-key", "other-config:lacp-aggregation-key";
"lacp-actor-key", "other-config:lacp-actor-key";])
and other_args = List.filter_map (fun (k, v) ->
if List.mem k known_props then None
else Some (Printf.sprintf "other-config:\"%s\"=\"%s\"" (String.escaped ("bond-" ^ k)) (String.escaped v))
else Some (Printf.sprintf "other-config:\"%s\"=\"%s\""
(String.escaped ("bond-" ^ k)) (String.escaped v))
) properties in
mode_args @ extra_args @ other_args
(mode_args @ extra_args_legacy @ extra_args @ other_args, per_iface_args)

let create_bond ?mac name interfaces bridge properties =
let args = make_bond_properties name properties in
let args, per_iface_args = make_bond_properties name properties in
let mac_args = match mac with
| None -> []
| Some mac -> ["--"; "set"; "port"; name; "MAC=\"" ^ (String.escaped mac) ^ "\""]
in
let per_iface_args =
if per_iface_args = []
then []
else List.flatten
(List.map
(fun iface ->
["--"; "set"; "interface"; iface ] @ per_iface_args)
interfaces)
in
vsctl ~log:true (["--"; "--may-exist"; "add-bond"; bridge; name] @ interfaces @
mac_args @ args)
mac_args @ args @ per_iface_args)

let get_fail_mode bridge =
vsctl ["get-fail-mode"; bridge]
Expand Down
27 changes: 18 additions & 9 deletions ocaml/xapi/nm.ml
Expand Up @@ -125,17 +125,24 @@ let create_bond ~__context bond mtu persistent =

(* set bond properties *)
let props =
let rec get_prop p =
if List.mem_assoc p props
then List.assoc p props
else ""
and get_prop_assoc_if_mode m p = if mode = m
then if List.mem_assoc p props
then [ p, List.assoc p props ]
else []
else []
in

if List.length slaves > 1 then
let hashing_algorithm =
if List.mem_assoc "hashing_algorithm" props then
List.assoc "hashing_algorithm" props
else
""
in
let rebalance_interval =
if mode = `lacp
let hashing_algorithm = get_prop "hashing_algorithm"
and rebalance_interval = if mode = `lacp
then []
else ["rebalance-interval", "1800000"]
and lacp_timeout = get_prop_assoc_if_mode `lacp "lacp-time"
and lacp_aggregation_key = get_prop_assoc_if_mode `lacp "lacp-aggregation-key"
in
let props = [
"mode", Record_util.bond_mode_to_string mode;
Expand All @@ -144,7 +151,9 @@ let create_bond ~__context bond mtu persistent =
"updelay", "31000";
"use_carrier", "1";
"hashing-algorithm", hashing_algorithm;
] @ rebalance_interval in
] @ rebalance_interval
@ lacp_timeout
@ lacp_aggregation_key in
let overrides = List.filter_map (fun (k, v) ->
if String.startswith "bond-" k then
Some ((String.sub_to_end k 5), v)
Expand Down
32 changes: 23 additions & 9 deletions ocaml/xapi/xapi_bond.ml
Expand Up @@ -226,18 +226,28 @@ let with_local_lock f = Mutex.execute local_m f
type requirement =
{
name:string;
default_value:string;
default_value:string option;
is_valid_value:string -> bool;
}

let requirements_of_mode = function
| `lacp -> [
{
name = "hashing_algorithm";
default_value = "tcpudp_ports";
is_valid_value = (fun str -> List.mem str ["src_mac"; "tcpudp_ports"]);
};
]
{
name = "hashing_algorithm";
default_value = Some "tcpudp_ports";
is_valid_value = (fun str -> List.mem str ["src_mac"; "tcpudp_ports"]);
};
{
name = "lacp-time";
default_value = Some "slow";
is_valid_value = (fun str -> List.mem str ["fast"; "slow"]);
};
{
name = "lacp-aggregation-key";
default_value = None;
is_valid_value = (fun i -> try ignore (int_of_string i); true with _ -> false);
};
]
| _ -> []

(* Validate a key-value pair against a list of property requirements. *)
Expand Down Expand Up @@ -265,8 +275,12 @@ let add_defaults requirements properties =
in
List.fold_left
(fun acc requirement ->
if property_is_present requirement then acc
else (requirement.name, requirement.default_value)::acc)
if property_is_present requirement
then acc
else match requirement.default_value with
| None -> acc
| Some default_value ->
(requirement.name, default_value)::acc)
properties requirements

let create ~__context ~network ~members ~mAC ~mode ~properties =
Expand Down

0 comments on commit 241bb6b

Please sign in to comment.