diff --git a/v6/jbuild b/v6/jbuild index 6f2022a1..e3ab76b4 100644 --- a/v6/jbuild +++ b/v6/jbuild @@ -15,8 +15,8 @@ let flags = function in go ic "" -let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] +let flags = flags rewriters_ppx let coverage_rewriter = let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in @@ -29,27 +29,13 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (jbuild_version 1) (library - ((name xapi_v6_interface) - (public_name xcp.v6.interface) - (modules (v6_interface)) - (flags (:standard -w -39 %s)) - (libraries - (rpclib - threads - xcp)) - (wrapped false) - %s)) - -(library - ((name xapi_v6) + ((name xcp_v6) (public_name xcp.v6) - (modules (:standard \ v6_interface)) (flags (:standard -w -39 %s)) (libraries (rpclib threads - xapi_v6_interface xcp)) (wrapped false) %s)) -|} (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter +|} flags coverage_rewriter diff --git a/v6/v6_cli.ml b/v6/v6_cli.ml new file mode 100644 index 00000000..685889d5 --- /dev/null +++ b/v6/v6_cli.ml @@ -0,0 +1,21 @@ +(* Licensing CLI *) + +module Cmds =V6_interface.RPC_API(Cmdlinergen.Gen ()) + +let version_str description = + let maj,min,mic = description.Idl.Interface.version in + Printf.sprintf "%d.%d.%d" maj min mic + +let default_cmd = + let doc = String.concat "" [ + "A CLI for the V6d API. This allows scripting of the licensing daemon "; + "for testing and debugging. This tool is not intended to be used as an "; + "end user tool"] in + Cmdliner.Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ())), + Cmdliner.Term.info "licensing_cli" ~version:(version_str Cmds.description) ~doc + +let cli () = + let rpc = V6_client.rpc in + Cmdliner.Term.eval_choice default_cmd (List.map (fun t -> t rpc) (Cmds.implementation ())) + +let _ = cli () diff --git a/v6/v6_client.ml b/v6/v6_client.ml index 121fa0d2..738e62cd 100644 --- a/v6/v6_client.ml +++ b/v6/v6_client.ml @@ -25,21 +25,18 @@ let retry_econnrefused f = None in match result with | Some x -> x - | None -> if retry then loop false else raise V6d_failure + | None -> if retry then loop false else raise (V6_error V6d_failure) in loop true -module Client = V6_interface.Client(struct - let rpc call = - retry_econnrefused (fun () -> - if !use_switch - then json_switch_rpc !queue_name call - else xml_http_rpc - ~srcstr:(Xcp_client.get_user_agent ()) - ~dststr:"v6" - V6_interface.uri - call - ) -end) +let json_url () = "file:" ^ json_path +let xml_url () = "file:" ^ xml_path + +let rpc call = + if !use_switch + then json_switch_rpc !queue_name call + else xml_http_rpc ~srcstr:"xapi" ~dststr:"v6d" xml_url call + +module Client = V6_interface.RPC_API(Idl.GenClientExnRpc(struct let rpc=rpc end)) include Client diff --git a/v6/v6_interface.ml b/v6/v6_interface.ml index 41c2ec7d..b6003c13 100644 --- a/v6/v6_interface.ml +++ b/v6/v6_interface.ml @@ -12,33 +12,137 @@ * GNU Lesser General Public License for more details. *) +(** + @group Licensing +*) +open Rpc +open Idl + let service_name = "v6d" let queue_name = ref (Xcp_service.common_prefix ^ service_name) let default_sockets_dir = "/var/lib/xcp" let default_path = ref (Filename.concat default_sockets_dir service_name) let uri () = "file:" ^ !default_path +let json_path = "/var/xapi/v6.json" +let xml_path = "/var/xapi/v6" +(** Uninterpreted/sanitised string associated with operation *) type debug_info = string +[@@deriving rpcty] + +(** Record representing software edition *) +type edition = + { + title : string ; + (** Name of edition, this will be passed to apply_edition *) + official_title : string ; + (** Marketing title used to advertise edition *) + code : string ; + (** Abbreviated form of name, used to show up in logs and on command line *) + order : int ; + (** Number indicating ordering among other editions; + low numbers correspond to fewer features, and vice versa *) + } +[@@deriving rpcty] -type edition_info = { - edition: string; +(** List of edition records *) +type edition_list = edition list +[@@deriving rpcty] + +(** Record of edition info, including xapi parameters and features *) +type edition_info = + { + edition_name: string; + (** Name of edition *) xapi_params: (string * string) list; + (** List of parameters used by Xapi *) additional_params: (string * string) list; + (** Addition parameters supplied *) experimental_features: (string * bool) list; -} + (** List of experimental features and whether they're available in this edition *) + } +[@@deriving rpcty] + +(** [string * string] list *) +type string_pair_lst = (string * string) list +[@@deriving rpcty] + +(** Wrapper for specific errors in managing features *) +type errors = + | Invalid_edition of string + (** Thrown by apply_edition on receiving unfamiliar edition. + * Note: get_editions returns list of all valid editions *) + | License_expired + (** Thrown by license_check when expiry date matches or precedes current date *) + | License_processing_error + (** License could not be processed *) + | License_checkout_error of string + (** License could not be checked out *) + | Missing_connection_details + (** Thrown if connection port or address parameter not supplied to check_license *) + | V6d_failure + (** Daemon failed to enable features *) +[@@default V6d_failure] +[@@deriving rpcty] + +(** Pass error variant as exn for error handler *) +exception V6_error of errors +[@@deriving rpcty] + +(** handle exception generation and raising *) +let err = Error.{ + def = errors; + raiser = (function + | e -> raise (V6_error e)); + matcher = (function + | V6_error e -> Some e + | _ -> None) + } + + +(** functor to autogenerate code using PPX *) +module RPC_API(R : RPC) = struct + open R + + (* description of V6d interface module *) + let description = Interface.{ + name = "Licensing"; + namespace = None; + description = + [ + "This interface is used by Xapi and V6d to manage " + ; "enabling and disabling features." + ]; + version=(1,0,0); } + + (* define implementation *) + let implementation = implement description + + (* define general parameters for API calls *) + let debug_info_p = Param.mk ~description:[ + "An uninterpreted string to associate with the operation." + ] debug_info + + (* ---- API call definitions ---- *) -exception Invalid_edition of string -exception V6d_failure -exception License_expired -exception License_processing_error -exception Missing_connection_details -exception License_checkout_error of string + let apply_edition = + let edition_p = Param.mk ~description:["Edition title"] Types.string in + let edition_info_p = Param.mk ~description:["Edition info"] edition_info in + let current_params_p = Param.mk ~description:["Xapi parameters"] string_pair_lst in + declare "apply_edition" + ["Checks license info to ensures enabled features are compatible."] + ( debug_info_p @-> edition_p @-> current_params_p @-> returning edition_info_p err ) -(* dbg_str -> requested edition -> current params -> edition_info *) -external apply_edition : debug_info -> string -> (string * string) list -> edition_info = "" + let get_editions = + let edition_list_p = Param.mk ~description:["List of editions"] edition_list in + declare "get_editions" + ["Gets list of accepted editions."] + ( debug_info_p @-> returning edition_list_p err ) -(* dbg_str -> list of editions *) -external get_editions : debug_info -> (string * (string * string * int)) list = "" + let get_version = + let result_p = Param.mk ~description:["String of version."] Types.string in + declare "get_version" + ["Returns version"] + ( debug_info_p @-> returning result_p err ) -(* dbg_str -> result *) -external get_version : debug_info -> string = "" +end