# HG changeset patch # User Rob Hoes # Date 1294419412 0 # Node ID c1100dd68e16dae897e796633d90688063cd62fd # Parent 7b6fef2813f75a20b5eb877aad11e9657bc38f97 Use pool.restrictions to define which features are enabled Signed-off-by: Rob Hoes diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/idl/ocaml_backend/OMakefile --- a/ocaml/idl/ocaml_backend/OMakefile +++ b/ocaml/idl/ocaml_backend/OMakefile @@ -112,6 +112,7 @@ ../../util/util_inventory \ ../../util/version \ ../../xapi/xapi_inventory \ + ../../xapi/features \ ../../license/v6rpc \ ../../license/v6daemon \ $(COMMON_OBJS) \ diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/license/features.ml --- a/ocaml/license/features.ml +++ /dev/null @@ -1,137 +0,0 @@ -(* (C) 2006-2010 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. - *) - -open Listext -module D = Debug.Debugger(struct let name="license" end) -open D - -(* Features and restrictions *) - -type feature = - | VLAN - | QoS - | Shared_storage - | Netapp - | Equalogic - | Pooling - | HA - | Marathon - | Email - | Performance - | WLB - | RBAC - | DMC - | Checkpoint - | Vswitch_controller - | CPU_masking - | Connection - | No_platform_filter - | No_nag_dialog - | VMPR - -type orientation = Positive | Negative - -let keys_of_features = - [ - VLAN, ("restrict_vlan", Negative, "VLAN"); - QoS, ("restrict_qos", Negative, "QoS"); - Shared_storage, ("restrict_pool_attached_storage", Negative, "SStorage"); - Netapp, ("restrict_netapp", Negative, "NTAP"); - Equalogic, ("restrict_equalogic", Negative, "EQL"); - Pooling, ("restrict_pooling", Negative, "Pool"); - HA, ("enable_xha", Positive, "XHA"); - Marathon, ("restrict_marathon", Negative, "MTC"); - Email, ("restrict_email_alerting", Negative, "email"); - Performance, ("restrict_historical_performance", Negative, "perf"); - WLB, ("restrict_wlb", Negative, "WLB"); - RBAC, ("restrict_rbac", Negative, "RBAC"); - DMC, ("restrict_dmc", Negative, "DMC"); - Checkpoint, ("restrict_checkpoint", Negative, "chpt"); - Vswitch_controller, ("restrict_vswitch_controller", Negative, "DVSC"); - CPU_masking, ("restrict_cpu_masking", Negative, "Mask"); - Connection, ("restrict_connection", Negative, "Cnx"); - No_platform_filter, ("platform_filter", Negative, "Plat"); - No_nag_dialog, ("regular_nag_dialog", Negative, "nonag"); - VMPR, ("restrict_vmpr", Negative, "VMPR"); - ] - -let string_of_feature f = - let str, o, _ = List.assoc f keys_of_features in - str, o - -let feature_of_string str = - let f, (_, o, _) = List.find (fun (_, (k, _, _)) -> str = k) keys_of_features in - f, o - -let tag_of_feature f = - let _, _, tag = List.assoc f keys_of_features in - tag - -let all_features = - List.map (fun (f, _) -> f) keys_of_features - -let to_compact_string (s: feature list) = - let get_tag f = - let tag = tag_of_feature f in - if List.mem f s then - tag - else - String.make (String.length tag) ' ' - in - let tags = List.map get_tag all_features in - String.concat " " tags - -let to_assoc_list (s: feature list) = - let get_map f = - let str, o = string_of_feature f in - let switch = List.mem f s in - let switch = string_of_bool (if o = Positive then switch else not switch) in - str, switch - in - List.map get_map all_features - -let of_assoc_list l = - let get_feature (k, v) = - try - let v = bool_of_string v in - let f, o = feature_of_string k in - let v = if o = Positive then v else not v in - if v then Some f else None - with _ -> - None - in - let features = List.map get_feature l in - List.fold_left (function ac -> function Some f -> f :: ac | None -> ac) [] features - -let pool_features_of_list hosts = - List.fold_left List.intersect all_features hosts - -let get_pool_features ~__context = - let pool = List.hd (Db.Pool.get_all ~__context) in - of_assoc_list (Db.Pool.get_restrictions ~__context ~self:pool) - -let is_enabled ~__context f = - let pool_features = get_pool_features ~__context in - List.mem f pool_features - -let update_pool_features ~__context = - let pool = List.hd (Db.Pool.get_all ~__context) in - let pool_features = get_pool_features ~__context in - let hosts = List.map (fun (_, host_r) -> host_r.API.host_license_params) (Db.Host.get_all_records ~__context) in - let new_features = pool_features_of_list (List.map of_assoc_list hosts) in - if new_features <> pool_features then begin - info "Old pool features enabled: %s" (to_compact_string pool_features); - info "New pool features enabled: %s" (to_compact_string new_features); - Db.Pool.set_restrictions ~__context ~self:pool ~value:(to_assoc_list new_features) - end - diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/license/features.mli --- a/ocaml/license/features.mli +++ /dev/null @@ -1,57 +0,0 @@ -(* - * 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 controls feature restriction. - * @group Licensing - *) - -(** Features than can be enabled and disabled. *) -type feature = - | VLAN (** Enable VLAN. Currently not used. *) - | QoS (** Enable QoS control. Currently not used. *) - | Shared_storage (** Enable shared storage. Currently not used? *) - | Netapp (** Enable use of NetApp SRs *) - | Equalogic (** Enable use of Equalogic SRs *) - | Pooling (** Enable pooling of hosts *) - | HA (** Enable High Availability (HA) *) - | Marathon (** Currently not used *) - | Email (** Enable email alerting *) - | Performance (** Currently not used? *) - | WLB (** Enable Workload Balancing (WLB) *) - | RBAC (** Enable Role-Based Access Control (RBAC) *) - | DMC (** Enable Dynamic Memory Control (DMC) *) - | Checkpoint (** Enable Checkpoint functionality *) - | Vswitch_controller (** Enable use of a Distributed VSwitch (DVS) Controller *) - | CPU_masking (** Enable masking of CPU features *) - | Connection (** Used by XenCenter *) - | No_platform_filter (** Filter platform data *) - | No_nag_dialog (** Used by XenCenter *) - | VMPR (** Enable use of VM Protection and Recovery *) - -(** The list of all known features. *) -val all_features : feature list - -(** Returns a compact list of the current restrictions. *) -val to_compact_string : feature list -> string - -(** Convert a {!feature} list into an association list. *) -val to_assoc_list : feature list -> (string * string) list - -(** Convert an association list of features into a {!feature} list. *) -val of_assoc_list : (string * string) list -> feature list - -(** Check whether a given feature is currently enabled on the pool. *) -val is_enabled : __context:Context.t -> feature -> bool - -(** Update the pool-level restrictions list in the database. *) -val update_pool_features : __context:Context.t -> unit diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/OMakefile --- a/ocaml/xapi/OMakefile +++ b/ocaml/xapi/OMakefile @@ -237,10 +237,11 @@ ../license/v6rpc \ bios_strings \ xapi_config \ + features \ + pool_features \ ../license/grace_retry \ ../license/v6alert \ ../license/edition \ - ../license/features \ ../license/license_file \ ../license/license_init diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/features.ml --- /dev/null +++ b/ocaml/xapi/features.ml @@ -0,0 +1,114 @@ +(* (C) 2006-2010 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 D = Debug.Debugger(struct let name="license" end) +open D + +(* Features and restrictions *) + +type feature = + | VLAN + | QoS + | Shared_storage + | Netapp + | Equalogic + | Pooling + | HA + | Marathon + | Email + | Performance + | WLB + | RBAC + | DMC + | Checkpoint + | Vswitch_controller + | CPU_masking + | Connection + | No_platform_filter + | No_nag_dialog + | VMPR + +type orientation = Positive | Negative + +let keys_of_features = + [ + VLAN, ("restrict_vlan", Negative, "VLAN"); + QoS, ("restrict_qos", Negative, "QoS"); + Shared_storage, ("restrict_pool_attached_storage", Negative, "SStorage"); + Netapp, ("restrict_netapp", Negative, "NTAP"); + Equalogic, ("restrict_equalogic", Negative, "EQL"); + Pooling, ("restrict_pooling", Negative, "Pool"); + HA, ("enable_xha", Positive, "XHA"); + Marathon, ("restrict_marathon", Negative, "MTC"); + Email, ("restrict_email_alerting", Negative, "email"); + Performance, ("restrict_historical_performance", Negative, "perf"); + WLB, ("restrict_wlb", Negative, "WLB"); + RBAC, ("restrict_rbac", Negative, "RBAC"); + DMC, ("restrict_dmc", Negative, "DMC"); + Checkpoint, ("restrict_checkpoint", Negative, "chpt"); + Vswitch_controller, ("restrict_vswitch_controller", Negative, "DVSC"); + CPU_masking, ("restrict_cpu_masking", Negative, "Mask"); + Connection, ("restrict_connection", Negative, "Cnx"); + No_platform_filter, ("platform_filter", Negative, "Plat"); + No_nag_dialog, ("regular_nag_dialog", Negative, "nonag"); + VMPR, ("restrict_vmpr", Negative, "VMPR"); + ] + +let string_of_feature f = + let str, o, _ = List.assoc f keys_of_features in + str, o + +let feature_of_string str = + let f, (_, o, _) = List.find (fun (_, (k, _, _)) -> str = k) keys_of_features in + f, o + +let tag_of_feature f = + let _, _, tag = List.assoc f keys_of_features in + tag + +let all_features = + List.map (fun (f, _) -> f) keys_of_features + +let to_compact_string (s: feature list) = + let get_tag f = + let tag = tag_of_feature f in + if List.mem f s then + tag + else + String.make (String.length tag) ' ' + in + let tags = List.map get_tag all_features in + String.concat " " tags + +let to_assoc_list (s: feature list) = + let get_map f = + let str, o = string_of_feature f in + let switch = List.mem f s in + let switch = string_of_bool (if o = Positive then switch else not switch) in + str, switch + in + List.map get_map all_features + +let of_assoc_list l = + let get_feature (k, v) = + try + let v = bool_of_string v in + let f, o = feature_of_string k in + let v = if o = Positive then v else not v in + if v then Some f else None + with _ -> + None + in + let features = List.map get_feature l in + List.fold_left (function ac -> function Some f -> f :: ac | None -> ac) [] features + diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/features.mli --- /dev/null +++ b/ocaml/xapi/features.mli @@ -0,0 +1,52 @@ +(* + * 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 controls feature restriction. + * @group Licensing + *) + +(** Features than can be enabled and disabled. *) +type feature = + | VLAN (** Enable VLAN. Currently not used. *) + | QoS (** Enable QoS control. Currently not used. *) + | Shared_storage (** Enable shared storage. Currently not used? *) + | Netapp (** Enable use of NetApp SRs *) + | Equalogic (** Enable use of Equalogic SRs *) + | Pooling (** Enable pooling of hosts *) + | HA (** Enable High Availability (HA) *) + | Marathon (** Currently not used *) + | Email (** Enable email alerting *) + | Performance (** Currently not used? *) + | WLB (** Enable Workload Balancing (WLB) *) + | RBAC (** Enable Role-Based Access Control (RBAC) *) + | DMC (** Enable Dynamic Memory Control (DMC) *) + | Checkpoint (** Enable Checkpoint functionality *) + | Vswitch_controller (** Enable use of a Distributed VSwitch (DVS) Controller *) + | CPU_masking (** Enable masking of CPU features *) + | Connection (** Used by XenCenter *) + | No_platform_filter (** Filter platform data *) + | No_nag_dialog (** Used by XenCenter *) + | VMPR (** Enable use of VM Protection and Recovery *) + +(** The list of all known features. *) +val all_features : feature list + +(** Returns a compact list of the current restrictions. *) +val to_compact_string : feature list -> string + +(** Convert a {!feature} list into an association list. *) +val to_assoc_list : feature list -> (string * string) list + +(** Convert an association list of features into a {!feature} list. *) +val of_assoc_list : (string * string) list -> feature list + diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/pool_features.ml --- /dev/null +++ b/ocaml/xapi/pool_features.ml @@ -0,0 +1,41 @@ +(* (C) 2006-2010 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. + *) + +open Features +module D = Debug.Debugger(struct let name="pool_features" end) +open D + +let pool_features_of_list hosts = + List.fold_left Listext.List.intersect all_features hosts + +let get_pool_features ~__context = + let pool = List.hd (Db.Pool.get_all ~__context) in + of_assoc_list (Db.Pool.get_restrictions ~__context ~self:pool) + +let is_enabled ~__context f = + let pool_features = get_pool_features ~__context in + List.mem f pool_features + +let update_pool_features ~__context = + let pool = List.hd (Db.Pool.get_all ~__context) in + let pool_features = get_pool_features ~__context in + let hosts = List.map + (fun (_, host_r) -> of_assoc_list host_r.API.host_license_params) + (Db.Host.get_all_records ~__context) in + let new_features = pool_features_of_list hosts in + if new_features <> pool_features then begin + info "Old pool features enabled: %s" (to_compact_string pool_features); + info "New pool features enabled: %s" (to_compact_string new_features); + Db.Pool.set_restrictions ~__context ~self:pool ~value:(to_assoc_list new_features) + end + diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/pool_features.mli --- /dev/null +++ b/ocaml/xapi/pool_features.mli @@ -0,0 +1,23 @@ +(* + * 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 controls feature restriction. + * @group Licensing + *) + +(** Check whether a given feature is currently enabled on the pool. *) +val is_enabled : __context:Context.t -> Features.feature -> bool + +(** Update the pool-level restrictions list in the database. *) +val update_pool_features : __context:Context.t -> unit + diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/vmops.ml --- a/ocaml/xapi/vmops.ml +++ b/ocaml/xapi/vmops.ml @@ -357,7 +357,7 @@ let platformdata = let p = Db.VM.get_platform ~__context ~self in - if not (Features.is_enabled ~__context Features.No_platform_filter) then + if not (Pool_features.is_enabled ~__context Features.No_platform_filter) then List.filter (fun (k, v) -> List.mem k filtered_platform_flags) p else p in diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/workload_balancing.ml --- a/ocaml/xapi/workload_balancing.ml +++ b/ocaml/xapi/workload_balancing.ml @@ -87,7 +87,7 @@ split_host_port url let assert_wlb_licensed ~__context = - if not (Features.is_enabled ~__context Features.WLB) + if not (Pool_features.is_enabled ~__context Features.WLB) then raise_license_restriction() diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/xapi_ha.ml --- a/ocaml/xapi/xapi_ha.ml +++ b/ocaml/xapi/xapi_ha.ml @@ -1375,7 +1375,7 @@ if Db.Pool.get_ha_enabled ~__context ~self:pool then raise (Api_errors.Server_error(Api_errors.ha_is_enabled, [])); - if not (Features.is_enabled ~__context Features.HA) + if not (Pool_features.is_enabled ~__context Features.HA) then raise (Api_errors.Server_error(Api_errors.license_restriction, [])); (* Check that all of our 'disallow_unplug' PIFs are currently attached *) diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/xapi_host.ml --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -35,7 +35,7 @@ let set_license_params ~__context ~self ~value = Db.Host.set_license_params ~__context ~self ~value; - Features.update_pool_features ~__context + Pool_features.update_pool_features ~__context let set_power_on_mode ~__context ~self ~power_on_mode ~power_on_config = Db.Host.set_power_on_mode ~__context ~self ~value:power_on_mode; @@ -1324,7 +1324,7 @@ let set_cpu_features ~__context ~host ~features = debug "Set CPU features"; (* check restrictions *) - if not (Features.is_enabled ~__context Features.CPU_masking) then + if not (Pool_features.is_enabled ~__context Features.CPU_masking) then raise (Api_errors.Server_error (Api_errors.feature_restricted, [])); let cpuid = Cpuid.read_cpu_info () in diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/xapi_message.ml --- a/ocaml/xapi/xapi_message.ml +++ b/ocaml/xapi/xapi_message.ml @@ -169,7 +169,7 @@ let handle_message ~__context message = try - if not (Features.is_enabled ~__context Features.Email) + if not (Pool_features.is_enabled ~__context Features.Email) then info "Email alerting is restricted by current license: not generating email" else begin let output, log = Forkhelpers.execute_command_get_output (Xapi_globs.xapi_message_script) [message] in diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/xapi_subject.ml --- a/ocaml/xapi/xapi_subject.ml +++ b/ocaml/xapi/xapi_subject.ml @@ -64,7 +64,7 @@ (* CP-1224: Free Edition: Newly created subjects will have the Pool Administrator role. *) (* CP-1224: Paid-for Edition: Newly created subjects will have an empty role. *) let default_roles = - if (Features.is_enabled ~__context Features.RBAC) + if (Pool_features.is_enabled ~__context Features.RBAC) then (* paid-for edition: we can only create a subject with no roles*) [] else (*free edition: one fixed role of pool-admin only*) @@ -177,7 +177,7 @@ (* CP-1224: Free Edition: Attempts to add or remove roles *) (* will fail with a LICENSE_RESTRICTION error.*) - if (not (Features.is_enabled ~__context Features.RBAC)) then + if (not (Pool_features.is_enabled ~__context Features.RBAC)) then raise (Api_errors.Server_error(Api_errors.license_restriction, [])) else @@ -215,7 +215,7 @@ (* CP-1224: Free Edition: Attempts to add or remove roles *) (* will fail with a LICENSE_RESTRICTION error.*) - if not (Features.is_enabled ~__context Features.RBAC) then + if not (Pool_features.is_enabled ~__context Features.RBAC) then raise (Api_errors.Server_error(Api_errors.license_restriction, [])) else diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/xapi_vm.ml --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -930,7 +930,7 @@ (* As the checkpoint operation modify the domain state, we take the vm_lock to do not let the event *) (* thread mess around with that. *) let checkpoint ~__context ~vm ~new_name = - if not (Features.is_enabled ~__context Features.Checkpoint) then + if not (Pool_features.is_enabled ~__context Features.Checkpoint) then raise (Api_errors.Server_error(Api_errors.license_restriction, [])) else begin Local_work_queue.wait_in_line Local_work_queue.long_running_queue diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/xapi_vm_memory_constraints.ml --- a/ocaml/xapi/xapi_vm_memory_constraints.ml +++ b/ocaml/xapi/xapi_vm_memory_constraints.ml @@ -68,7 +68,7 @@ let assert_valid_for_current_context ~__context ~vm ~constraints = (* NB we don't want to prevent dom0 ballooning even if we do want to prevent domU ballooning. *) - (if Db.VM.get_is_control_domain ~__context ~self:vm || (Features.is_enabled ~__context Features.DMC) + (if Db.VM.get_is_control_domain ~__context ~self:vm || (Pool_features.is_enabled ~__context Features.DMC) then assert_valid else assert_valid_and_pinned_at_static_max) ~constraints diff -r 7b6fef2813f7 -r c1100dd68e16 ocaml/xapi/xapi_vmpp.ml --- a/ocaml/xapi/xapi_vmpp.ml +++ b/ocaml/xapi/xapi_vmpp.ml @@ -20,7 +20,7 @@ let vmpr_snapshot_other_config_applies_to = "applies_to" let assert_licensed ~__context = - if (not (Features.is_enabled ~__context Features.VMPR)) + if (not (Pool_features.is_enabled ~__context Features.VMPR)) then raise (Api_errors.Server_error(Api_errors.license_restriction, []))