# HG changeset patch # User Rob Hoes # Date 1294419411 0 # Node ID 70b29fc7d5e0449354b1ac373fb9e08ca70a8968 # Parent 00a9b7b7cf540d84898fda2494a95dc1290c5e30 Remove no longer used module that was still lying around Signed-off-by: Rob Hoes diff -r 00a9b7b7cf54 -r 70b29fc7d5e0 ocaml/license/restrictions.ml --- a/ocaml/license/restrictions.ml +++ /dev/null @@ -1,299 +0,0 @@ -(* - * Copyright (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. - *) - -(* Restrictions *) -open Threadext -open License -module D = Debug.Debugger(struct let name="license" end) -open D - -(* The skus *) -type sku = Express | Enterprise - -let is_floodgate_free x = - x = Express - -let sku_of_string = function - | "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" - -(** 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*) - -(** 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; - enable_dmc : bool; - enable_checkpoint : bool; - enable_vswitch_controller : bool; - enable_cpu_masking : bool; - restrict_connection : bool; - platform_filter : bool; - regular_nag_dialog : bool; -} - -(** Used for printing compact host x restriction tables *) -let to_compact_string (x: restrictions) = - let tag_flag_pair_list = [ - "VLAN" , x.enable_vlans ; - "QoS" , x.enable_qos ; - "SStorage", x.enable_shared_storage; - "NTAP" , x.enable_netapp ; - "EQL" , x.enable_equalogic ; - "Pool" , x.enable_pooling ; - "XHA" , x.enable_xha ; - "MTC" , x.enable_mtc_pci ; - "email" , x.enable_email ; - "perf" , x.enable_performance ; - "WLB" , x.enable_wlb ; - "RBAC" , x.enable_rbac ; - "DMC" , x.enable_dmc ; - "chpt" , x.enable_checkpoint ; - "DVSC" , x.enable_vswitch_controller; - "Mask" , x.enable_cpu_masking; - "Cnx" , not x.restrict_connection ; - "Plat" , not x.platform_filter ; - "nag" , x.regular_nag_dialog ; - ] in - let to_string (tag, flag) = - if flag then tag else String.make (String.length tag) ' ' in - String.concat " " (List.map to_string tag_flag_pair_list) - -(** 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; - enable_dmc = true; - enable_checkpoint = true; - enable_vswitch_controller = true; - enable_cpu_masking = 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; - enable_dmc = a.enable_dmc && b.enable_dmc; - enable_checkpoint = a.enable_checkpoint && b.enable_checkpoint; - enable_vswitch_controller = a.enable_vswitch_controller && b.enable_vswitch_controller; - enable_cpu_masking = a.enable_cpu_masking && b.enable_cpu_masking; - 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 - -(* Returns true if the pool SKUs are 'floodgate free' (ie if any are express *) -let pool_is_floodgate_free_of_list (license_params: ((string * string) list) list) = - (* Some of the license_params might be malformed due to initial startup glitches *) - let valid = List.filter (fun license_params -> try ignore(License.of_assoc_list license_params); true with _ -> false) license_params in - let licenses = List.map License.of_assoc_list license_params in - List.fold_left (||) false (List.map (fun x -> is_floodgate_free (sku_of_string x.License.sku)) licenses) - -let _restrict_connection = "restrict_connection" -let _restrict_pooling = "restrict_pooling" -let _restrict_qos = "restrict_qos" -let _restrict_pool_attached_storage = "restrict_pool_attached_storage" -let _restrict_vlan = "restrict_vlan" -let _enable_xha = "enable_xha" -let _restrict_netapp = "restrict_netapp" -let _restrict_equalogic = "restrict_equalogic" -let _restrict_marathon = "restrict_marathon" -let _platform_filter = "platform_filter" -let _restrict_email_alerting = "restrict_email_alerting" -let _restrict_historical_performance = "restrict_historical_performance" -let _restrict_wlb = "restrict_wlb" -let _restrict_rbac = "restrict_rbac" -let _restrict_dmc = "restrict_dmc" -let _restrict_checkpoint = "restrict_checkpoint" -let _restrict_vswitch_controller = "restrict_vswitch_controller" -let _restrict_cpu_masking = "restrict_cpu_masking" -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)); - (_restrict_dmc, string_of_bool (not x.enable_dmc )); - (_restrict_checkpoint, string_of_bool (not x.enable_checkpoint )); - (_restrict_vswitch_controller, string_of_bool (not x.enable_vswitch_controller )); - (_restrict_cpu_masking, string_of_bool (not x.enable_cpu_masking )); - (_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. *) -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)); - enable_dmc = Opt.default most_permissive.enable_dmc (Opt.map not (find bool_of_string _restrict_dmc)); - enable_checkpoint = Opt.default most_permissive.enable_checkpoint (Opt.map not (find bool_of_string _restrict_dmc)); - enable_vswitch_controller = Opt.default most_permissive.enable_vswitch_controller (Opt.map not (find bool_of_string _restrict_vswitch_controller)); - enable_cpu_masking = Opt.default most_permissive.enable_cpu_masking (Opt.map not (find bool_of_string _restrict_cpu_masking)); - 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; - enable_dmc = false; - enable_checkpoint = false; - enable_vswitch_controller = false; - enable_cpu_masking = 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; - enable_dmc = true; - enable_checkpoint = true; - enable_vswitch_controller = true; - enable_cpu_masking = true; - regular_nag_dialog = false; - } - -let get () = - restrictions_of_sku (get_sku ()) - -let get_pool ~__context = - let pool = List.hd (Db.Pool.get_all ~__context) in - of_assoc_list (Db.Pool.get_restrictions ~__context ~self:pool) - -let update_pool_restrictions ~__context = - let pool = List.hd (Db.Pool.get_all ~__context) in - let pool_restrictions = of_assoc_list (Db.Pool.get_restrictions ~__context ~self:pool) in - 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); - Db.Pool.set_restrictions ~__context ~self:pool ~value:(to_assoc_list new_restrictions) - end - -let license_ok_for_wlb ~__context = - (get_pool ~__context).enable_wlb - -let license_ok_for_rbac ~__context = - (get_pool ~__context).enable_rbac - -let context_ok_for_dmc ~__context = - (get_pool ~__context).enable_dmc - -let ok_for_checkpoint ~__context = - (get_pool ~__context).enable_checkpoint - -let ok_for_vswitch_controller ~__context = - (get_pool ~__context).enable_vswitch_controller - -let ok_for_cpu_masking ~__context = - (get_pool ~__context).enable_cpu_masking - diff -r 00a9b7b7cf54 -r 70b29fc7d5e0 ocaml/license/restrictions.mli --- a/ocaml/license/restrictions.mli +++ /dev/null @@ -1,101 +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 license entitlements. - * @group Licensing - *) - -(** Licensing mode. *) -type sku = -| Express (** Express (free) license *) -| Enterprise (** Enterprise (paid-for) license *) - -(* the following three functions are used by the CLI *) - -(** Convert a string to a {!sku}. *) -val sku_of_string : string -> sku - -(** Whether whether the given {!sku} corresponds to the free edition. *) -val is_floodgate_free : sku -> bool - -(** Convert a {!sku} to a cryptic abbreviation. *) -val obfuscated_string_of_sku : sku -> string - -(** 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) *) - enable_dmc : bool; (** enable Dynamic Memory Control (DMC) *) - enable_checkpoint : bool; (** enable Checkpoint *) - enable_vswitch_controller : bool; (** enable use of a Distributed VSwitch (DVS) Controller *) - enable_cpu_masking : bool; (** enable masking of CPU features *) - 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. *) -val to_compact_string : restrictions -> string - -(** Return the 'pool_restrictions' being the greatest set of permissions allowed by all licenses. *) -val pool_restrictions_of_list : restrictions list -> restrictions - -(** Convert a {!restrictions} value into an association list. *) -val to_assoc_list : restrictions -> (string * string) list - -(** Convert and association list of restictions into a {!restrictions} value. *) -val of_assoc_list : (string * string) list -> restrictions - -(** Get the current restrictions. *) -val get : unit -> restrictions - -(** Return cache of pool restrictions, always updated at least once when the master reads its license. - * Called on the master to gate some operations. *) -val get_pool : __context:Context.t -> restrictions - -(* called by xapi_host *) -(** Called whenever a slave resets its Host.license_params after reading in a license. *) -val update_pool_restrictions : __context:Context.t -> unit - -(** Object the {!restrictions} for a given {!sku}. *) -val restrictions_of_sku : sku -> restrictions - -(** Checks whether we are entitled to enable Workload Balancing (WLB) in the pool. *) -val license_ok_for_wlb : __context:Context.t -> bool - -(** Checks whether we are entitled to enable Role-Based Access Control (RBAC) in the pool *) -val license_ok_for_rbac : __context:Context.t -> bool - -(** Checks whether we are entitled to enable Dynamic Memory Control (DMC) - * in the pool. *) -val context_ok_for_dmc : __context:Context.t -> bool - -(** Checks whether we are entitled to enable checkpoint *) -val ok_for_checkpoint : __context:Context.t -> bool - -(** Checks whether we are entitled to use a VSwitch Controller *) -val ok_for_vswitch_controller : __context:Context.t -> bool - -(** Checks whether we are entitled to mask CPU features *) -val ok_for_cpu_masking : __context:Context.t -> bool -