# HG changeset patch # User Rob Hoes # Date 1294419412 0 # Node ID 2b41dc27dcc224bf22d1d0c432a668b6e626b60f # Parent 9e99160603a3f19a762cc5c4e46b6f2ca2b092b3 Clean up old modules Signed-off-by: Rob Hoes diff -r 0b9c761f2f4d ocaml/license/pubring.gpg Binary file ocaml/license/pubring.gpg has changed diff -r 0b9c761f2f4d ocaml/license/secring.gpg Binary file ocaml/license/secring.gpg has changed diff -r 0b9c761f2f4d ocaml/license/trustdb.gpg Binary file ocaml/license/trustdb.gpg has changed diff -r 9e99160603a3 -r 2b41dc27dcc2 ocaml/license/OMakefile --- a/ocaml/license/OMakefile +++ b/ocaml/license/OMakefile @@ -9,28 +9,25 @@ v6rpc \ v6errors \ v6daemon \ - edition + edition \ + v6testd # Name of daemon to install in dom0: -V6D = v6testd +V6D = v6d -OCamlProgram(v6testd, $(V6FILES) v6testd) +OCamlProgram($(V6D), $(V6FILES)) +OCamlDocProgram($(V6D), $(V6FILES)) + OCamlProgram(v6d-reopen-logs, v6d_reopen_logs) -OCamlDocProgram(v6d, $(V6FILES) v6testd) - .PHONY: install install: $(V6D) mkdir -p $(LIBEXEC) - $(IPROG) $(V6D) $(LIBEXEC)/v6d + $(IPROG) $(V6D) $(LIBEXEC) mkdir -p $(DESTDIR)/opt/xensource/bin $(IPROG) v6d-reopen-logs $(DESTDIR)/opt/xensource/bin -.PHONY: sdk-install -sdk-install: install +.PHONY: clean +clean: + rm -f *.cmi *.cmx *.cmo *.a *.cma *.cmxa *.run *.opt *.annot *.o *.rej *.orig *.spit *.spot *.omc v6d v6d-reopen-logs -.PHONY: clean - -clean: - rm -f *.cmi *.cmx *.cmo *.a *.cma *.cmxa *.run *.opt *.annot *.o v6d v6testd v6d-reopen-logs - diff -r 9e99160603a3 -r 2b41dc27dcc2 ocaml/license/license.ml --- a/ocaml/license/license.ml +++ /dev/null @@ -1,157 +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. - *) - -open Stringext -open Pervasiveext - -module D = Debug.Debugger(struct let name="license" end) -open D - -(* Defaults *) -let edition = Edition.Free - -(* Round a date, given by Unix.time, to days *) -let round_to_days d = - let days = (int_of_float d) / (24 * 3600) in - (float_of_int days) *. 24. *. 3600. - -(* Obtain a date that lies 30 days in the future to set as grace expiry date *) -let grace_expiry () = - if Xapi_fist.reduce_grace_period () then - Unix.time () +. 15. *. 60. (* 15 minutes in the future *) - else - round_to_days (Unix.time () +. 30. *. 24. *. 60. *. 60.) (* 30 days in the future *) - -(* Obtain a date that lies 30 days in the future to set as upgrade grace expiry date *) -let upgrade_grace_expiry () = - if Xapi_fist.reduce_upgrade_grace_period () then - Unix.time () +. 15. *. 60. (* 15 minutes in the future *) - else - round_to_days (Unix.time () +. 30. *. 24. *. 60. *. 60.) (* 30 days in the future *) - -let default_version = Version.product_version -let default_sockets = 1 -let default_productcode = "" - -(* Only read out the fields we care about. The signature covers the other - fields so there's no verification required here. *) -type license = - { - sku : string; - version : string; - serialnumber : string; - sockets : int; - productcode : string; - expiry : float; - grace : string; - - name : string; - company : string; - address1 : string; - address2 : string; - city : string; - state : string; - postalcode : string; - country : string; - - sku_marketing_name : string; (* calculated only on the host with the license file, copied otherwise *) - } - -(* String constants used for converting the license record to/from string*string association lists *) -let _sku_type = "sku_type" -let _version = "version" -let _serialnumber = "serialnumber" -let _sockets = "sockets" -let _productcode = "productcode" -let _expiry = "expiry" -let _grace = "grace" -let _name = "name" -let _company = "company" -let _address1 = "address1" -let _address2 = "address2" -let _city = "city" -let _state = "state" -let _postalcode = "postalcode" -let _country = "country" -let _sku_marketing_name = "sku_marketing_name" - -let to_assoc_list (x: license) = - [ _sku_type, x.sku; - _version, x.version; - _serialnumber, x.serialnumber; - _sockets, string_of_int x.sockets; - _productcode, x.productcode; - _expiry, Date.to_string (Date.of_float x.expiry); - _grace, x.grace; - _name, x.name; - _company, x.company; - _address1, x.address1; - _address2, x.address2; - _city, x.city; - _state, x.state; - _postalcode, x.postalcode; - _country, x.country; - _sku_marketing_name, x.sku_marketing_name; - ] - -exception Missing_license_param of string - -(** Takes an association list (eg from Host.license_params) and returns a license record. This may throw - Missing_license_param if the key is absent *) -let of_assoc_list (x: (string * string) list) = - let find k = if List.mem_assoc k x then List.assoc k x else raise (Missing_license_param k) in - { sku = find _sku_type; - version = find _version; - serialnumber = find _serialnumber; - sockets = (try int_of_string (find _sockets) with _ -> 1); (* sockets are now irrelevant *) - productcode = find _productcode; - expiry = (Date.to_float (Date.of_string (find _expiry))); - grace = "no"; (* NOTE: 'grace' key left out for backwards compatibility *) - name = find _name; - company = find _company; - address1 = find _address1; - address2 = find _address2; - city = find _city; - state = find _state; - postalcode = find _postalcode; - country = find _country; - (* NB: it would be dangerous to use this host's sku_marketing_name db to resolve another host's sku *) - sku_marketing_name = (try find _sku_marketing_name with Missing_license_param _ -> ""); - } - -let default () = - { - sku = Edition.to_string edition; - version = default_version; - serialnumber = ""; - sockets = default_sockets; - productcode = default_productcode; - expiry = grace_expiry (); - grace = "no"; - name = ""; - company = ""; - address1 = ""; - address2 = ""; - city = ""; - state = ""; - postalcode = ""; - country = ""; - sku_marketing_name = Edition.to_marketing_name edition; - } - -(* Calls to obtain info about license *) - -let check_expiry l = - Unix.time () < l.expiry - diff -r 9e99160603a3 -r 2b41dc27dcc2 ocaml/license/license.mli --- a/ocaml/license/license.mli +++ /dev/null @@ -1,62 +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 keeps track of licenses and related matter - * @group Licensing - *) - -(** Type for holding all details about a license *) -type license = - { - sku : string; (** License type *) - version : string; (** No longer used *) - serialnumber : string; (** No longer used *) - sockets : int; (** No longer used *) - productcode : string; (** No longer used *) - expiry : float; (** Expiry date (result of Unix.time) *) - grace : string; (** Indicates whether the current license is a grace license. - * Possible values: "no", "upgrade grace", "regular grace" *) - - name : string; (** No longer used *) - company : string; (** No longer used *) - address1 : string; (** No longer used *) - address2 : string; (** No longer used *) - city : string; (** No longer used *) - state : string; (** No longer used *) - postalcode : string; (** No longer used *) - country : string; (** No longer used *) - - sku_marketing_name : string; (** Official marketing name of the license *) - } - -(** Converts a license into a association list to place in DB. *) -val to_assoc_list : license -> (string * string) list - -(** Converts a license association list from DB into a license value. *) -val of_assoc_list : (string * string) list -> license - -(** Returns a default, free license with 30-day grace. *) -val default : unit -> license - -(** Check whether a given license is valid or expired. *) -val check_expiry : license -> bool - -(** Thrown if we fail to find a license param. *) -exception Missing_license_param of string - -(** Obtain a date that lies 30 days in the future to set as grace expiry date. *) -val grace_expiry : unit -> float - -(** Obtain a date that lies 30 days in the future to set as upgrade grace expiry date. *) -val upgrade_grace_expiry : unit -> float - diff -r 9e99160603a3 -r 2b41dc27dcc2 ocaml/license/license_file.ml --- a/ocaml/license/license_file.ml +++ /dev/null @@ -1,144 +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. - *) - -(* Slightly outdated comment: - * - * There are 2 ways that a license can be registered by xapi. The - * first is on startup, when the file /etc/xensource/license is read, - * and the second is the api call 'host.license_apply'. There are also - * 2 possible problems with a license - that it might have expired, and - * that it might be invalid. The API call will refuse to do anything if - * the license has either problem, but initial startup will always - * apply a parsable license, even if it has expired. - * - * The license is checked to see if it has expired in exactly one place - * - Vmops.create_check, and so an expired license will mean it is - * impossible to start new domains. - *) - -open Stringext -open Pervasiveext -open License - -module D = Debug.Debugger(struct let name="license" end) -open D - -exception LicenseParseError -exception LicenseCannotReadFile -exception LicenseFieldMissing of string -exception License_expired of license -exception License_file_deprecated - -(* Set from config file: *) -(* ...but only in xapi, not in the v6 daemon!!! *) -let filename = ref "/etc/xensource/license" - -(* License setting functions *) - -let validate_signature fname = - Gpg.with_signed_cleartext fname - (fun fingerprint fd -> - (match fingerprint with - | Some f -> - (* base64-encoded fingerprint of our licensing public key *) - if (Base64.encode f)<>"QzA5Qzk4REIwNjM4RjNFQjZEQUFERkU4QTJCRjA0QkM3QThDNzhBNw==" - then - ( - debug "Got fingerprint: %s" f; - (* debug "Encoded: %s" (Base64.encode f); -- don't advertise the fact that we've got an encoded string in here! *) - raise Gpg.InvalidSignature - ) - | None -> - debug "No fingerprint!"; - raise Gpg.InvalidSignature); - Unixext.string_of_fd fd) - -(* only activation keys are accepted as license files since XS 5.6 *) -let parse_license license_data = - let lic_xml = Xml.parse_string license_data in - - let readfld fname attrs = - try - List.assoc fname attrs - with Not_found -> raise (LicenseFieldMissing fname) in - - let maybe_readfld fname attrs = - try - List.assoc fname attrs - with Not_found -> "" in - - match lic_xml with - | Xml.Element("xe_license", attrs, _) -> - let sku = readfld "sku_type" attrs in - (* we now only accept activation keys for the free edition fo XS *) - if sku <> "XE Express" then - raise License_file_deprecated - else - {sku = Edition.to_string Edition.Free; - version = readfld "version" attrs; - serialnumber = readfld "serialnumber" attrs; - sockets = int_of_string (readfld "sockets" attrs); - productcode = (readfld "productcode" attrs); - expiry = float_of_string (readfld "expiry" attrs); - grace = "no"; - name = maybe_readfld "name" attrs; - company = maybe_readfld "company" attrs; - address1 = maybe_readfld "address1" attrs; - address2 = maybe_readfld "address2" attrs; - city = maybe_readfld "city" attrs; - state = maybe_readfld "state" attrs; - postalcode = maybe_readfld "postalcode" attrs; - country = maybe_readfld "country" attrs; - sku_marketing_name = Edition.to_marketing_name Edition.Free; - } - | _ -> raise LicenseParseError - -(* only activation keys are accepted as license files since XS 5.6 *) -let read_license_file fname = - try - Unix.access fname [Unix.F_OK]; - let license_data = validate_signature fname in - let newlicense = parse_license license_data in - Some newlicense - with - | License_file_deprecated -> raise License_file_deprecated - | e -> - begin - debug "Failed to read license file: %s" (Printexc.to_string e); - None - end - -(* only activation keys are accepted as license files since XS 5.6 *) -let do_parse_and_validate fname = - try - let _ = try Unix.access fname [Unix.F_OK] with _ -> raise LicenseCannotReadFile in - let license_data = validate_signature fname in - let newlicense = parse_license license_data in - - (if not (License.check_expiry newlicense) then raise (License_expired newlicense)); - - (* At this point, license is valid and hasn't expired *) - newlicense - with e -> - (match e with - | License_expired l -> warn "License has expired" - | LicenseCannotReadFile -> warn "License application failed: cannot read license file." - | Gpg.InvalidSignature -> warn "License application failed: invalid signature on license file." - | LicenseFieldMissing fname -> warn "License application failed: essential field '%s' missing from license." fname - | LicenseParseError -> warn "License application failed: reverting to previous license" - | License_file_deprecated -> warn "License application failed: deprecated license file" - | e -> warn "License application failed: exception '%s' in license parsing." (Printexc.to_string e); - log_backtrace ()); - raise e - diff -r 9e99160603a3 -r 2b41dc27dcc2 ocaml/license/license_file.mli --- a/ocaml/license/license_file.mli +++ /dev/null @@ -1,43 +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. - *) -(** Handling of license files - * @group Licensing - *) - -(** Path to the license file in use. *) -val filename : string ref - -(** Parse a license file and return the result. - * Called from host.license_apply. *) -val read_license_file : string -> License.license option - -(** As read_license_file, but also set license state variable if not expired. - * Called from host.license_apply. *) -val do_parse_and_validate : string -> License.license - - -(** Thrown if the license data is malformed. *) -exception LicenseParseError - -(** Thrown if the given license file cannot be opened. *) -exception LicenseCannotReadFile - -(** Thrown if a particular field is missing from the license data. *) -exception LicenseFieldMissing of string - -(** Thrown if the license in a given file is found to be expired. *) -exception License_expired of License.license - -(** Thrown if an old-style, deprecated license file is used. *) -exception License_file_deprecated