# HG changeset patch
# User Jonathan Knowles <jonathan.knowles@xxxxxxxxxxxxx>
# 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 <jonathan.knowles@xxxxxxxxxxxxx>
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. *)
2 files changed, 181 insertions(+), 182 deletions(-)
ocaml/license/restrictions.ml | 333 +++++++++++++++++++---------------------
ocaml/license/restrictions.mli | 30 +--
xen-api.hg-12.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home