# HG changeset patch # User Jonathan Knowles # Date 1265039945 0 # Node ID e61b811f0c2c0867257b8053649a4343b4bd5ea0 # Parent 79d00bde5fb4f7c1b175b52ff99c7830c6cd437f [PCR0047] Extending Ocamldoc and reformatting sections of code in line with our OCaml Best Practices Guide. Signed-off-by: Jonathan Knowles diff -r 79d00bde5fb4 -r e61b811f0c2c ocaml/license/restrictions.ml --- a/ocaml/license/restrictions.ml Mon Feb 01 15:59:04 2010 +0000 +++ b/ocaml/license/restrictions.ml Mon Feb 01 15:59:05 2010 +0000 @@ -25,95 +25,93 @@ x = Express let sku_of_string = function -| "XE Express" -> Express -| "XE Enterprise" -> Enterprise -| x -> failwith (Printf.sprintf "Unknown SKU type: '%s'" x) + | "XE Express" -> Express + | "XE Enterprise" -> Enterprise + | x -> failwith (Printf.sprintf "Unknown SKU type: '%s'" x) let string_of_sku = function -| Express -> "XE Express" -| Enterprise -> "XE Enterprise" + | Express -> "XE Express" + | Enterprise -> "XE Enterprise" -(* CA-26992: to avoid confusing the user with legacy SKU names we trivially obfuscate them *) +(** CA-26992: to avoid confusing the user with legacy SKU names we trivially obfuscate them *) let obfuscated_string_of_sku = function -| Express -> "RF" (*free*) -| Enterprise -> "RP" (*paid*) + | Express -> "RF" (*free*) + | Enterprise -> "RP" (*paid*) -(* The restrictions that are applied *) -type restrictions = - { - enable_vlans : bool; - enable_qos : bool; - enable_shared_storage : bool; - enable_netapp : bool; - enable_equalogic : bool; - enable_pooling : bool; - enable_xha: bool; - enable_mtc_pci: bool; - enable_email : bool; - enable_performance : bool; - enable_wlb : bool; - enable_rbac : bool; - restrict_connection : bool; - platform_filter : bool; - regular_nag_dialog : bool; - } +(** The restrictions that are applied *) +type restrictions = { + enable_vlans : bool; + enable_qos : bool; + enable_shared_storage : bool; + enable_netapp : bool; + enable_equalogic : bool; + enable_pooling : bool; + enable_xha: bool; + enable_mtc_pci: bool; + enable_email : bool; + enable_performance : bool; + enable_wlb : bool; + enable_rbac : bool; + restrict_connection : bool; + platform_filter : bool; + regular_nag_dialog : bool; +} -(* Used for printing compact host x restriction tables *) +(** Used for printing compact host x restriction tables *) let to_compact_string (x: restrictions) = - (if x.enable_vlans then "VLAN " else " ") ^ - (if x.enable_qos then "QoS " else " ") ^ - (if x.enable_shared_storage then "SStorage " else " ") ^ - (if x.enable_netapp then "NTAP " else " ") ^ - (if x.enable_equalogic then "EQL " else " ") ^ - (if x.enable_pooling then "Pool " else " ") ^ - (if x.enable_xha then "XHA " else " ") ^ - (if x.enable_mtc_pci then "MTC " else " ") ^ - (if x.enable_email then "email " else " ") ^ - (if x.enable_performance then "perf " else " ") ^ - (if x.enable_wlb then "WLB " else " ") ^ - (if x.enable_rbac then "RBAC " else " ") ^ - (if x.restrict_connection then " " else "Cnx ") ^ - (if x.platform_filter then " " else "Plat ") ^ - (if x.regular_nag_dialog then " nag " else " ") + (if x.enable_vlans then "VLAN " else " " ) ^ + (if x.enable_qos then "QoS " else " " ) ^ + (if x.enable_shared_storage then "SStorage " else " ") ^ + (if x.enable_netapp then "NTAP " else " " ) ^ + (if x.enable_equalogic then "EQL " else " " ) ^ + (if x.enable_pooling then "Pool " else " " ) ^ + (if x.enable_xha then "XHA " else " " ) ^ + (if x.enable_mtc_pci then "MTC " else " " ) ^ + (if x.enable_email then "email " else " " ) ^ + (if x.enable_performance then "perf " else " " ) ^ + (if x.enable_wlb then "WLB " else " " ) ^ + (if x.enable_rbac then "RBAC " else " " ) ^ + (if x.restrict_connection then " " else "Cnx " ) ^ + (if x.platform_filter then " " else "Plat " ) ^ + (if x.regular_nag_dialog then " nag " else " " ) -(* Represents no restrictions at all *) -let most_permissive = - { - enable_vlans = true; - enable_qos = true; - enable_shared_storage = true; - enable_netapp = true; - enable_equalogic = true; - enable_pooling = true; - enable_xha = true; - enable_mtc_pci = true; - enable_email = true; - enable_performance = true; - enable_wlb = true; - enable_rbac = true; - restrict_connection = false; - platform_filter = false; - regular_nag_dialog = false; - } +(** Represents no restrictions at all *) +let most_permissive = { + enable_vlans = true; + enable_qos = true; + enable_shared_storage = true; + enable_netapp = true; + enable_equalogic = true; + enable_pooling = true; + enable_xha = true; + enable_mtc_pci = true; + enable_email = true; + enable_performance = true; + enable_wlb = true; + enable_rbac = true; + restrict_connection = false; + platform_filter = false; + regular_nag_dialog = false; +} -(* Return a new restrictions record which, for each field, takes the least permissive of the two arguments *) -let least_permissive (a: restrictions) (b: restrictions) = -{ - enable_vlans = a.enable_vlans && b.enable_vlans; - enable_qos = a.enable_qos && b.enable_qos; - enable_shared_storage = a.enable_shared_storage && b.enable_shared_storage; - enable_netapp = a.enable_netapp && b.enable_netapp; - enable_equalogic = a.enable_equalogic && b.enable_equalogic; - enable_pooling = a.enable_pooling && b.enable_pooling; - enable_xha = a.enable_xha && b.enable_xha; - enable_mtc_pci = a.enable_mtc_pci && b.enable_mtc_pci; - enable_email = a.enable_email && b.enable_email; - enable_performance = a.enable_performance && b.enable_performance; - enable_wlb = a.enable_wlb && b.enable_wlb; - enable_rbac = a.enable_rbac && b.enable_rbac; - restrict_connection = a.restrict_connection || b.restrict_connection; - platform_filter = a.platform_filter || b.platform_filter; - regular_nag_dialog = a.regular_nag_dialog || b.regular_nag_dialog; +(** Return a new restrictions record which, for each field, takes the least + * permissive of the two arguments *) +let least_permissive (a: restrictions) (b: restrictions) = { + enable_vlans = a.enable_vlans && b.enable_vlans; + enable_qos = a.enable_qos && b.enable_qos; + enable_shared_storage = a.enable_shared_storage && b.enable_shared_storage; + enable_netapp = a.enable_netapp && b.enable_netapp; + enable_equalogic = a.enable_equalogic && b.enable_equalogic; + enable_pooling = a.enable_pooling && b.enable_pooling; + enable_xha = a.enable_xha && b.enable_xha; + enable_mtc_pci = a.enable_mtc_pci && b.enable_mtc_pci; + enable_email = a.enable_email && b.enable_email; + enable_performance = a.enable_performance && b.enable_performance; + enable_wlb = a.enable_wlb && b.enable_wlb; + enable_rbac = a.enable_rbac && b.enable_rbac; + restrict_connection = a.restrict_connection || b.restrict_connection; + platform_filter = a.platform_filter || b.platform_filter; + regular_nag_dialog = a.regular_nag_dialog || b.regular_nag_dialog; } let pool_restrictions_of_list (hosts: restrictions list) = List.fold_left least_permissive most_permissive hosts @@ -141,111 +139,112 @@ let _restrict_rbac = "restrict_rbac" let _regular_nag_dialog = "regular_nag_dialog" -let to_assoc_list (x: restrictions) = - [ (_restrict_connection,string_of_bool x.restrict_connection); - (_restrict_pooling,string_of_bool (not x.enable_pooling)); - (_restrict_qos,string_of_bool (not x.enable_qos)); - (_restrict_pool_attached_storage,string_of_bool (not x.enable_shared_storage)); - (_restrict_netapp, string_of_bool (not x.enable_netapp)); - (_restrict_equalogic, string_of_bool (not x.enable_equalogic)); - (_restrict_vlan,string_of_bool (not x.enable_vlans)); - (_enable_xha, string_of_bool (x.enable_xha)); - (_restrict_marathon, string_of_bool (not x.enable_mtc_pci)); - (_platform_filter, string_of_bool x.platform_filter); - (_restrict_email_alerting, string_of_bool (not x.enable_email)); - (_restrict_historical_performance, string_of_bool (not x.enable_performance)); - (_restrict_wlb, string_of_bool (not x.enable_wlb)); - (_restrict_rbac, string_of_bool (not x.enable_rbac)); - (_regular_nag_dialog, string_of_bool x.regular_nag_dialog); - ] +let to_assoc_list (x: restrictions) = [ + (_restrict_connection, string_of_bool ( x.restrict_connection )); + (_restrict_pooling, string_of_bool (not x.enable_pooling )); + (_restrict_qos, string_of_bool (not x.enable_qos )); + (_restrict_pool_attached_storage, string_of_bool (not x.enable_shared_storage)); + (_restrict_netapp, string_of_bool (not x.enable_netapp )); + (_restrict_equalogic, string_of_bool (not x.enable_equalogic )); + (_restrict_vlan, string_of_bool (not x.enable_vlans )); + (_enable_xha, string_of_bool ( x.enable_xha )); + (_restrict_marathon, string_of_bool (not x.enable_mtc_pci )); + (_platform_filter, string_of_bool ( x.platform_filter )); + (_restrict_email_alerting, string_of_bool (not x.enable_email )); + (_restrict_historical_performance, string_of_bool (not x.enable_performance )); + (_restrict_wlb, string_of_bool (not x.enable_wlb )); + (_restrict_rbac, string_of_bool (not x.enable_rbac )); + (_regular_nag_dialog, string_of_bool ( x.regular_nag_dialog )); +] -(* Read an association list possibly generated by a slave running a previous version and hence possibly - missing some values. In the case where a value is missing we default to the most_permissive. *) +(** Read an association list possibly generated by a slave running a previous + * version and hence possibly missing some values. In the case where a value + * is missing we default to the most_permissive. *) let of_assoc_list x = - let find fn key = if List.mem_assoc key x then Some (fn (List.assoc key x)) else None in - { - enable_vlans = Opt.default most_permissive.enable_vlans (Opt.map not (find bool_of_string _restrict_vlan)); - enable_qos = Opt.default most_permissive.enable_qos (Opt.map not (find bool_of_string _restrict_qos)); - enable_shared_storage = Opt.default most_permissive.enable_shared_storage (Opt.map not (find bool_of_string _restrict_pool_attached_storage)); - enable_netapp = Opt.default most_permissive.enable_netapp (Opt.map not (find bool_of_string _restrict_netapp)); - enable_equalogic = Opt.default most_permissive.enable_equalogic (Opt.map not (find bool_of_string _restrict_equalogic)); - enable_pooling = Opt.default most_permissive.enable_pooling (Opt.map not (find bool_of_string _restrict_pooling)); - enable_xha = Opt.default most_permissive.enable_xha (find bool_of_string _enable_xha); - enable_mtc_pci = Opt.default most_permissive.enable_mtc_pci (Opt.map not (find bool_of_string _restrict_marathon)); - restrict_connection = Opt.default most_permissive.restrict_connection (find bool_of_string _restrict_connection); - platform_filter = Opt.default most_permissive.platform_filter (find bool_of_string _platform_filter); - enable_email = Opt.default most_permissive.enable_email (Opt.map not (find bool_of_string _restrict_email_alerting)); - enable_performance = Opt.default most_permissive.enable_performance (Opt.map not (find bool_of_string _restrict_historical_performance)); - enable_wlb = Opt.default most_permissive.enable_wlb (Opt.map not (find bool_of_string _restrict_wlb)); - enable_rbac = Opt.default most_permissive.enable_rbac (Opt.map not (find bool_of_string _restrict_rbac)); - regular_nag_dialog = Opt.default most_permissive.regular_nag_dialog (find bool_of_string _regular_nag_dialog); - } + let find fn key = if List.mem_assoc key x then Some (fn (List.assoc key x)) else None in + { + enable_vlans = Opt.default most_permissive.enable_vlans (Opt.map not (find bool_of_string _restrict_vlan)); + enable_qos = Opt.default most_permissive.enable_qos (Opt.map not (find bool_of_string _restrict_qos)); + enable_shared_storage = Opt.default most_permissive.enable_shared_storage (Opt.map not (find bool_of_string _restrict_pool_attached_storage)); + enable_netapp = Opt.default most_permissive.enable_netapp (Opt.map not (find bool_of_string _restrict_netapp)); + enable_equalogic = Opt.default most_permissive.enable_equalogic (Opt.map not (find bool_of_string _restrict_equalogic)); + enable_pooling = Opt.default most_permissive.enable_pooling (Opt.map not (find bool_of_string _restrict_pooling)); + enable_xha = Opt.default most_permissive.enable_xha (find bool_of_string _enable_xha); + enable_mtc_pci = Opt.default most_permissive.enable_mtc_pci (Opt.map not (find bool_of_string _restrict_marathon)); + restrict_connection = Opt.default most_permissive.restrict_connection (find bool_of_string _restrict_connection); + platform_filter = Opt.default most_permissive.platform_filter (find bool_of_string _platform_filter); + enable_email = Opt.default most_permissive.enable_email (Opt.map not (find bool_of_string _restrict_email_alerting)); + enable_performance = Opt.default most_permissive.enable_performance (Opt.map not (find bool_of_string _restrict_historical_performance)); + enable_wlb = Opt.default most_permissive.enable_wlb (Opt.map not (find bool_of_string _restrict_wlb)); + enable_rbac = Opt.default most_permissive.enable_rbac (Opt.map not (find bool_of_string _restrict_rbac)); + regular_nag_dialog = Opt.default most_permissive.regular_nag_dialog (find bool_of_string _regular_nag_dialog); + } - -(* Encodes the minimum set of restrictions available in all SKUs (ie FG-Free and FG-PaidFor) *) -let common_to_all_skus = - { - enable_vlans = true; - enable_qos = true; - enable_shared_storage = true; - enable_netapp = false; - enable_equalogic = false; - enable_pooling = true; - enable_xha = false; - enable_mtc_pci = true; - restrict_connection = false; - platform_filter = true; - enable_email = false; - enable_performance = false; - enable_wlb = false; - enable_rbac = false; - regular_nag_dialog = true; - } +(** Encodes the minimum set of restrictions available in all SKUs (ie FG-Free + * and FG-PaidFor) *) +let common_to_all_skus = { + enable_vlans = true; + enable_qos = true; + enable_shared_storage = true; + enable_netapp = false; + enable_equalogic = false; + enable_pooling = true; + enable_xha = false; + enable_mtc_pci = true; + restrict_connection = false; + platform_filter = true; + enable_email = false; + enable_performance = false; + enable_wlb = false; + enable_rbac = false; + regular_nag_dialog = true; +} let get_sku () = sku_of_string !License.license.License.sku let get_sku_from_license l = sku_of_string l.sku let rec restrictions_of_sku = function -| Express -> common_to_all_skus -| Enterprise -> - { - common_to_all_skus with - enable_xha = true; - platform_filter = false; - enable_netapp = true; - enable_equalogic = true; - enable_email = true; - enable_performance = true; - enable_wlb = true; - enable_rbac = true; - regular_nag_dialog = false; - } + | Express -> common_to_all_skus + | Enterprise -> + { + common_to_all_skus with + enable_xha = true; + platform_filter = false; + enable_netapp = true; + enable_equalogic = true; + enable_email = true; + enable_performance = true; + enable_wlb = true; + enable_rbac = true; + regular_nag_dialog = false; + } let get () = - restrictions_of_sku (get_sku ()) + restrictions_of_sku (get_sku ()) -(* Cache of pool restrictions, always updated at least once when the master reads its license *) +(** Cache of pool restrictions, always updated at least once when the master + * reads its license *) let pool_restrictions = ref most_permissive let pool_restrictions_m = Mutex.create () let get_pool () = Mutex.execute pool_restrictions_m (fun () -> !pool_restrictions) -let update_pool_restrictions ~__context = - Mutex.execute pool_restrictions_m - (fun () -> - let hosts = List.map (fun (_, host_r) -> host_r.API.host_license_params) (Db.Host.get_all_records ~__context) in - let new_restrictions = pool_restrictions_of_list (List.map of_assoc_list hosts) in - if new_restrictions <> !pool_restrictions then begin - info "Old pool restrictions: %s" (to_compact_string !pool_restrictions); - info "New pool restrictions: %s" (to_compact_string new_restrictions); - pool_restrictions := new_restrictions - end - ) +let update_pool_restrictions ~__context = Mutex.execute pool_restrictions_m + (fun () -> + let hosts = List.map + (fun (_, host_r) -> host_r.API.host_license_params) + (Db.Host.get_all_records ~__context) in + let new_restrictions = + pool_restrictions_of_list (List.map of_assoc_list hosts) in + if new_restrictions <> !pool_restrictions then begin + info "Old pool restrictions: %s" (to_compact_string !pool_restrictions); + info "New pool restrictions: %s" (to_compact_string new_restrictions); + pool_restrictions := new_restrictions + end) let license_ok_for_wlb ~__context = - (get_pool()).enable_wlb + (get_pool()).enable_wlb let license_ok_for_rbac ~__context = - (get_pool()).enable_rbac - + (get_pool()).enable_rbac diff -r 79d00bde5fb4 -r e61b811f0c2c ocaml/license/restrictions.mli --- a/ocaml/license/restrictions.mli Mon Feb 01 15:59:04 2010 +0000 +++ b/ocaml/license/restrictions.mli Mon Feb 01 15:59:05 2010 +0000 @@ -33,21 +33,21 @@ (** Holding the flags that control which features are enabled or not. *) type restrictions = { - enable_vlans : bool; (** not used anymore *) - enable_qos : bool; (** not used anymore *) - enable_shared_storage : bool; (** not used anymore; perhaps XenCenter does? *) - enable_netapp : bool; (** used by XenCenter? *) - enable_equalogic : bool; (** used by XenCenter? *) - enable_pooling : bool; (** not used anymore *) - enable_xha : bool; (** enable High Availability (HA) *) - enable_mtc_pci : bool; (** not used anymore *) - enable_email : bool; (** enable email alerting *) - enable_performance : bool; (** used by XenCenter? *) - enable_wlb : bool; (** enable Workload Balancing (WLB) *) - enable_rbac : bool; (** enable Role-Based Access Control (RBAC) *) - restrict_connection : bool; (** not used anymore; perhaps XenCenter does? *) - platform_filter : bool; (** filter platform data on domain create? *) - regular_nag_dialog : bool; (** used by XenCenter *) + enable_vlans : bool; (** not used anymore *) + enable_qos : bool; (** not used anymore *) + enable_shared_storage : bool; (** not used anymore; perhaps XenCenter does? *) + enable_netapp : bool; (** used by XenCenter? *) + enable_equalogic : bool; (** used by XenCenter? *) + enable_pooling : bool; (** not used anymore *) + enable_xha : bool; (** enable High Availability (HA) *) + enable_mtc_pci : bool; (** not used anymore *) + enable_email : bool; (** enable email alerting *) + enable_performance : bool; (** used by XenCenter? *) + enable_wlb : bool; (** enable Workload Balancing (WLB) *) + enable_rbac : bool; (** enable Role-Based Access Control (RBAC) *) + restrict_connection : bool; (** not used anymore; perhaps XenCenter does? *) + platform_filter : bool; (** filter platform data on domain create? *) + regular_nag_dialog : bool; (** used by XenCenter *) } (** Returns a compact list of the current restrictions. *)