../../util/util_inventory \
../../util/version \
../../xapi/xapi_inventory \
+ ../../xapi/features \
../../license/v6rpc \
../../license/v6daemon \
$(COMMON_OBJS) \
+++ /dev/null
-(* (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
-
+++ /dev/null
-(*
- * 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
../license/v6rpc \
bios_strings \
xapi_config \
+ features \
+ pool_features \
../license/grace_retry \
../license/v6alert \
../license/edition \
- ../license/features \
../license/license_file \
../license/license_init
--- /dev/null
+(* (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
+
--- /dev/null
+(*
+ * 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
+
--- /dev/null
+(* (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
+
--- /dev/null
+(*
+ * 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
+
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
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()
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 *)
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;
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
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
(* 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*)
(* 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
(* 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
(* 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
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
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, []))
projects / xcp / xen-api.git / commitdiff