diff --git a/doc/content/design/external-auth-ldaps.md b/doc/content/design/external-auth-ldaps.md index 4b5258e6bac..cfdef048727 100644 --- a/doc/content/design/external-auth-ldaps.md +++ b/doc/content/design/external-auth-ldaps.md @@ -91,8 +91,9 @@ Given `ldaps` default to `false`, this feature is **NOT** enabled until explicit #### 3.1.2 Error code Following new error codes added to indicate ldaps enable related error -- AUTH_NO_CERT, no certs can be used for ldaps, refer to 4.1.2 for certs finding. -- AUTH_INVALID_CERT, found certs, but none of the certs can be used to connect to DC +- POOL_AUTH_ENABLE_FAILED_NO_CERTS, no certs can be used for ldaps, refer to 4.1.2 for certs finding. +- POOL_AUTH_ENABLE_FAILED_INVALID_CERTS, found certs, but none of the certs can be used to connect to DC +**Note**: Current error code handing infrustrucure requires the error code prefix with POOL_AUTH_ENABLE_FAILED ### 3.2 Set/Get Pool LDAPS Status @@ -134,10 +135,10 @@ xe pool-external-auth-set-ldaps uuid= ldaps= #### 3.2.1.2 Error code This API may raise following errors -- AUTH_NO_CERT, no certs found to enable ldaps, refer to 4.1.2 for certs finding -- AUTH_INVALID_CERT, found certs, but none of the certs can be used to connect to DC +- AUTH_NO_CERTS, no certs found to enable ldaps, refer to 4.1.2 for certs finding +- AUTH_INVALID_CERTS, found certs, but none of the certs can be used to connect to DC - AUTH_IS_DISABLED, AD is not enabled -- AUTH_LDAPS_PING_FAILED, failed to do ldaps query on all DCs with valid certs +- AUTH_SET_LDAPS_FAILED, Failed to set ldaps, the error message contains the details like ldap query on domain failed #### 3.2.2 Get Pool LDAPS Status @@ -211,24 +212,6 @@ This design is following [trusted-certificates.md](https://github.com/xapi-proje - `pool.external_auth_set_ldaps` API - (Re)join domain -### 4.2 Xapi Configuration - -#### 4.2.1 winbind-tls-verify-peer - -For security, xapi asks winbind to verify CA certificate. `ca_and_name_if_available` is the default. - -However, user may want to disable this verification for debug purpose. - -`winbind-tls-verify-peer` is introduced for xapi configuration, and the possible values are `no_check`, `ca_only`, `ca_and_name_if_available`, `ca_and_name` and `as_strict_as_possible`. - The configured value will override `tls verify peer` value in xapi generated samba configuration. Refer to [smb.conf](https://www.samba.org/samba/docs/current/man-html/smb.conf.5.html) for the details. - - -**Note:** This item is not intended for public documentation. This is only for debug purpose, or system tuning for specific scenarios from engineering/support team. - -#### 4.2.2 ad-warning-message-interval - -xapi sends warning message to user with this interval on LDAP query failure. Default to 1 week. Refer to section "Session revalidate" for the details. - ## 5. Session Revalidate xapi LDAP queries domain user status (if user has been added to manage XenServer) at configurable interval, and destroys the session created by domain user if user no longer in healthy status. @@ -238,23 +221,11 @@ However, the LDAP query may fail due to various issues as follows: - Temporary network issues - CA certificate is not properly configured, or expired, etc. -Instead of destroying user session for stability, a warning message will be sent to user with the details at configurable interval `ad-warning-message-interval`. - -- If no LDAP error, do nothing -- If error happens, send the warning message if: - - first time see the error through xapi start up (so no need to persist last send time) or - - `current_time - last_sent_time > winbind_warning_message_interval` - -The message is defined as follows: -- name: AD_DC_LDAP_CHECK -- priority: Warning -- cls: `Host -- Body: LDAP(S) query check to `` of `` failed from `` of `` +Instead of destroying user session for stability, a warning will be printed in xensource.log Note: - The backend session revalidate check only performs on pool coordinator, thus the backend LDAP(S) query check only on coordinator - `external_auth_set_ldaps` perform LDAP(S) query check on every host -- All previous AD_DC_LDAP_CHECK warning of a host will be cleaned on a successful LDAP(s) query from that host ## 6. Pool Join/Leave diff --git a/doc/content/design/secureboot-certificate-expiry.md b/doc/content/design/secureboot-certificate-expiry.md new file mode 100644 index 00000000000..aab10697ecc --- /dev/null +++ b/doc/content/design/secureboot-certificate-expiry.md @@ -0,0 +1,169 @@ +--- +title: Handling Microsoft Secure Boot Certificate Expiry +layout: default +design_doc: true +revision: 1 +status: draft +--- + +## 1. Background + +Microsoft Secure Boot certificates from 2011 are reaching end-of-life, and legacy VMs may still contain only the old certificate set. XenServer needs an out-of-band mechanism to update per-VM UEFI Secure Boot variables safely and at scale. + +Scope of this design: + +- Update certificate state tracking and update flow for VMs, snapshots, and templates +- Provide API support for scheduling certificate updates on VM boot +- Integrate xapi and varstored behavior for consistent state handling + +## 2. System Overview + +### 2.1 Out-of-band Update Mechanism + +Certificate update is implemented as a dedicated API-driven workflow (not a plugin), so that: + +- The interface is documented and SDK-generated +- RBAC can be assigned precisely +- xapi can route requests and coordinate host-side behavior consistently + +### 2.2 Certificate State Tracking + +A new VM field is introduced: + +- `VM.secureboot_certificates_state` (enum, readonly) + +States: + +- `ok`: No update required (including non-applicable VM types) +- `update_available`: Update required +- `update_on_boot`: Update scheduled for next boot + +~~~mermaid + +stateDiagram +update_available --> update_on_boot : Admin marks VM for update +update_on_boot --> ok : VM boots, update succeeds +update_on_boot --> update_on_boot : VM boots, update fails(retain state) +ok --> update_available : recompute state(e.g. legacy VM import) + +~~~ + +### 2.3 RBAC + +The new update API follows VM-admin-level access, aligned with existing NVRAM-related VM operations. + +## 3. Design for Components + +### 3.1 VM Certificate State Model + +`VM.secureboot_certificates_state` applies to these VM-class objects, + +- VMs +- Snapshots +- Templates + +Transition intent: + +- Admin marks a VM for update: `update_available -> update_on_boot` +- VM boots and update succeeds: `update_on_boot -> ok` +- VM boots and update fails: remains `update_on_boot` or is reset to `update_available` based on update result handling + +### 3.2 API: Mark/Unmark Update-on-Boot + +New API: + +- `VM.update_secureboot_certificates_on_boot(session, vm, mark)` + +Behavior: + +- `mark=true`: require current state `update_available`, then set `update_on_boot` +- `mark=false`: require current state `update_on_boot`, then set `update_available` + +Validation: + +- Reject invalid transitions with `OPERATION_NOT_ALLOWED` + +### 3.3 DB Upgrade and Import Handling + +On toolstack restart after upgrade: + +- Initialize `secureboot_certificates_state` for all VM records to `ok` +- Re-evaluate NVRAM and set `update_available` where needed + +Applied to: + +- VMs +- Snapshots +- Non-default templates + +Default templates remain `ok`. + +For VM import and cross-pool migration: + +- If imported metadata lacks `secureboot_certificates_state`, determine state from NVRAM and set it during import +- If imported metadata contains `secureboot_certificates_state`, reserve the state during import + +### 3.4 NVRAM and State Consistency + +The certificate state must stay consistent with actual NVRAM content. + +Key interface change: + +- Extend `VM.set_NVRAM_EFI_variables` with optional parameter `update`, we call it `VM.set_NVRAM_EFI_variables_V2` + +Rules: + +- `update=yes` -> set state `ok` +- `update=no` -> do not update state +- omitted -> xapi runs certificate check helper and derives state + +This ensures compatibility when old varstored instances are still running during rolling update windows. + +### 3.5 Certificate Check Helper + +A standalone program will be introduced, which xapi calls to determine the SecureBoot cert state + +Inputs: + +- `temp file path` which contains NVRAM EFI-variables data + +Behavior: + +- This program comes to use some common functions shared with varstored. +- This program is launched by xapi, it is executed in a sandboxed and reduced privileges environment. +- Xapi retrieves VM's NVRAM content from database and passes it to this program via command-line arguments. +- If this program outputs `update_required`, xapi sets `VM.secureboot_certificates_state` to be `update_available`. +- If this program outputs `update_ok`, xapi sets `VM.secureboot_certificates_state` to be `ok`. +- On toolstack restart, during DB upgrade, this program is invoked to compute `VM.secureboot_certificates_state`. Since xapi process has not completed initialization at that point, this program cannot call any services of xapi. + +### 3.6 Boot-time Automatic Update Path + +When varstored initializes a VM and sees `secureboot_certificates_state=update_on_boot`, varstored does, + +- Perform certificate update flow during boot-time initialization +- Write updated NVRAM and synchronize state via `VM.set_NVRAM_EFI_variables_V2` + +The `VM.set_NVRAM_EFI_variables_V2` interface performs same as `VM.set_NVRAM_EFI_variables`, uses the existing varstored-guard process to make calls to xapi. + +If `VM.set_NVRAM_EFI_variables_V2` runs into error (e.g. there is something wrong with the communication with xapi), + +- xapi does not update VM NVRAM and `VM.secureboot_certificates_state` +- VM boot gets stuck at the firmware initialization stage, if the issue is not fixed, rebooting the VM will still encounter the same problem +- Once the issue is fixed, admin can continue the secureboot certificate upgrade by VM reboot + +### 3.7 End-to-end Workflow + +1. Upgrade packages (`xapi-core`, `varstored`, related components) +2. Restart toolstack +3. xapi DB upgrade initializes and recalculates `secureboot_certificates_state` +4. Admin marks selected VMs via `VM.update_secureboot_certificates_on_boot` +5. VM reboot triggers varstored certificate update +6. xapi updates state to reflect post-update NVRAM content + +## 4. Out of Scope + +- User-notification mechanism for certificate expiry +- Custom certificate workflow +- Template/snapshot feature expansion beyond state tracking and conversion behavior +- OS-specific test-process guidance +- VM with Secure Boot PCR7 binding (e.g. Windows bitlocker), provide customer documentation to guide how to resolve such issues diff --git a/doc/content/xapi/cli/_index.md b/doc/content/xapi/cli/_index.md index 6715e7288c0..093e1576aaf 100644 --- a/doc/content/xapi/cli/_index.md +++ b/doc/content/xapi/cli/_index.md @@ -156,7 +156,7 @@ So each function receives a printer for sending text output to the xe client, an let mac = List.assoc_default "mac" params "" in let network = Client.Network.get_by_uuid rpc session_id network in let pifs = List.assoc "pif-uuids" params in - let uuids = String.split ',' pifs in + let uuids = String.split_on_char ',' pifs in let pifs = List.map (fun uuid -> Client.PIF.get_by_uuid rpc session_id uuid) uuids in let mode = Record_util.bond_mode_of_string (List.assoc_default "mode" params "") in let properties = read_map_params "properties" params in diff --git a/dune-project b/dune-project index 94f67c4c192..548b8b5efad 100644 --- a/dune-project +++ b/dune-project @@ -179,6 +179,8 @@ (xapi-types (= :version)) (xapi-stdext-zerocheck + (= :version)) + (xapi-work-queues (= :version))) (synopsis "A CLI for xapi storage services") (description @@ -191,7 +193,8 @@ (name xapi-schema)) (package - (name xapi-work-queues)) + (name xapi-work-queues) + (depends ppx_deriving_rpc xapi-stdext-threads)) (package (name rrdd-plugin) @@ -327,6 +330,7 @@ xapi-stdext-pervasives xapi-stdext-unix xapi-stdext-zerocheck + xapi-work-queues xen-api-client xen-api-client-lwt xenctrl @@ -365,6 +369,7 @@ rrdd-plugin xapi-stdext-std xapi-tracing-export + xapi-work-queues xen-api-client (alcotest :with-test) (ppx_deriving_rpc :with-test) @@ -483,6 +488,8 @@ (= :version)) (xapi-types (= :version)) + (xapi-work-queues + (= :version)) (xen-api-client-lwt (= :version)) xenctrl ; for quicktest diff --git a/ocaml/database/parse_db_conf.ml b/ocaml/database/parse_db_conf.ml index 785320afc56..c854a03300d 100644 --- a/ocaml/database/parse_db_conf.ml +++ b/ocaml/database/parse_db_conf.ml @@ -13,7 +13,6 @@ *) (* !!! This needs to be moved out of xapi and into the database directory; probably being merged with db_connections !!! *) -open Xapi_stdext_std.Xstringext open Xapi_stdext_unix module D = Debug.Make (struct let name = "parse_db_conf" end) @@ -110,7 +109,7 @@ let parse_db_conf s = let conf = Unixext.string_of_file s in let lines : string list ref = ref [] in let consume_line () = lines := List.tl !lines in - lines := String.split '\n' conf ; + lines := String.split_on_char '\n' conf ; List.iter (fun line -> debug "%s" line) !lines ; let read_block () = let path_line = List.hd !lines in @@ -120,7 +119,7 @@ let parse_db_conf s = while !lines <> [] && List.hd !lines <> "" do let line = List.hd !lines in key_values := - ( match String.split ':' line with + ( match String.split_on_char ':' line with | k :: vs -> ( String.lowercase_ascii k , String.lowercase_ascii (String.concat ":" vs) diff --git a/ocaml/database/redo_log.ml b/ocaml/database/redo_log.ml index 38b3a819e91..f7d02c1cc3d 100644 --- a/ocaml/database/redo_log.ml +++ b/ocaml/database/redo_log.ml @@ -12,7 +12,6 @@ * GNU Lesser General Public License for more details. *) open Xapi_stdext_pervasives.Pervasiveext -open Xapi_stdext_std.Xstringext open Xapi_stdext_unix let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute diff --git a/ocaml/doc/dune b/ocaml/doc/dune index 061ba778232..618de9e30fb 100644 --- a/ocaml/doc/dune +++ b/ocaml/doc/dune @@ -1,7 +1,7 @@ (executable (modes exe) (name jsapi) - (libraries + (libraries mustache rpclib.core rpclib.json @@ -10,7 +10,6 @@ xapi-consts xapi-datamodel xapi-stdext-pervasives - xapi-stdext-std xapi-stdext-unix ) (preprocess (pps ppx_deriving_rpc)) diff --git a/ocaml/doc/jsapi.ml b/ocaml/doc/jsapi.ml index 797b9d9a734..9aa0afcdd3e 100644 --- a/ocaml/doc/jsapi.ml +++ b/ocaml/doc/jsapi.ml @@ -12,7 +12,6 @@ * GNU Lesser General Public License for more details. *) -open Xapi_stdext_std.Xstringext open Xapi_stdext_pervasives.Pervasiveext module Unixext = Xapi_stdext_unix.Unixext open Datamodel_types diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 82f8d1d85ed..e2cb85d0614 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -877,8 +877,9 @@ module User = struct ~lifecycle: [(Published, rel_rio, "Unique identifier/object reference")] ; field ~qualifier:StaticRO - ~lifecycle:[(Published, rel_rio, "short name (e.g. userid)")] - "short_name" "short name (e.g. userid)" + ~lifecycle: + [(Published, rel_rio, "short name (for example, userid)")] + "short_name" "short name (for example, userid)" ; field ~lifecycle:[(Published, rel_rio, "full name")] "fullname" "full name" @@ -2620,10 +2621,11 @@ module PIF = struct [ ( Published , rel_rio - , "machine-readable name of the interface (e.g. eth0)" + , "machine-readable name of the interface (for example, eth0)" ) ] - "device" "machine-readable name of the interface (e.g. eth0)" + "device" + "machine-readable name of the interface (for example, eth0)" ; field ~qualifier:StaticRO ~ty:(Ref _network) ~lifecycle: [ @@ -2793,16 +2795,16 @@ module PIF = struct , rel_orlando , "Prevent this PIF from being unplugged; set this to notify \ the management tool-stack that the PIF has a special use \ - and should not be unplugged under any circumstances (e.g. \ - because you're running storage traffic over it)" + and should not be unplugged under any circumstances (for \ + example, because you're running storage traffic over it)" ) ] ~qualifier:DynamicRO ~default_value:(Some (VBool false)) ~ty:Bool "disallow_unplug" "Prevent this PIF from being unplugged; set this to notify the \ management tool-stack that the PIF has a special use and should \ - not be unplugged under any circumstances (e.g. because you're \ - running storage traffic over it)" + not be unplugged under any circumstances (for example, because \ + you're running storage traffic over it)" ; field ~in_oss_since:None ~ty:(Set (Ref _tunnel)) ~lifecycle: [ @@ -4143,7 +4145,9 @@ module Sr_stat = struct ( "sr_health" , [ ("healthy", "Storage is fully available") - ; ("recovering", "Storage is busy recovering, e.g. rebuilding mirrors.") + ; ( "recovering" + , "Storage is busy recovering, for example, rebuilding mirrors." + ) ; ( "unreachable" , "Storage is unreachable but may be recoverable with admin \ intervention" @@ -4229,7 +4233,7 @@ module Probe_result = struct ~ty:(Map (String, String)) "extra_info" "Additional plugin-specific information about this configuration, \ - that might be of use for an API user. This can for example \ + that might be of use for an API user. This can, for example, \ include the LUN or the WWPN." ] () @@ -4336,7 +4340,8 @@ module SR = struct ; { param_type= String ; param_name= "content_type" - ; param_doc= "The type of the new SRs content, if required (e.g. ISOs)" + ; param_doc= + "The type of the new SRs content, if required (for example, ISOs)" ; param_release= rio_release ; param_default= None } @@ -4911,11 +4916,12 @@ module SR = struct [ ( Published , rel_rio - , "the type of the SR's content, if required (e.g. ISOs)" + , "the type of the SR's content, if required (for example, \ + ISOs)" ) ] "content_type" - "the type of the SR's content, if required (e.g. ISOs)" + "the type of the SR's content, if required (for example, ISOs)" ; field ~qualifier:DynamicRO "shared" ~ty:Bool ~lifecycle: [ @@ -6750,16 +6756,17 @@ module VBD = struct VM" ) ] - "device" "device seen by the guest e.g. hda1" + "device" "device seen by the guest, for example, hda1" ; field ~lifecycle: [ ( Published , rel_rio - , "user-friendly device name e.g. 0,1,2,etc." + , "user-friendly device name, for example, 0, 1, 2, etc." ) ] - "userdevice" "user-friendly device name e.g. 0,1,2,etc." + "userdevice" + "user-friendly device name, for example, 0, 1, 2, etc." ; field ~ty:Bool ~lifecycle:[(Published, rel_rio, "true if this VBD is bootable")] "bootable" "true if this VBD is bootable" @@ -6774,10 +6781,12 @@ module VBD = struct [ ( Published , rel_rio - , "how the VBD will appear to the guest (e.g. disk or CD)" + , "how the VBD will appear to the guest (for example, disk \ + or CD)" ) ] - "type" "how the VBD will appear to the guest (e.g. disk or CD)" + "type" + "how the VBD will appear to the guest (for example, disk or CD)" ; field ~in_oss_since:None ~lifecycle: [ @@ -6959,8 +6968,8 @@ module Auth = struct ( Published , rel_george , "This call queries the external directory service to obtain the \ - user information (e.g. username, organization etc) from the \ - specified subject_identifier" + user information (for example, username, organization etc.) from \ + the specified subject_identifier" ) ] ~params: @@ -6977,8 +6986,8 @@ module Auth = struct ) ~doc: "This call queries the external directory service to obtain the user \ - information (e.g. username, organization etc) from the specified \ - subject_identifier" + information (for example, username, organization etc.) from the \ + specified subject_identifier" ~allowed_roles:_R_READ_ONLY () let get_group_membership = @@ -8651,8 +8660,8 @@ module Event = struct ~doc: "Blocking call which returns a new token and a (possibly empty) batch \ of events. The returned token can be used in subsequent calls to this \ - function. It eliminates redundant events (e.g. same field updated \ - multiple times)." + function. It eliminates redundant events (for example, same field \ + updated multiple times)." ~custom_marshaller:true ~flags:[`Session] ~result: ( Set (Record _event) @@ -11037,7 +11046,7 @@ let http_actions = ; ( "get_vm_rrds" , ( Get , "/vm_rrds" - , true + , false , [String_query_arg "uuid"; Bool_query_arg "json"] , _R_READ_ONLY , [] @@ -11054,7 +11063,7 @@ let http_actions = ) (* For XC < 8460 compatibility, remove when out of support *) ; ( "get_host_rrds" - , (Get, "/host_rrds", true, [Bool_query_arg "json"], _R_READ_ONLY, []) + , (Get, "/host_rrds", false, [Bool_query_arg "json"], _R_READ_ONLY, []) ) ; ( Constants.get_sr_rrd , ( Get diff --git a/ocaml/idl/datamodel_host.ml b/ocaml/idl/datamodel_host.ml index 345a8468f30..e551442fec5 100644 --- a/ocaml/idl/datamodel_host.ml +++ b/ocaml/idl/datamodel_host.ml @@ -1508,9 +1508,9 @@ let create_params = ; param_name= "pending_guidances_full" ; param_doc= "The set of pending full guidances after applying updates, which a \ - user should follow to make some updates, e.g. specific hardware \ - drivers or CPU features, fully effective, but the 'average user' \ - doesn't need to" + user should follow to make some updates, for example, specific \ + hardware drivers or CPU features, fully effective, but the 'average \ + user' doesn't need to" ; param_release= numbered_release "26.0.0" ; param_default= Some (VSet []) } @@ -2000,7 +2000,7 @@ let enable_external_auth = ; (String, "service_name", "The name of the service") ; ( String , "auth_type" - , "The type of authentication (e.g. AD for Active Directory)" + , "The type of authentication (for example, AD for Active Directory)" ) ] ~doc:"This call enables external authentication on a host" @@ -2667,9 +2667,9 @@ let set_ssh_auto_mode = (Ref _host, "self", "The host") ; ( Bool , "value" - , "The SSH auto mode for the host，when set to true, SSH to normally be \ - disabled and SSH to be enabled only in case of emergency e.g., xapi \ - is down" + , "The SSH auto mode for the host. When true, the SSH port is closed \ + by default and it's open only in case the API is unavailable. When \ + false, the SSH port is always open." ) ] ~allowed_roles:_R_POOL_ADMIN () @@ -3326,14 +3326,15 @@ let t = ( Published , "1.303.0" , "The set of pending mandatory guidances after applying \ - updates, which must be applied, as otherwise there may be \ - e.g. VM failures" + updates, which must be applied, otherwise there may be, for \ + example, VM failures" ) ] ~ty:(Set update_guidances) "pending_guidances" ~default_value:(Some (VSet [])) "The set of pending mandatory guidances after applying updates, \ - which must be applied, as otherwise there may be e.g. VM failures" + which must be applied, otherwise there may be, for example, VM \ + failures" ; field ~qualifier:DynamicRO ~lifecycle: [ @@ -3374,9 +3375,9 @@ let t = ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set update_guidances) "pending_guidances_full" ~default_value:(Some (VSet [])) "The set of pending full guidances after applying updates, which a \ - user should follow to make some updates, e.g. specific hardware \ - drivers or CPU features, fully effective, but the 'average user' \ - doesn't need to" + user should follow to make some updates, for example, specific \ + hardware drivers or CPU features, fully effective, but the \ + 'average user' doesn't need to" ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:String ~default_value:(Some (VString "")) "last_update_hash" "The SHA256 checksum of updateinfo of the most recently applied \ diff --git a/ocaml/idl/datamodel_pool.ml b/ocaml/idl/datamodel_pool.ml index c74686fab31..13b2526b9a0 100644 --- a/ocaml/idl/datamodel_pool.ml +++ b/ocaml/idl/datamodel_pool.ml @@ -617,7 +617,7 @@ let enable_external_auth = ; (String, "service_name", "The name of the service") ; ( String , "auth_type" - , "The type of authentication (e.g. AD for Active Directory)" + , "The type of authentication (for example, AD for Active Directory)" ) ] ~doc: @@ -1652,9 +1652,9 @@ let set_ssh_auto_mode = (Ref _pool, "self", "The pool") ; ( Bool , "value" - , "The SSH auto mode for all hosts in the pool，when set to true, SSH \ - to normally be disabled and SSH to be enabled only in case of \ - emergency e.g., xapi is down" + , "The SSH auto mode for all hosts in the pool. When true, the SSH \ + port is closed by default and it's open only in case the API is \ + unavailable. When false, the SSH port is always open." ) ] ~allowed_roles:_R_POOL_ADMIN () @@ -2277,7 +2277,7 @@ let t = ~ty:(Map (String, String)) ~default_value:(Some (VMap [])) "recommendations" "The recommended pool properties for clients to respect for \ - optimal performance. e.g. max-vm-group=5" + optimal performance. For example, max-vm-group=5" ; field ~writer_roles:_R_POOL_OP ~qualifier:RW ~lifecycle:[] ~ty:(Map (String, String)) ~default_value:(Some (VMap [])) "license_server" diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index 17178314acc..7edc823639f 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -248,8 +248,8 @@ let get_boot_record = ] ~doc: "Returns a record describing the VM's dynamic state, initialised when \ - the VM boots and updated to reflect runtime configuration changes e.g. \ - CPU hotplug" + the VM boots and updated to reflect runtime configuration changes, for \ + example CPU hotplug" ~result:(Record _vm, "A record describing the VM") ~params:[(Ref _vm, "self", "The VM whose boot-time state to return")] ~errs:[] ~flags:[`Session] (* no async *) @@ -347,15 +347,16 @@ let clone = , rel_rio , "Clones the specified VM, making a new VM. Clone automatically \ exploits the capabilities of the underlying storage repository in \ - which the VM's disk images are stored (e.g. Copy on Write). This \ - function can only be called when the VM is in the Halted State." + which the VM's disk images are stored (for example, Copy on Write). \ + This function can only be called when the VM is in the Halted \ + State." ) ] ~doc: "Clones the specified VM, making a new VM. Clone automatically exploits \ the capabilities of the underlying storage repository in which the VM's \ - disk images are stored (e.g. Copy on Write). This function can only \ - be called when the VM is in the Halted State." + disk images are stored (for example, Copy on Write). This function can \ + only be called when the VM is in the Halted State." ~result:(Ref _vm, "The reference of the newly created VM.") ~params: [ @@ -418,8 +419,8 @@ let snapshot_with_quiesce = ~doc: "Snapshots the specified VM with quiesce, making a new VM. Snapshot \ automatically exploits the capabilities of the underlying storage \ - repository in which the VM's disk images are stored (e.g. Copy on \ - Write)." + repository in which the VM's disk images are stored (for example, Copy \ + on Write)." ~result:(Ref _vm, "The reference of the newly created VM.") ~params: [ @@ -464,13 +465,13 @@ let snapshot = , rel_orlando , "Snapshots the specified VM, making a new VM. Snapshot automatically \ exploits the capabilities of the underlying storage repository in \ - which the VM's disk images are stored (e.g. Copy on Write)." + which the VM's disk images are stored (for example, Copy on Write)." ) ] ~doc: "Snapshots the specified VM, making a new VM. Snapshot automatically \ exploits the capabilities of the underlying storage repository in which \ - the VM's disk images are stored (e.g. Copy on Write)." + the VM's disk images are stored (for example, Copy on Write)." ~result:(Ref _vm, "The reference of the newly created VM.") ~versioned_params: [ @@ -532,15 +533,15 @@ let checkpoint = , rel_midnight_ride , "Checkpoints the specified VM, making a new VM. Checkpoint \ automatically exploits the capabilities of the underlying storage \ - repository in which the VM's disk images are stored (e.g. Copy on \ - Write) and saves the memory image as well." + repository in which the VM's disk images are stored (for example, \ + Copy on Write) and saves the memory image as well." ) ] ~doc: "Checkpoints the specified VM, making a new VM. Checkpoint automatically \ exploits the capabilities of the underlying storage repository in which \ - the VM's disk images are stored (e.g. Copy on Write) and saves the \ - memory image as well." + the VM's disk images are stored (for example, Copy on Write) and saves \ + the memory image as well." ~result:(Ref _vm, "The reference of the newly created VM.") ~params: [ @@ -639,8 +640,8 @@ let start = ; ( Bool , "force" , "Attempt to force the VM to start. If this flag is false then the VM \ - may fail pre-boot safety checks (e.g. if the CPU the VM last booted \ - on looks substantially different to the current one)" + may fail pre-boot safety checks (for example, if the CPU the VM \ + last booted on looks substantially different to the current one)" ) ] ~errs: @@ -665,7 +666,7 @@ let assert_can_boot_here = ; ( Changed , rel_quebec , "Does additional compatibility checks when VM powerstate is not \ - halted (e.g. CPUID). Use this before calling VM.resume or \ + halted (for example, CPUID). Use this before calling VM.resume or \ VM.pool_migrate." ) ] @@ -703,13 +704,13 @@ let assert_agile = [ ( Published , rel_orlando - , "Returns an error if the VM is not considered agile e.g. because it \ - is tied to a resource local to a host" + , "Returns an error if the VM is not considered agile, for example, \ + because it is tied to a resource local to a host" ) ] ~doc: - "Returns an error if the VM is not considered agile e.g. because it is \ - tied to a resource local to a host" + "Returns an error if the VM is not considered agile, for example, \ + because it is tied to a resource local to a host" ~params:[(Ref _vm, "self", "The VM")] ~allowed_roles:_R_READ_ONLY () @@ -1088,8 +1089,8 @@ let start_on = ; ( Bool , "force" , "Attempt to force the VM to start. If this flag is false then the VM \ - may fail pre-boot safety checks (e.g. if the CPU the VM last booted \ - on looks substantially different to the current one)" + may fail pre-boot safety checks (for example, if the CPU the VM \ + last booted on looks substantially different to the current one)" ) ] ~errs: @@ -1164,15 +1165,15 @@ let cleanShutdown = ( Published , rel_rio , "Attempt to cleanly shutdown the specified VM. (Note: this may not \ - be supported---e.g. if a guest agent is not installed). This can \ - only be called when the specified VM is in the Running state." + be supported, for example, if a guest agent is not installed). This \ + can only be called when the specified VM is in the Running state." ) ] ~name:"clean_shutdown" ~doc: "Attempt to cleanly shutdown the specified VM. (Note: this may not be \ - supported---e.g. if a guest agent is not installed). This can only be \ - called when the specified VM is in the Running state." + supported, for example, if a guest agent is not installed). This can \ + only be called when the specified VM is in the Running state." ~params:[(Ref _vm, "vm", "The VM to shutdown")] ~errs: [ @@ -1192,15 +1193,15 @@ let cleanReboot = ( Published , rel_rio , "Attempt to cleanly shutdown the specified VM (Note: this may not be \ - supported---e.g. if a guest agent is not installed). This can only \ - be called when the specified VM is in the Running state." + supported, for example, if a guest agent is not installed). This \ + can only be called when the specified VM is in the Running state." ) ] ~name:"clean_reboot" ~doc: "Attempt to cleanly shutdown the specified VM (Note: this may not be \ - supported---e.g. if a guest agent is not installed). This can only be \ - called when the specified VM is in the Running state." + supported, for example, if a guest agent is not installed). This can \ + only be called when the specified VM is in the Running state." ~params:[(Ref _vm, "vm", "The VM to shutdown")] ~errs: [ @@ -1392,8 +1393,8 @@ let resume = ; ( Bool , "force" , "Attempt to force the VM to resume. If this flag is false then the \ - VM may fail pre-resume safety checks (e.g. if the CPU the VM was \ - running on looks substantially different to the current one)" + VM may fail pre-resume safety checks (for example, if the CPU the \ + VM was running on looks substantially different to the current one)" ) ] ~errs: @@ -1426,8 +1427,8 @@ let resume_on = ; ( Bool , "force" , "Attempt to force the VM to resume. If this flag is false then the \ - VM may fail pre-resume safety checks (e.g. if the CPU the VM was \ - running on looks substantially different to the current one)" + VM may fail pre-resume safety checks (for example, if the CPU the \ + VM was running on looks substantially different to the current one)" ) ] ~errs: @@ -3116,7 +3117,7 @@ let t = ~lifecycle:[(Published, rel_ely, "")] ~default_value:(Some (VBool false)) "requires_reboot" "Indicates whether a VM requires a reboot in order to update its \ - configuration, e.g. its memory allocation." + configuration, for example, its memory allocation." ; field ~qualifier:StaticRO ~ty:String ~lifecycle: [ @@ -3158,14 +3159,15 @@ let t = ( Published , "1.303.0" , "The set of pending mandatory guidances after applying \ - updates, which must be applied, as otherwise there may be \ - e.g. VM failures" + updates, which must be applied, otherwise there may be, for \ + example, VM failures" ) ] ~ty:(Set update_guidances) "pending_guidances" ~default_value:(Some (VSet [])) "The set of pending mandatory guidances after applying updates, \ - which must be applied, as otherwise there may be e.g. VM failures" + which must be applied, otherwise there may be, for example, VM \ + failures" ; field ~qualifier:DynamicRO ~internal_only:true ~lifecycle:[(Prototyped, "23.18.0", ""); (Removed, "23.24.0", "")] ~ty:(Set update_guidances) "recommended_guidances" @@ -3179,9 +3181,9 @@ let t = ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set update_guidances) "pending_guidances_full" ~default_value:(Some (VSet [])) "The set of pending full guidances after applying updates, which a \ - user should follow to make some updates, e.g. specific hardware \ - drivers or CPU features, fully effective, but the 'average user' \ - doesn't need to" + user should follow to make some updates, for example, specific \ + hardware drivers or CPU features, fully effective, but the \ + 'average user' doesn't need to" ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set (Ref _vm_group)) "groups" "VM groups associated with the VM" ] diff --git a/ocaml/idl/markdown_backend.ml b/ocaml/idl/markdown_backend.ml index 9018c009df8..f8c47c73e11 100644 --- a/ocaml/idl/markdown_backend.ml +++ b/ocaml/idl/markdown_backend.ml @@ -43,41 +43,41 @@ let compare_case_ins x y = compare (String.lowercase_ascii x) (String.lowercase_ascii y) let escape s = - let esc_char = function + let replace = function | '\\' -> - "\" + Some "\" | '*' -> - "*" + Some "*" | '_' -> - "_" + Some "_" | '{' -> - "{" + Some "{" | '}' -> - "}" + Some "}" | '[' -> - "[" + Some "[" | ']' -> - "]" + Some "]" | '(' -> - "(" + Some "(" | ')' -> - ")" + Some ")" | '>' -> - ">" + Some ">" | '<' -> - "<" + Some "<" | '#' -> - "#" + Some "#" | '+' -> - "+" + Some "+" | '-' -> - "-" + Some "-" | '!' -> - "!" - | c -> - String.make 1 c + Some "!" + | _ -> + None in - String.to_seq s |> Seq.map esc_char |> List.of_seq |> String.concat "" + Xapi_stdext_std.Xstringext.String.replaced ~replace s let rec of_ty_verbatim = function | SecretString | String -> diff --git a/ocaml/idl/ocaml_backend/dune b/ocaml/idl/ocaml_backend/dune index f3273fe5c6d..6304d72729c 100644 --- a/ocaml/idl/ocaml_backend/dune +++ b/ocaml/idl/ocaml_backend/dune @@ -4,8 +4,6 @@ (libraries astring cmdliner - fmt - ptime.clock uuidm xapi-consts xapi-datamodel diff --git a/ocaml/idl/ocaml_backend/gen_rbac.ml b/ocaml/idl/ocaml_backend/gen_rbac.ml index 5ce8c0abb90..b6a40b78581 100644 --- a/ocaml/idl/ocaml_backend/gen_rbac.ml +++ b/ocaml/idl/ocaml_backend/gen_rbac.ml @@ -34,13 +34,10 @@ let internal_role_local_root = "_local_root_" (* the output of this function is used as input by the automatic tests *) let writer_csv static_permissions_roles = - let now = - let now = Ptime_clock.now () in - let str = Fmt.str "%a" Ptime.(pp_rfc3339 ~frac_s:3 ~tz_offset_s:0 ()) now in - (* remove separators between Year, Month, and Day; to keep old logging format *) - Astring.String.filter (function '-' -> false | _ -> true) str - in - Printf.sprintf "%s,PERMISSION/ROLE,%s\n" now + Printf.sprintf "%s,PERMISSION/ROLE,%s\n" + (let t = Debug.gettimestring () in + String.sub t 0 (String.length t - 1) + ) (* role titles are ordered by roles in roles_all *) (List.fold_left (fun rr r -> rr ^ r ^ ",") "" Datamodel_roles.roles_all) ^ List.fold_left @@ -83,11 +80,10 @@ let role_uuid name = Option.get (hash2uuid name) let permission_description = "A basic permission" let permission_name wire_name = - let open Xapi_stdext_std in let s1 = replace_char (Printf.sprintf "permission_%s" wire_name) '.' '_' in let s2 = replace_char s1 '/' '_' in - let s3 = Xstringext.String.replace "*" "WILDCHAR" s2 in - Xstringext.String.replace ":" "_" s3 + let s3 = Xapi_stdext_std.Xstringext.String.replace '*' ~by:"WILDCHAR" s2 in + replace_char s3 ':' '_' let permission_index = ref 0 diff --git a/ocaml/idl/ocaml_backend/gen_server.ml b/ocaml/idl/ocaml_backend/gen_server.ml index 9d0f512ab6c..83d8b29a231 100644 --- a/ocaml/idl/ocaml_backend/gen_server.ml +++ b/ocaml/idl/ocaml_backend/gen_server.ml @@ -465,7 +465,7 @@ let gen_module api : O.Module.t = ~params: [ O.Anon (Some "http_req", "Http.Request.t") - ; O.Anon (Some "fd", "Unix.file_descr") + ; O.Anon (Some "fd", "Unix.file_descr option") ; O.Anon (Some "call", "Rpc.call") ] ~ty:"response" diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index c963c8f116b..5c769fe6856 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "32bbba07579ca8844fa6162164530268" +let last_known_schema_hash = "87b39cf2131c990f186bb6baa6e5ece8" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/libs/http-lib/dune b/ocaml/libs/http-lib/dune index 23b76736fc9..b6cc6f699c7 100644 --- a/ocaml/libs/http-lib/dune +++ b/ocaml/libs/http-lib/dune @@ -63,6 +63,7 @@ xapi-log.backtrace xapi-log xapi-stdext-pervasives + xapi-stdext-std xapi-stdext-threads xapi-stdext-unix)) diff --git a/ocaml/libs/http-lib/http_svr.ml b/ocaml/libs/http-lib/http_svr.ml index ded971ad7da..ff97bc3db36 100644 --- a/ocaml/libs/http-lib/http_svr.ml +++ b/ocaml/libs/http-lib/http_svr.ml @@ -340,28 +340,22 @@ module Server = struct x.handlers [] end -let escape str = - (* from xapi-stdext-std xstringext *) - let escaped ~rules string = - let aux h t = - ( if List.mem_assoc h rules then - List.assoc h rules - else - Astring.String.of_char h +let escape_html str = + Xapi_stdext_std.Xstringext.String.replaced + ~replace:(function + | '<' -> + Some "<" + | '>' -> + Some ">" + | '\'' -> + Some "'" + | '"' -> + Some """ + | '&' -> + Some "&" + | _ -> + None ) - :: t - in - String.concat "" (Astring.String.fold_right aux string []) - in - escaped - ~rules: - [ - ('<', "<") - ; ('>', ">") - ; ('\'', "'") - ; ('"', """) - ; ('&', "&") - ] str exception Generic_error of string @@ -518,7 +512,7 @@ let read_request ?proxy_seen ~read_timeout ~total_timeout ~max_length fd = ) | exc -> response_internal_error exc fd - ~extra:(escape (Printexc.to_string exc)) + ~extra:(escape_html (Printexc.to_string exc)) ) ; (None, None) @@ -567,7 +561,7 @@ let handle_one (x : 'a Server.t) ss context req = ) | exc -> response_internal_error ~req exc ss - ~extra:(escape (Printexc.to_string exc)) + ~extra:(escape_html (Printexc.to_string exc)) ) ; !finished diff --git a/ocaml/libs/http-lib/http_svr.mli b/ocaml/libs/http-lib/http_svr.mli index 432cfdd082d..0aae32467f8 100644 --- a/ocaml/libs/http-lib/http_svr.mli +++ b/ocaml/libs/http-lib/http_svr.mli @@ -49,8 +49,8 @@ end exception Generic_error of string -val escape : string -> string -(** [escape str] escapes HTML/XML special characters in [str] for safe inclusion in HTML/XML content. *) +val escape_html : string -> string +(** [escape_html str] escapes HTML/XML special characters in [str] for safe inclusion in HTML/XML content. *) type socket diff --git a/ocaml/libs/log/debug.ml b/ocaml/libs/log/debug.ml index a975dc6e71b..dbaa6090159 100644 --- a/ocaml/libs/log/debug.ml +++ b/ocaml/libs/log/debug.ml @@ -74,8 +74,13 @@ let tasks : task ThreadLocalTable.t = ThreadLocalTable.make () let names : string ThreadLocalTable.t = ThreadLocalTable.make () let gettimestring () = - let now = Ptime_clock.now () in - Fmt.str "%a|" Ptime.(pp_rfc3339 ~frac_s:3 ~tz_offset_s:0 ()) now + let time = Unix.gettimeofday () in + let tm = Unix.gmtime time in + let msec = time -. floor time in + Printf.sprintf "%d%.2d%.2dT%.2d:%.2d:%.2d.%.3dZ|" (1900 + tm.Unix.tm_year) + (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min + tm.Unix.tm_sec + (int_of_float (1000.0 *. msec)) (** [escape str] efficiently escapes non-printable characters and in addition the backslash character. The function is efficient in the sense that it will diff --git a/ocaml/libs/log/debug.mli b/ocaml/libs/log/debug.mli index 0c5178b293c..64deb52838e 100644 --- a/ocaml/libs/log/debug.mli +++ b/ocaml/libs/log/debug.mli @@ -34,6 +34,9 @@ val set_remote_context : string option -> unit module type BRAND = sig val name : string end +val gettimestring : unit -> string +(** The current time of day in a format suitable for logging *) + val set_facility : Syslog.facility -> unit (** Set the syslog facility that will be used by this program. *) diff --git a/ocaml/libs/log/dune b/ocaml/libs/log/dune index b749c5ad500..caeac508524 100644 --- a/ocaml/libs/log/dune +++ b/ocaml/libs/log/dune @@ -10,8 +10,6 @@ fmt mtime logs - ptime - ptime.clock threads.posix unix xapi-log.backtrace diff --git a/ocaml/libs/sexpr/sExpr.ml b/ocaml/libs/sexpr/sExpr.ml index 2793599aa14..01d789b6a44 100644 --- a/ocaml/libs/sexpr/sExpr.ml +++ b/ocaml/libs/sexpr/sExpr.ml @@ -27,7 +27,7 @@ let is_escape_char = function '\\' | '\'' -> true | _ -> false (* XXX: This escapes "'c'" and "\'c\'" to "\\'c\\'". * They are both unescaped as "'c'". They have been ported * to make sure that this corner case is left unchanged. - * It is worth investigating the use of + * It is worth investigating the use of * - Astring.String.Ascii.escape_string * - Astring.String.Ascii.unescape * that have guaranteed invariants and optimised performances *) diff --git a/ocaml/libs/tgroup/dune b/ocaml/libs/tgroup/dune index 6c152a5c2ef..12070176651 100644 --- a/ocaml/libs/tgroup/dune +++ b/ocaml/libs/tgroup/dune @@ -2,7 +2,7 @@ (name tgroup) (modules tgroup) (public_name tgroup) - (libraries unix xapi-log xapi-stdext-unix xapi-stdext-std)) + (libraries astring unix xapi-log xapi-stdext-unix)) (test (name test_tgroup) diff --git a/ocaml/libs/tgroup/tgroup.ml b/ocaml/libs/tgroup/tgroup.ml index 84a02d04f1c..f95c0992788 100644 --- a/ocaml/libs/tgroup/tgroup.ml +++ b/ocaml/libs/tgroup/tgroup.ml @@ -70,8 +70,7 @@ module Group = struct | _ -> false - let sanitize s = - Xapi_stdext_std.Xstringext.String.filter_chars s is_alphanum + let sanitize s = Astring.String.filter is_alphanum s let make ?user_agent subject_sid = let user_agent = diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/bench/bench_xstringext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/bench/bench_xstringext.ml index fcd7b6a7e72..ffd640215b1 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/bench/bench_xstringext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/bench/bench_xstringext.ml @@ -8,36 +8,42 @@ let make_string len = String.init len (fun i -> Char.chr (33 + (i mod 94))) let escape_rules = [('a', "[A]"); ('e', "[E]"); ('i', "[I]"); ('o', "[O]"); ('u', "[U]")] -(* Reference implementation from xstringext_test.ml *) -let escaped_spec ?rules string = - match rules with - | None -> - String.escaped string - | Some rules -> - let apply_rules char = - match List.assoc_opt char rules with - | None -> - Seq.return char - | Some replacement -> - String.to_seq replacement - in - string |> String.to_seq |> Seq.concat_map apply_rules |> String.of_seq +let replace = function + | 'a' -> + Some "[A]" + | 'e' -> + Some "[E]" + | 'i' -> + Some "[I]" + | 'o' -> + Some "[O]" + | 'u' -> + Some "[U]" + | _ -> + None + +(* Reference implementation using lists *) +let replaced_spec ~rules string = + let apply_rules char = List.assoc_opt char rules in + XString.replaced ~replace:apply_rules string -let escaped_benchmark n = +let replaced ~rules string = XString.replaced ~replace:rules string + +let replaced_benchmark n = let s = make_string n in - Staged.stage @@ fun () -> ignore (XString.escaped ~rules:escape_rules s) + Staged.stage @@ fun () -> ignore (replaced ~rules:replace s) -let escaped_spec_benchmark n = +let replaced_spec_benchmark n = let s = make_string n in - Staged.stage @@ fun () -> ignore (escaped_spec ~rules:escape_rules s) + Staged.stage @@ fun () -> ignore (replaced_spec ~rules:escape_rules s) -let test_escaped = - Test.make_indexed ~name:"escaped" ~fmt:"%s %d" ~args:[100; 500; 1000] - escaped_benchmark +let test_replaced = + Test.make_indexed ~name:"replaced" ~fmt:"%s %d" ~args:[100; 500; 1000] + replaced_benchmark -let test_escaped_spec = - Test.make_indexed ~name:"escaped-spec" ~fmt:"%s %d" ~args:[100; 500; 1000] - escaped_spec_benchmark +let test_replaced_spec = + Test.make_indexed ~name:"replaced-spec" ~fmt:"%s %d" ~args:[100; 500; 1000] + replaced_spec_benchmark let benchmark () = let ols = @@ -50,8 +56,8 @@ let benchmark () = Benchmark.cfg ~limit:2000 ~quota:(Time.second 0.5) ~kde:(Some 1000) () in let test = - Test.make_grouped ~name:"escaped-comparison" - [test_escaped; test_escaped_spec] + Test.make_grouped ~name:"replaced-comparison" + [test_replaced; test_replaced_spec] in let raw_results = Benchmark.all cfg instances test in let results = @@ -97,8 +103,10 @@ let () = List.iter (fun size -> Printf.printf "String size %s:\n" size ; - let opt_test = Printf.sprintf "escaped-comparison/escaped %s" size in - let ref_test = Printf.sprintf "escaped-comparison/escaped-spec %s" size in + let opt_test = Printf.sprintf "replaced-comparison/replaced %s" size in + let ref_test = + Printf.sprintf "replaced-comparison/replaced-spec %s" size + in match (get_timing opt_test, get_timing ref_test) with | Some opt_time, Some ref_time -> let improvement = (ref_time -. opt_time) /. ref_time *. 100.0 in diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml index 3959e612d10..349719aa53e 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml @@ -40,7 +40,17 @@ module List = struct inv_assoc k t (* Tail-recursive map. *) - let map_tr f l = rev (rev_map f l) + + let[@tail_mod_cons] rec map_tr f l = + match l with + | [] -> + [] + | [x] -> + [f x] + | x1 :: x2 :: xs -> + let fx1 = f x1 in + let fx2 = f x2 in + fx1 :: fx2 :: map_tr f xs let count pred l = fold_left diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml index c9936997b3a..36c550d9476 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml @@ -12,89 +12,18 @@ * GNU Lesser General Public License for more details. *) module String = struct - include String - - let of_char c = String.make 1 c - - let rev_map f string = - let n = length string in - String.init n (fun i -> f string.[n - i - 1]) - - let rev_iter f string = - for i = length string - 1 downto 0 do - f string.[i] - done - - let fold_left f accu string = - let accu = ref accu in - for i = 0 to length string - 1 do - accu := f !accu string.[i] - done ; - !accu - - let fold_right f string accu = - let accu = ref accu in - for i = length string - 1 downto 0 do - accu := f string.[i] !accu - done ; - !accu - - (** Returns true for whitespace characters, false otherwise *) - let isspace = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false - - let split_f p str = - let split_one seq = - let not_p c = not (p c) in - let a = Seq.take_while not_p seq in - let b = Seq.drop_while not_p seq in - (a, b) - in - let drop seq = Seq.drop_while p seq in - let rec split acc chars = - if Seq.is_empty chars then - acc - else - let a, b = split_one chars in - let b = drop b in - let acc = - if Seq.is_empty a then - acc - else - Seq.cons a acc - in - split acc b - in - String.to_seq str - |> split Seq.empty - |> Seq.map String.of_seq - |> List.of_seq - |> List.rev - - let index_opt s c = - let rec loop i = - if String.length s = i then - None - else if s.[i] = c then - Some i - else - loop (i + 1) - in - loop 0 + let sub_to_end s start = + let length = String.length s in + String.sub s start (length - start) - let rec split ?(limit = -1) c s = - let i = match index_opt s c with Some x -> x | None -> -1 in - let nlimit = - if limit = -1 || limit = 0 then - limit - else - limit - 1 - in - if i = -1 || nlimit = 0 then - [s] - else - let a = String.sub s 0 i - and b = String.sub s (i + 1) (String.length s - i - 1) in - a :: split ~limit:nlimit c b + let rec split ~limit sep s = + match (String.index_opt s sep, limit < 2) with + | None, _ | _, true -> + [s] + | Some pos, false -> + let first = String.sub s 0 pos in + let rest = sub_to_end s (pos + 1) in + first :: split ~limit:(limit - 1) sep rest let rtrim s = let n = String.length s in @@ -103,73 +32,6 @@ module String = struct else s - (** has_substr str sub returns true if sub is a substring of str. Simple, naive, slow. *) - let has_substr str sub = - if String.length sub > String.length str then - false - else - let result = ref false in - for start = 0 to String.length str - String.length sub do - if String.sub str start (String.length sub) = sub then result := true - done ; - !result - - (** find all occurences of needle in haystack and return all their respective index *) - let find_all needle haystack = - let m = String.length needle and n = String.length haystack in - if m > n then - [] - else - let i = ref 0 and found = ref [] in - while !i < n - m + 1 do - if String.sub haystack !i m = needle then ( - found := !i :: !found ; - i := !i + m - ) else - incr i - done ; - List.rev !found - - (* replace all @f substring in @s by @t *) - let replace f t s = - let indexes = find_all f s in - let n = List.length indexes in - if n > 0 then ( - let len_f = String.length f and len_t = String.length t in - let new_len = String.length s + (n * len_t) - (n * len_f) in - let new_b = Bytes.make new_len '\000' in - let orig_offset = ref 0 and dest_offset = ref 0 in - List.iter - (fun h -> - let len = h - !orig_offset in - Bytes.blit_string s !orig_offset new_b !dest_offset len ; - Bytes.blit_string t 0 new_b (!dest_offset + len) len_t ; - orig_offset := !orig_offset + len + len_f ; - dest_offset := !dest_offset + len + len_t - ) - indexes ; - Bytes.blit_string s !orig_offset new_b !dest_offset - (String.length s - !orig_offset) ; - Bytes.unsafe_to_string new_b - ) else - s - - let filter_chars s valid = - let badchars = ref false in - let buf = Buffer.create 0 in - for i = 0 to String.length s - 1 do - if !badchars then ( - if valid s.[i] then Buffer.add_char buf s.[i] - ) else if not (valid s.[i]) then ( - Buffer.add_substring buf s 0 i ; - badchars := true - ) - done ; - if !badchars then - Buffer.contents buf - else - s - let map_unlikely s f = let changed = ref false in let m = ref 0 in @@ -190,18 +52,15 @@ module String = struct ) else s - let escaped ?rules s = - match rules with - | None -> - String.escaped s - | Some rules -> - map_unlikely s (fun c -> List.assoc_opt c rules) - - let sub_to_end s start = - let length = String.length s in - String.sub s start (length - start) - - let sub_before c s = String.sub s 0 (String.index s c) + let replace char ~by s = + let replaceable = Stdlib.Char.equal char in + let get_replacement c = + if replaceable c then + Some by + else + None + in + map_unlikely s get_replacement - let sub_after c s = sub_to_end s (String.index s c + 1) + let replaced ~replace s = map_unlikely s replace end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli index 1f27490493d..62a1053d883 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli @@ -12,63 +12,21 @@ * GNU Lesser General Public License for more details. *) module String : sig - include module type of String + val replaced : replace:(char -> string option) -> string -> string + (** [replaced ~replacement str] applies [replace] to all characters in [str] + and when it returns [Some rep] the character is replaced with [rep] in + the resulting string *) - val of_char : char -> string + val replace : char -> by:string -> string -> string + (** [replace ch ~by s] replaces all the occurrences of [ch] in [s] by [~by] + *) - val rev_map : (char -> char) -> string -> string - (** Map a string to a string, applying the given function in reverse - order. *) - - val rev_iter : (char -> unit) -> string -> unit - (** Iterate over the characters in a string in reverse order. *) - - val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a - (** Fold over the characters in a string. *) - - val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a - (** Iterate over the characters in a string in reverse order. *) - - val isspace : char -> bool - (** True if the character is whitespace *) - - val escaped : ?rules:(char * string) list -> string -> string - (** Backward-compatible string escaping, defaulting to the built-in - OCaml string escaping but allowing an arbitrary mapping from characters - to strings. *) - - val split_f : (char -> bool) -> string -> string list - (** Take a predicate and a string, return a list of strings separated by - runs of characters where the predicate was true. Avoid if possible, it's - very costly to execute. *) - - val split : ?limit:int -> char -> string -> string list + val split : limit:int -> char -> string -> string list (** split a string on a single char *) val rtrim : string -> string (** FIXME document me|remove me if similar to strip *) - val has_substr : string -> string -> bool - (** True if sub is a substr of str *) - - val find_all : string -> string -> int list - (** find all occurences of needle in haystack and return all their respective index *) - - val replace : string -> string -> string -> string - (** replace all [f] substring in [s] by [t] *) - - val filter_chars : string -> (char -> bool) -> string - (** filter chars from a string *) - - val map_unlikely : string -> (char -> string option) -> string - (** map a string trying to fill the buffer by chunk *) - val sub_to_end : string -> int -> string (** a substring from the specified position to the end of the string *) - - val sub_before : char -> string -> string - (** a substring from the start of the string to the first occurrence of a given character, excluding the character *) - - val sub_after : char -> string -> string - (** a substring from the first occurrence of a given character to the end of the string, excluding the character *) end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml index 9b7eb2674a1..2505be96a0b 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml @@ -13,10 +13,6 @@ module XString = Xapi_stdext_std.Xstringext.String -let test_boolean tested_f (name, case, expected) = - let check () = Alcotest.(check bool) name expected (tested_f case) in - (name, `Quick, check) - let test_string tested_f (name, case, expected) = let check () = Alcotest.(check string) name expected (tested_f case) in (name, `Quick, check) @@ -27,47 +23,14 @@ let test_list tested_f (name, case, expected) = in (name, `Quick, check) -let test_rev_map = - let spec_rev = [("", ""); ("foo bar", "rab oof")] in - let spec_func = [("id", Fun.id); ("uppercase_ascii", Char.uppercase_ascii)] in - let test (f_name, f) (case, expected) = - let expected = String.map f expected in - let name = - Printf.sprintf {|"%s" produces "%s" (%s)|} case expected f_name - in - test_string (XString.rev_map f) (name, case, expected) - in - let tests = - (* Generate the product of the two lists to generate the tests *) - List.concat_map (fun func -> List.map (test func) spec_rev) spec_func - in - ("rev_map", tests) - let test_split = - let test ?limit (splitter, splitted, expected) = - let split, name = - match limit with - | None -> - let name = Printf.sprintf {|'%c' splits "%s"|} splitter splitted in - (* limit being set to -1 is the same as not using the parameter *) - let split = XString.split ~limit:(-1) in - (split, name) - | Some limit -> - let name = - Printf.sprintf {|'%c' splits "%s" with limit %i|} splitter splitted - limit - in - let split = XString.split ~limit in - (split, name) + let test limit (splitter, splitted, expected) = + let split = XString.split ~limit in + let name = + Printf.sprintf {|'%c' splits "%s" with limit %i|} splitter splitted limit in test_list (split splitter) (name, splitted, expected) in - let specs_no_limit = - [ - ('.', "...", [""; ""; ""; ""]); ('.', "foo.bar.baz", ["foo"; "bar"; "baz"]) - ] - in - let tests_no_limit = List.map test specs_no_limit in let specs_limit = [ (0, [('.', "...", ["..."]); ('.', "foo.bar.baz", ["foo.bar.baz"])]) @@ -82,50 +45,12 @@ let test_split = ; (4, [('.', "...", [""; ""; ""; ""])]) ] in - let tests_limit = + let tests = List.concat_map - (fun (limit, spec) -> List.map (test ~limit) spec) + (fun (limit, spec) -> List.map (test limit) spec) specs_limit in - ("split", List.concat [tests_no_limit; tests_limit]) - -let test_split_f = - let specs = - [ - (XString.isspace, "foo bar", ["foo"; "bar"]) - ; (XString.isspace, "foo bar", ["foo"; "bar"]) - ; (XString.isspace, "foo \n\t\r bar", ["foo"; "bar"]) - ; (XString.isspace, " foo bar ", ["foo"; "bar"]) - ; (XString.isspace, "", []) - ; (XString.isspace, " ", []) - ] - in - let test (splitter, splitted, expected) = - let name = Printf.sprintf {|"%s"|} (String.escaped splitted) in - test_list (XString.split_f splitter) (name, splitted, expected) - in - let tests = List.map test specs in - ("split_f", tests) - -let test_has_substr = - let spec = - [ - ("", "", true) - ; ("", "foo bar", true) - ; ("f", "foof", true) - ; ("foofo", "foof", false) - ; ("foof", "foof", true) - ; ("f", "foof", true) - ; ("fo", "foof", true) - ; ("of", "foof", true) - ; ("ff", "foof", false) - ] - in - let test (contained, container, expected) = - let name = Printf.sprintf {|"%s" in "%s"|} contained container in - test_boolean (XString.has_substr container) (name, contained, expected) - in - ("has_substr", List.map test spec) + ("split", tests) let test_rtrim = let spec = @@ -147,49 +72,27 @@ let test_rtrim = in ("rtrim", List.map test spec) -(** Simple implementation of escaped for testing against *) -let escaped_spec ?rules string = - match rules with - | None -> - String.escaped string - | Some rules -> - let apply_rules char = - match List.assoc_opt char rules with - | None -> - Seq.return char - | Some replacement -> - String.to_seq replacement - in - string |> String.to_seq |> Seq.concat_map apply_rules |> String.of_seq - -let test_escaped = - let open QCheck2 in - (* Generator for escape rules: list of (char, string) mappings *) - let gen_rules = - let open Gen in - let gen_rule = pair char (string_size (int_range 0 5) ~gen:char) in - list gen_rule - in - (* Generator for test input: string and optional rules *) - let gen_input = Gen.pair Gen.string (Gen.opt gen_rules) in - let property (s, rules) = - let expected = escaped_spec ?rules s in - let actual = XString.escaped ?rules s in - String.equal expected actual +let test_replace = + let spec = + [ + (('*', "WILDCHAR", ""), "") + ; (('*', "", "*"), "") + ; (('*', "WILDCHAR", "*"), "WILDCHAR") + ; (('*', "WILDCHAR", "**"), "WILDCHARWILDCHAR") + ; (('*', "WILDCHAR", "***"), "WILDCHARWILDCHARWILDCHAR") + ; (('"', "", ""), "") + ; (('"', "", "a"), "a") + ; (('"', "", {|"a"|}), "a") + ; (('"', "", {|a"a|}), "aa") + ] in - let test = - Test.make ~name:"escaped matches reference implementation" ~count:1000 - gen_input property + let test ((char, by, case), expected) = + let name = + Printf.sprintf "replace '%c' by %S in %S is %S" char (String.escaped by) + (String.escaped case) (String.escaped expected) + in + test_string (XString.replace char ~by) (name, case, expected) in - ("escaped", [QCheck_alcotest.to_alcotest test]) + ("replace", List.map test spec) -let () = - Alcotest.run "Xstringext" - [ - test_rev_map - ; test_split - ; test_split_f - ; test_has_substr - ; test_rtrim - ; test_escaped - ] +let () = Alcotest.run "Xstringext" [test_split; test_rtrim; test_replace] diff --git a/ocaml/libs/xml-light2/dune b/ocaml/libs/xml-light2/dune index a36111de5a2..980d70badcd 100644 --- a/ocaml/libs/xml-light2/dune +++ b/ocaml/libs/xml-light2/dune @@ -1,20 +1,12 @@ (library - (name xmllight2) - (public_name xml-light2) - (modules xml) - (wrapped false) - (libraries - threads - xmlm - ) -) + (name xmllight2) + (public_name xml-light2) + (modules xml) + (wrapped false) + (libraries threads xapi-stdext-std xmlm)) (executable - (modes exe) - (name xmlpp) - (modules xmlpp) - (libraries - xml-light2 - ) -) - + (modes exe) + (name xmlpp) + (modules xmlpp) + (libraries xml-light2)) diff --git a/ocaml/libs/xml-light2/xml.ml b/ocaml/libs/xml-light2/xml.ml index 455f449b7fc..35be8467791 100644 --- a/ocaml/libs/xml-light2/xml.ml +++ b/ocaml/libs/xml-light2/xml.ml @@ -42,11 +42,7 @@ let _ = (* internal parse function *) let is_empty xml = let is_empty_string s = - let is_empty = ref true in - for i = 0 to String.length s - 1 do - if s.[i] <> '\n' && s.[i] <> ' ' && s.[i] <> '\t' then is_empty := false - done ; - !is_empty + String.for_all (function '\n' | ' ' | '\t' -> true | _ -> false) s in match xml with PCData data when is_empty_string data -> true | _ -> false @@ -54,7 +50,9 @@ let _parse i = let el (tag : Xmlm.tag) (children : xml list) : xml = let name_local = snd (fst tag) in let attrs' = - List.map (fun (nameattr, str) -> (snd nameattr, str)) (snd tag) + Xapi_stdext_std.Listext.List.map_tr + (fun (nameattr, str) -> (snd nameattr, str)) + (snd tag) in Element (name_local, attrs', List.filter (fun xml -> not (is_empty xml)) children) @@ -93,28 +91,24 @@ let parse_string s = let esc_pcdata data = let buf = Buffer.create (String.length data + 10) in String.iter - (fun c -> - let s = - match c with - | '>' -> - ">" - | '<' -> - "<" - | '&' -> - "&" - | '"' -> - """ - | c - when (c >= '\x20' && c <= '\xff') - || c = '\x09' - || c = '\x0a' - || c = '\x0d' -> - String.make 1 c - | _ -> - "" - in - Buffer.add_string buf s - ) + (function + | '>' -> + Buffer.add_string buf ">" + | '<' -> + Buffer.add_string buf "<" + | '&' -> + Buffer.add_string buf "&" + | '"' -> + Buffer.add_string buf """ + | c + when (c >= '\x20' && c <= '\xff') + || c = '\x09' + || c = '\x0a' + || c = '\x0d' -> + Buffer.add_char buf c + | _ -> + () + ) data ; Buffer.contents buf @@ -139,9 +133,7 @@ let to_fct xml f = let astr = str_of_attrs attrs in let on = fmt "<%s%s>" name astr in let off = fmt "" name in - f on ; - List.iter (fun child -> print child) children ; - f off + f on ; List.iter print children ; f off | PCData data -> f (esc_pcdata data) in @@ -213,22 +205,3 @@ let to_string_fmt xml = to_fct_fmt xml (fun s -> Buffer.add_string buffer s) ; let s = Buffer.contents buffer in Buffer.reset buffer ; s - -(* helpers functions *) -exception Not_pcdata of string - -exception Not_element of string - -let pcdata = function PCData x -> x | e -> raise (Not_pcdata (to_string e)) - -let children = function - | Element (_, _, c) -> - c - | e -> - raise (Not_element (to_string e)) - -let tag = function - | Element (x, _, _) -> - x - | e -> - raise (Not_element (to_string e)) diff --git a/ocaml/libs/xml-light2/xml.mli b/ocaml/libs/xml-light2/xml.mli index 9b5ccd79b02..e472e41e3a7 100644 --- a/ocaml/libs/xml-light2/xml.mli +++ b/ocaml/libs/xml-light2/xml.mli @@ -32,22 +32,6 @@ val parse_in : in_channel -> xml val parse_string : string -> xml -val to_fct : xml -> (string -> unit) -> unit -(** output functions *) - -val to_fct_fmt : xml -> (string -> unit) -> unit - val to_string : xml -> string val to_string_fmt : xml -> string - -(** helper functions *) -exception Not_pcdata of string - -exception Not_element of string - -val pcdata : xml -> string - -val children : xml -> xml list - -val tag : xml -> string diff --git a/ocaml/quicktest/qt.ml b/ocaml/quicktest/qt.ml index 13a9c8c1e51..4b3e7a64ead 100644 --- a/ocaml/quicktest/qt.ml +++ b/ocaml/quicktest/qt.ml @@ -192,20 +192,25 @@ module VDI = struct let test_vdi_name_description = "VDI for storage quicktest" - let make rpc session_id ?(virtual_size = 4194304L) sR = + let make rpc session_id ?(virtual_size = Int64.(mul (mul 4L 1024L) 1024L)) + ?backing_format sR = + let sm_config = + match backing_format with Some x -> [("image-format", x)] | None -> [] + in Client.Client.VDI.create ~sR ~session_id ~rpc ~name_label:test_vdi_name_label ~name_description:test_vdi_name_description ~_type:`user ~sharable:false ~read_only:false ~virtual_size ~xenstore_data:[] ~other_config:[] ~tags:[] - ~sm_config:[] + ~sm_config let with_destroyed rpc session_id self f = Xapi_stdext_pervasives.Pervasiveext.finally f (fun () -> Client.Client.VDI.destroy ~rpc ~session_id ~self ) - let with_new rpc session_id ?(virtual_size = 4194304L) sr f = - let self = make rpc session_id ~virtual_size sr in + let with_new rpc session_id ?(virtual_size = Int64.(mul (mul 4L 1024L) 1024L)) + ?backing_format sr f = + let self = make rpc session_id ~virtual_size ?backing_format sr in with_destroyed rpc session_id self (fun () -> f self) let with_any rpc session_id sr_info f = diff --git a/ocaml/quicktest/qt.mli b/ocaml/quicktest/qt.mli index aaa5e211732..48939e58c5b 100644 --- a/ocaml/quicktest/qt.mli +++ b/ocaml/quicktest/qt.mli @@ -75,6 +75,7 @@ module VDI : sig rpc -> API.ref_session -> ?virtual_size:int64 + -> ?backing_format:string -> API.ref_SR -> (API.ref_VDI -> 'a) -> 'a diff --git a/ocaml/quicktest/quicktest_http.ml b/ocaml/quicktest/quicktest_http.ml index f8d56ba6380..82827926148 100644 --- a/ocaml/quicktest/quicktest_http.ml +++ b/ocaml/quicktest/quicktest_http.ml @@ -34,7 +34,7 @@ module Uds = struct with_channel_aux fd func let http_response_code d = - match Xapi_stdext_std.Xstringext.String.split ' ' d with + match String.split_on_char ' ' d with | _ :: code :: _ -> int_of_string code | _ -> @@ -102,7 +102,7 @@ module Cookies = struct match body with | first_line :: _ -> D.warn "expected = [%s]; received = [%s]" expected first_line ; - Xapi_stdext_std.Xstringext.String.has_substr first_line expected + Astring.String.is_infix ~affix:expected first_line | _ -> false in @@ -213,9 +213,7 @@ module HTML_Escaping = struct let bad_command_exp = "<>'\\"&" let html_escaping expected cmd = - let check_result b = - Xapi_stdext_std.Xstringext.String.has_substr b expected - in + let check_result = Astring.String.is_infix ~affix:expected in let _, _, _, body = Uds.http_command Xapi_globs.unix_domain_socket cmd in match body with | first_line :: _ -> diff --git a/ocaml/quicktest/quicktest_max_vdi_size.ml b/ocaml/quicktest/quicktest_max_vdi_size.ml index 43e2582abaf..cdddd2b967e 100644 --- a/ocaml/quicktest/quicktest_max_vdi_size.ml +++ b/ocaml/quicktest/quicktest_max_vdi_size.ml @@ -1,6 +1,6 @@ let with_max_vdi rpc session_id sr f = Qt.VDI.with_new rpc session_id ~virtual_size:Constants.max_vhd_size sr - (fun vdi -> + ~backing_format:"vhd" (fun vdi -> (* We write some data to the very end of the VDI to ensure the IO code gets tested with large offsets *) Qt.VDI.with_open rpc session_id vdi `RW (fun fd -> @@ -43,7 +43,8 @@ let test_export_import rpc session_id sr_info () = |> ignore ; Xapi_stdext_pervasives.Pervasiveext.finally (fun () -> - Qt.VDI.with_new rpc session_id ~virtual_size sR (fun new_vdi -> + Qt.VDI.with_new rpc session_id ~virtual_size sR ~backing_format:format + (fun new_vdi -> let new_vdi_uuid = Client.Client.VDI.get_uuid ~rpc ~session_id ~self:new_vdi in diff --git a/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml b/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml index 48657f00a78..7adb16731a7 100644 --- a/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml +++ b/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml @@ -57,13 +57,14 @@ let checksum rpc session_id vdi = Digest.to_hex (Digest.file path) ) -let check_vdi_unchanged rpc session_id ~vdi_size ~prepare_vdi ~vdi_op sr_info () - = +let check_vdi_unchanged rpc session_id ~vdi_size ~prepare_vdi ~vdi_op + ~backing_format sr_info () = let sR = sr_info.Qt.sr in - Qt.VDI.with_new ~virtual_size:vdi_size rpc session_id sR (fun vdi -> + Qt.VDI.with_new ~virtual_size:vdi_size ~backing_format rpc session_id sR + (fun vdi -> prepare_vdi rpc session_id vdi ; let checksum_original = checksum rpc session_id vdi in - let new_vdi = vdi_op rpc session_id sR vdi in + let new_vdi = vdi_op rpc session_id sR vdi backing_format in Qt.VDI.with_destroyed rpc session_id new_vdi (fun () -> let checksum_copy = checksum rpc session_id new_vdi in if checksum_copy <> checksum_original then @@ -77,11 +78,12 @@ let check_vdi_unchanged rpc session_id ~vdi_size ~prepare_vdi ~vdi_op sr_info () ) let check_vdi_delta rpc session_id ~vdi_size ~prepare_vdi ~prepare_vdi_base - ~vdi_op sr_info () = + ~vdi_op ~backing_format sr_info () = let sR = sr_info.Qt.sr in - Qt.VDI.with_new ~virtual_size:vdi_size rpc session_id sR + Qt.VDI.with_new ~virtual_size:vdi_size ~backing_format rpc session_id sR @@ fun vdi_original -> - Qt.VDI.with_new ~virtual_size:vdi_size rpc session_id sR @@ fun base_vdi -> + Qt.VDI.with_new ~virtual_size:vdi_size ~backing_format rpc session_id sR + @@ fun base_vdi -> prepare_vdi rpc session_id vdi_original ; let checksum_original = checksum rpc session_id vdi_original in prepare_vdi_base rpc session_id base_vdi ; @@ -96,7 +98,7 @@ let check_vdi_delta rpc session_id ~vdi_size ~prepare_vdi ~prepare_vdi_base checksum_copy checksum_original ) -let copy_vdi rpc session_id sr vdi = +let copy_vdi rpc session_id sr vdi _ = Client.Client.VDI.copy ~rpc ~session_id ~vdi ~base_vdi:API.Ref.null ~into_vdi:API.Ref.null ~sr @@ -117,14 +119,15 @@ let export_vdi_to_file ~rpc ~session_id ~exportformat ?base_vdi ~vdi () = |> ignore ; file -let create_new_vdi ~rpc ~session_id ~sR ~vdi = +let create_new_vdi ~rpc ~session_id ~sR ~vdi ~backing_format = let virtual_size = Client.Client.VDI.get_virtual_size ~rpc ~session_id ~self:vdi in + let sm_config = [("image-format", backing_format)] in let new_vdi = Client.Client.VDI.create ~rpc ~session_id ~name_label:"" ~name_description:"" ~sR ~virtual_size ~_type:`user ~sharable:false - ~read_only:false ~other_config:[] ~xenstore_data:[] ~sm_config:[] ~tags:[] + ~read_only:false ~other_config:[] ~xenstore_data:[] ~sm_config ~tags:[] in let new_vdi_uuid = Client.Client.VDI.get_uuid ~rpc ~session_id ~self:new_vdi @@ -141,11 +144,13 @@ let import_file_into_vdi ~file ~vdi_uuid ~exportformat = ] |> ignore -let export_import_vdi rpc session_id ~exportformat sR vdi = +let export_import_vdi rpc session_id ~exportformat sR vdi backing_format = let file = export_vdi_to_file ~rpc ~session_id ~exportformat ~vdi () in Xapi_stdext_pervasives.Pervasiveext.finally (fun () -> - let new_vdi_uuid, new_vdi = create_new_vdi ~rpc ~session_id ~sR ~vdi in + let new_vdi_uuid, new_vdi = + create_new_vdi ~rpc ~session_id ~sR ~vdi ~backing_format + in import_file_into_vdi ~file ~vdi_uuid:new_vdi_uuid ~exportformat ; new_vdi ) @@ -177,79 +182,83 @@ let delta_export_import_vhd = export_delta_import_vdi ~exportformat:"vhd" let delta_export_import_qcow = export_delta_import_vdi ~exportformat:"qcow2" -let data_integrity_tests vdi_op op_name = +let data_integrity_tests vdi_op op_name backing_format = [ ( op_name ^ ": small empty VDI" , `Slow - , check_vdi_unchanged ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:noop ~vdi_op + , check_vdi_unchanged + ~vdi_size:Sizes.(4L ** mib) + ~prepare_vdi:noop ~vdi_op ~backing_format ) ; ( op_name ^ ": small random VDI" , `Slow , check_vdi_unchanged ~vdi_size:Sizes.(4L ** mib) - ~prepare_vdi:write_random_data ~vdi_op + ~prepare_vdi:write_random_data ~vdi_op ~backing_format ) ; ( op_name ^ ": small full VDI" , `Slow - , check_vdi_unchanged ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:fill ~vdi_op + , check_vdi_unchanged + ~vdi_size:Sizes.(4L ** mib) + ~prepare_vdi:fill ~vdi_op ~backing_format ) ] -let delta_data_integrity_tests vdi_op op_name = +let delta_data_integrity_tests vdi_op op_name backing_format = [ ( op_name ^ ": delta between empty & empty VDI" , `Slow - , check_vdi_delta + , check_vdi_delta ~backing_format ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:noop ~prepare_vdi_base:noop ~vdi_op ) ; ( op_name ^ ": delta between random & empty VDI" , `Slow - , check_vdi_delta + , check_vdi_delta ~backing_format ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:write_random_data ~prepare_vdi_base:noop ~vdi_op ) ; ( op_name ^ ": delta between random & random VDI" , `Slow - , check_vdi_delta + , check_vdi_delta ~backing_format ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:write_random_data ~prepare_vdi_base:write_random_data ~vdi_op ) ; ( op_name ^ ": delta between full and empty VDI" , `Slow - , check_vdi_delta + , check_vdi_delta ~backing_format ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:fill ~prepare_vdi_base:noop ~vdi_op ) ; ( op_name ^ ": delta between full and random VDI" , `Slow - , check_vdi_delta + , check_vdi_delta ~backing_format ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:fill ~prepare_vdi_base:write_random_data ~vdi_op ) ; ( op_name ^ ": delta between full and full VDI" , `Slow - , check_vdi_delta + , check_vdi_delta ~backing_format ~vdi_size:Sizes.(4L ** mib) ~prepare_vdi:fill ~prepare_vdi_base:fill ~vdi_op ) ] -let large_data_integrity_tests vdi_op op_name = +let large_data_integrity_tests vdi_op op_name backing_format = let b = Random.int64 16L in [ ( op_name ^ ": ~2GiB empty VDI" , `Slow , check_vdi_unchanged ~vdi_size:Sizes.((2L ** gib) +* b) - ~prepare_vdi:noop ~vdi_op + ~prepare_vdi:noop ~vdi_op ~backing_format ) ; ( op_name ^ ": ~2GiB random VDI" , `Slow , check_vdi_unchanged ~vdi_size:Sizes.((2L ** gib) +* b) - ~prepare_vdi:write_random_data ~vdi_op + ~prepare_vdi:write_random_data ~vdi_op ~backing_format ) ] @@ -266,30 +275,33 @@ let supported_gfs2_srs test_case = test_case |> conn |> sr (sr_with_vdi_create_destroy |> SR.has_type "gfs2") let tests () = - (data_integrity_tests copy_vdi "VDI.copy" |> supported_srs) - @ (large_data_integrity_tests copy_vdi "VDI.copy" |> supported_srs) + (data_integrity_tests copy_vdi "VDI.copy" "vhd" |> supported_srs) + @ (large_data_integrity_tests copy_vdi "VDI.copy" "vhd" |> supported_srs) @ (data_integrity_tests export_import_raw "VDI export/import to/from raw file" + "vhd" |> supported_srs ) @ (data_integrity_tests export_import_vhd "VDI export/import to/from VHD file" + "vhd" |> supported_srs ) @ (delta_data_integrity_tests delta_export_import_vhd - "VDI delta export/import to/from VHD file" + "VDI delta export/import to/from VHD file" "vhd" |> supported_srs ~f:Qt_filter.SR.smapiv1 ) - @ (data_integrity_tests export_import_tar "VDI export/import to/from TAR file" + @ (data_integrity_tests export_import_tar + "VDI export/import to/from TAR file" "vhd" |> supported_srs ) @ (data_integrity_tests export_import_qcow - "VDI export/import to/from QCOW file" + "VDI export/import to/from QCOW file" "qcow2" |> supported_srs ) @ (delta_data_integrity_tests delta_export_import_qcow - "VDI delta export/import to/from QCOW file" + "VDI delta export/import to/from QCOW file" "qcow2" |> supported_srs ) @ (large_data_integrity_tests export_import_tar - "VDI export/import to/from TAR file" + "VDI export/import to/from TAR file" "vhd" |> supported_gfs2_srs ) diff --git a/ocaml/quicktest/quicktest_vm_memory.ml b/ocaml/quicktest/quicktest_vm_memory.ml index 116403cedcf..c6d584d7497 100644 --- a/ocaml/quicktest/quicktest_vm_memory.ml +++ b/ocaml/quicktest/quicktest_vm_memory.ml @@ -12,7 +12,7 @@ let check_tasks tasks = let one t ~host ~vm ~workload_vm n = Trace.with_ __FUNCTION__ @@ fun scope -> workload t ~host ~workload_vm ; - let vms = fill_mem_n t ~workaround_migration:true ~host ~vm ~n in + let vms = fill_mem_n t ~workaround_migration:false ~host ~vm ~n in let migration_host, migration_vm = List.nth vms 0 in diff --git a/ocaml/quicktest/quicktest_vm_snapshot.ml b/ocaml/quicktest/quicktest_vm_snapshot.ml index f6e976bb22c..54c0489f375 100644 --- a/ocaml/quicktest/quicktest_vm_snapshot.ml +++ b/ocaml/quicktest/quicktest_vm_snapshot.ml @@ -5,15 +5,17 @@ let with_setup rpc session_id sr vm_template f = print_endline (Printf.sprintf "Template has uuid: %s%!" uuid) ; let vdi = Client.Client.VDI.create ~rpc ~session_id ~name_label:"small" - ~name_description:__LOC__ ~sR:sr ~virtual_size:4194304L ~_type:`user - ~sharable:false ~read_only:false ~other_config:[] ~xenstore_data:[] - ~sm_config:[] ~tags:[] + ~name_description:__LOC__ ~sR:sr + ~virtual_size:Int64.(mul (mul 4L 1024L) 1024L) + ~_type:`user ~sharable:false ~read_only:false ~other_config:[] + ~xenstore_data:[] ~sm_config:[] ~tags:[] in let vdi2 = Client.Client.VDI.create ~rpc ~session_id ~name_label:"small2" - ~name_description:__LOC__ ~sR:sr ~virtual_size:4194304L ~_type:`user - ~sharable:false ~read_only:false ~other_config:[] ~xenstore_data:[] - ~sm_config:[] ~tags:[] + ~name_description:__LOC__ ~sR:sr + ~virtual_size:Int64.(mul (mul 4L 1024L) 1024L) + ~_type:`user ~sharable:false ~read_only:false ~other_config:[] + ~xenstore_data:[] ~sm_config:[] ~tags:[] in Qt.VM.with_new rpc session_id ~template:vm_template (fun vm -> print_endline (Printf.sprintf "Installed new VM") ; diff --git a/ocaml/rrd2csv/src/rrd2csv.ml b/ocaml/rrd2csv/src/rrd2csv.ml index 6ed61dbdded..4ef3998e9c1 100644 --- a/ocaml/rrd2csv/src/rrd2csv.ml +++ b/ocaml/rrd2csv/src/rrd2csv.ml @@ -149,10 +149,10 @@ module Ds_selector = struct let of_string str = let open Rrd in - let splitted = Xstringext.String.split ',' str in + let splitted = String.split_on_char ',' str in match splitted with | without_trailing_comma :: _ -> ( - let splitted = Xstringext.String.split ':' without_trailing_comma in + let splitted = String.split_on_char ':' without_trailing_comma in match splitted with | [cf; owner; uuid; metric] -> { @@ -185,13 +185,7 @@ module Ds_selector = struct let escape_metric s = let quote s = Printf.sprintf "\"%s\"" s in if String.contains s '"' then - quote - (Xstringext.String.map_unlikely s (function - | '\"' -> - Some "\"\"" - | _ -> - None - )) + quote (Xstringext.String.replace '"' ~by:{|""|} s) else if String.contains s ',' || String.contains s '\n' then quote s else diff --git a/ocaml/sdk-gen/c/README.dist b/ocaml/sdk-gen/c/README.dist index 20095880330..d721728b035 100644 --- a/ocaml/sdk-gen/c/README.dist +++ b/ocaml/sdk-gen/c/README.dist @@ -1,7 +1,7 @@ libxenserver ============ -Copyright (c) 2007-2025 Cloud Software Group, Inc. All Rights Reserved. +Copyright (c) 2007-2026 Cloud Software Group, Inc. All Rights Reserved. libxenserver is a complete SDK for XenServer exposing the XenServer API to C developers. @@ -20,10 +20,10 @@ Reference For XenServer documentation see https://docs.xenserver.com The XenServer Management API Reference is available at -https://docs.xenserver.com/en-us/xenserver/8/developer/management-api +https://docs.xenserver.com/en-us/xenserver/developer/api-reference The XenServer Software Development Kit Guide is available at -https://docs.xenserver.com/en-us/xenserver/8/developer/sdk-guide +https://docs.xenserver.com/en-us/xenserver/developer/sdk-guide A number of examples to help you get started with the SDK is available at https://github.com/xenserver/xenserver-samples @@ -32,7 +32,7 @@ For community content, blogs, and downloads, visit https://www.xenserver.com/blogs and https://www.citrix.com/community/ To network with other developers using XenServer visit -https://discussions.citrix.com/forum/101-hypervisor-formerly-xenserver/ +https://community.citrix.com/forums/forum/1118-xenserver-sdk/ Dependencies diff --git a/ocaml/sdk-gen/csharp/FriendlyErrorNames.resx b/ocaml/sdk-gen/csharp/FriendlyErrorNames.resx index 69b5ae29fb9..5786eca65fa 100644 --- a/ocaml/sdk-gen/csharp/FriendlyErrorNames.resx +++ b/ocaml/sdk-gen/csharp/FriendlyErrorNames.resx @@ -91,7 +91,7 @@ The GPU group contains active virtual GPUs and cannot be deleted. - Object has been deleted.{0}:{1} + Could not find the specified object. If it existed before, it may have recently been deleted. {0} {1} This operation cannot be performed because the referenced network is not properly shared. The network must either be entirely virtual or must be physically present via a currently attached PIF on every server. diff --git a/ocaml/sdk-gen/csharp/autogen/README.md b/ocaml/sdk-gen/csharp/autogen/README.md index acc7622ee50..cac10e6a532 100644 --- a/ocaml/sdk-gen/csharp/autogen/README.md +++ b/ocaml/sdk-gen/csharp/autogen/README.md @@ -1,6 +1,6 @@ # XenServer.NET -Copyright (c) 2007-2025 Cloud Software Group, Inc. All Rights Reserved. +Copyright (c) 2007-2026 Cloud Software Group, Inc. All Rights Reserved. XenServer.NET is a complete SDK for XenServer, exposing the XenServer API as .NET classes. It is written in C#. @@ -18,10 +18,10 @@ terms of the BSD 2-Clause license. See LICENSE.txt for details. For XenServer documentation see The XenServer Management API Reference is available at - + The XenServer Software Development Kit Guide is available at - + A number of examples to help you get started with the SDK is available at @@ -30,11 +30,11 @@ For community content, blogs, and downloads, visit and To network with other developers using XenServer visit - + ## Prerequisites -This library requires .NET Standard 2.0. +This library targets .NET Framework 4.6.2, .NET Standard 2.0, and .NET 8.0. ## Dependencies diff --git a/ocaml/sdk-gen/csharp/autogen/src/Event.cs b/ocaml/sdk-gen/csharp/autogen/src/Event.cs index 1eed4e3ef10..ad89ae086c6 100644 --- a/ocaml/sdk-gen/csharp/autogen/src/Event.cs +++ b/ocaml/sdk-gen/csharp/autogen/src/Event.cs @@ -45,22 +45,6 @@ public override void UpdateFrom(Event update) id = update.id; } - [Obsolete("Use the calls setting individual fields of the API object instead.")] - public override string SaveChanges(Session session, string opaqueRef, Event serverObject) - { - if (opaqueRef == null) - { - throw new InvalidOperationException("There is no constructor available for this type; you cannot directly create one on the server."); - } - - Event server = serverObject; - - if (!_id.Equals(server._id)) - set_id(session, opaqueRef, _id); - - return null; - } - public static Event get_record(Session session, string _event) { return session.JsonRpcClient.event_get_record(session.opaque_ref, _event); diff --git a/ocaml/sdk-gen/csharp/autogen/src/HTTP.cs b/ocaml/sdk-gen/csharp/autogen/src/HTTP.cs index 732478828f2..ca26aa3cd09 100644 --- a/ocaml/sdk-gen/csharp/autogen/src/HTTP.cs +++ b/ocaml/sdk-gen/csharp/autogen/src/HTTP.cs @@ -90,10 +90,21 @@ public override void GetObjectData(SerializationInfo info, StreamingContext cont [Serializable] public class BadServerResponseException : Exception { + public int StatusCode { get; } + public string InitialLine { get; } + public string Body { get; } + public BadServerResponseException() { } public BadServerResponseException(string message) : base(message) { } + public BadServerResponseException(string message, int statusCode, string initialLine, string body) : base(message) + { + StatusCode = statusCode; + InitialLine = initialLine; + Body = body; + } + public BadServerResponseException(string message, Exception exception) : base(message, exception) { } #if !(NET8_0_OR_GREATER) @@ -195,11 +206,16 @@ private static string ReadLine(Stream stream) private static bool ReadHttpHeaders(ref Stream stream, IWebProxy proxy, bool nodelay, int timeout_ms, List headers = null) { // read headers/fields - string line = ReadLine(stream), initialLine = line, transferEncodingField = null; + string line = ReadLine(stream); + string initialLine = line; + string transferEncodingField = null; + if (string.IsNullOrEmpty(initialLine)) // sanity check return false; + if (headers == null) headers = new List(); + while (!string.IsNullOrWhiteSpace(line)) // IsNullOrWhiteSpace also checks for empty string { line = line.TrimEnd('\r', '\n'); @@ -211,6 +227,7 @@ private static bool ReadHttpHeaders(ref Stream stream, IWebProxy proxy, bool nod // read chunks string entityBody = ""; + if (!string.IsNullOrEmpty(transferEncodingField)) { int lastChunkSize = -1; @@ -246,13 +263,9 @@ private static bool ReadHttpHeaders(ref Stream stream, IWebProxy proxy, bool nod entityBody = entityBody.TrimEnd('\r', '\n'); headers.Add(entityBody); // keep entityBody if it's needed for Digest authentication (when qop="auth-int") } - else - { - // todo: handle other transfer types, in case "Transfer-Encoding: Chunked" isn't used - } // handle server response - int code = getResultCode(initialLine); + int code = GetResultCode(initialLine); switch (code) { case 407: // authentication error; caller must handle this case @@ -268,17 +281,32 @@ private static bool ReadHttpHeaders(ref Stream stream, IWebProxy proxy, bool nod return true; // headers need to be sent again default: + var contentLengthHeader = headers + .FirstOrDefault(h => h.StartsWith("Content-Length:", StringComparison.InvariantCultureIgnoreCase)); + + if (contentLengthHeader != null && int.TryParse(contentLengthHeader.Substring(15).Trim(), out var len)) + { + byte[] bytes = new byte[len]; + int total = 0; + int read; + + while (total < len && (read = stream.Read(bytes, total, len - total)) > 0) + total += read; + + entityBody = Encoding.ASCII.GetString(bytes); + } + stream.Close(); - throw new BadServerResponseException(string.Format("Received error code {0} from the server", initialLine)); + throw new BadServerResponseException(string.Format("Received error code {0} from the server", initialLine), code, initialLine, entityBody); } return false; } - private static int getResultCode(string line) + private static int GetResultCode(string line) { string[] bits = line.Split(' '); - return (bits.Length < 2 ? 0 : Int32.Parse(bits[1])); + return bits.Length < 2 ? 0 : Int32.Parse(bits[1]); } public static bool UseSSL(Uri uri) @@ -651,7 +679,7 @@ private static void AuthenticateProxy(ref Stream stream, Uri uri, IWebProxy prox if (authenticatedResponse.Count == 0) throw new BadServerResponseException("No response from the proxy server after authentication attempt."); - switch (getResultCode(authenticatedResponse[0])) + switch (GetResultCode(authenticatedResponse[0])) { case 200: break; diff --git a/ocaml/sdk-gen/csharp/autogen/src/JsonRpc.cs b/ocaml/sdk-gen/csharp/autogen/src/JsonRpc.cs index a790f397320..91a39f53770 100644 --- a/ocaml/sdk-gen/csharp/autogen/src/JsonRpc.cs +++ b/ocaml/sdk-gen/csharp/autogen/src/JsonRpc.cs @@ -163,6 +163,7 @@ public override string ToString() public partial class JsonRpcClient { private int _globalId; + private string _userAgent; #if (NET8_0_OR_GREATER) private static readonly Type ClassType = typeof(JsonRpcClient); @@ -205,6 +206,10 @@ public JsonRpcClient(string baseUrl) Url = baseUrl; JsonRpcUrl = new Uri(new Uri(baseUrl), "/jsonrpc").ToString(); JsonRpcVersion = JsonRpcVersion.v1; + Timeout = Session.STANDARD_TIMEOUT; + UserAgent = Session.DefaultUserAgent; + KeepAlive = true; + AllowAutoRedirect = true; } /// @@ -215,7 +220,13 @@ public JsonRpcClient(string baseUrl) public event Action RequestEvent; public JsonRpcVersion JsonRpcVersion { get; set; } - public string UserAgent { get; set; } + + public string UserAgent + { + get => _userAgent; + set => _userAgent = string.IsNullOrEmpty(value) ? Session.DefaultUserAgent : value; + } + public bool KeepAlive { get; set; } public IWebProxy WebProxy { get; set; } public int Timeout { get; set; } @@ -239,7 +250,7 @@ public JsonRpcClient(string baseUrl) public string JsonRpcUrl { get; private set; } - private void Rpc(string callName, JToken parameters, JsonSerializer serializer) + protected void Rpc(string callName, JToken parameters, JsonSerializer serializer) { Rpc(callName, parameters, serializer); } @@ -516,7 +527,7 @@ private JsonSerializerSettings CreateSettings(IList converters) }; } - private JsonSerializer CreateSerializer(IList converters) + protected JsonSerializer CreateSerializer(IList converters) { var settings = CreateSettings(converters); return JsonSerializer.Create(settings); diff --git a/ocaml/sdk-gen/csharp/autogen/src/README-NuGet.md b/ocaml/sdk-gen/csharp/autogen/src/README-NuGet.md index 0e4a60fffc0..a541ab76d55 100644 --- a/ocaml/sdk-gen/csharp/autogen/src/README-NuGet.md +++ b/ocaml/sdk-gen/csharp/autogen/src/README-NuGet.md @@ -1,6 +1,6 @@ # XenServer.NET -Copyright (c) 2007-2025 Cloud Software Group, Inc. All Rights Reserved. +Copyright (c) 2007-2026 Cloud Software Group, Inc. All Rights Reserved. XenServer.NET is a complete SDK for XenServer, exposing the XenServer API as .NET classes. It is written in C#. @@ -13,35 +13,32 @@ are ideal for developers wishing to use XenServer.NET. XenServer.NET is free software. You can redistribute and modify it under the terms of the BSD 2-Clause license. See LICENSE.txt for details. - ## Reference -For XenServer documentation see https://docs.xenserver.com +For XenServer documentation see The XenServer Management API Reference is available at -https://docs.xenserver.com/en-us/xenserver/8/developer/management-api + The XenServer Software Development Kit Guide is available at -https://docs.xenserver.com/en-us/xenserver/8/developer/sdk-guide + A number of examples to help you get started with the SDK is available at -https://github.com/xenserver/xenserver-samples + For community content, blogs, and downloads, visit -https://www.xenserver.com/blogs and https://www.citrix.com/community + and To network with other developers using XenServer visit -https://discussions.citrix.com/forum/101-hypervisor-formerly-xenserver - + ## Prerequisites -This library requires .NET Standard 2.0. - +This library targets .NET Framework 4.6.2, .NET Standard 2.0, and .NET 8.0. ## Dependencies XenServer.NET is dependent upon the following libraries: -- Newtonsoft JSON.NET by James Newton-King (see https://www.newtonsoft.com). +- Newtonsoft JSON.NET by James Newton-King (see ). JSON.NET is licensed under the MIT license. \ No newline at end of file diff --git a/ocaml/sdk-gen/csharp/autogen/src/Session.cs b/ocaml/sdk-gen/csharp/autogen/src/Session.cs index 5d999136833..4ffcaf7aab3 100644 --- a/ocaml/sdk-gen/csharp/autogen/src/Session.cs +++ b/ocaml/sdk-gen/csharp/autogen/src/Session.cs @@ -46,29 +46,16 @@ public partial class Session : XenObject public const int STANDARD_TIMEOUT = 24 * 60 * 60 * 1000; /// - /// This string is used as the HTTP UserAgent for each request. + /// The default HTTP UserAgent for each request. /// - public static string UserAgent = $"XenAPI/{Helper.APIVersionString(API_Version.LATEST)}"; - - /// - /// If null, no proxy is used, otherwise this proxy is used for each request. - /// - public static IWebProxy Proxy = null; - - public API_Version APIVersion = API_Version.UNKNOWN; - - public object Tag; + public static readonly string DefaultUserAgent = $"XenServer.NET/@SDK_VERSION@"; #region Constructors + /// Thrown if 'client' is null public Session(JsonRpcClient client) { - client.Timeout = STANDARD_TIMEOUT; - client.KeepAlive = true; - client.UserAgent = UserAgent; - client.WebProxy = Proxy; - client.AllowAutoRedirect = true; - JsonRpcClient = client; + JsonRpcClient = client ?? throw new ArgumentNullException(nameof(client)); } public Session(string url) : @@ -101,8 +88,7 @@ public Session(Session session) //in the following do not copy over the ConnectionGroupName - if (session.JsonRpcClient != null && - (APIVersion == API_Version.API_2_6 || APIVersion >= API_Version.API_2_8)) + if (APIVersion == API_Version.API_2_6 || APIVersion >= API_Version.API_2_8) { JsonRpcClient = new JsonRpcClient(session.Url) { @@ -119,7 +105,12 @@ public Session(Session session) ServerCertificateValidationCallback = session.JsonRpcClient.ServerCertificateValidationCallback }; } - CopyADFromSession(session); + + //copy AD details + IsLocalSuperuser = session.IsLocalSuperuser; + SessionSubject = session.SessionSubject; + UserSid = session.UserSid; + Permissions = session.Permissions; } #endregion @@ -131,14 +122,7 @@ private static string GetUrl(string hostname, int port) private void SetupSessionDetails() { - SetAPIVersion(); - SetADDetails(); - SetRbacPermissions(); - } - - private void SetAPIVersion() - { - Dictionary, Pool> pools = Pool.get_all_records(this); + var pools = Pool.get_all_records(this); if (pools.Values.Count > 0) { @@ -147,125 +131,92 @@ private void SetAPIVersion() APIVersion = Helper.GetAPIVersion(host.API_version_major, host.API_version_minor); } - if (JsonRpcClient != null) - { - if (APIVersion == API_Version.API_2_6) - JsonRpcClient.JsonRpcVersion = JsonRpcVersion.v1; - else if (APIVersion >= API_Version.API_2_8) - JsonRpcClient.JsonRpcVersion = JsonRpcVersion.v2; - } - } + //the SDK cannot connect to servers with API < 2.5 because JsonRPC was not available - private void CopyADFromSession(Session session) - { - IsLocalSuperuser = session.IsLocalSuperuser; - SessionSubject = session.SessionSubject; - UserSid = session.UserSid; - Roles = session.Roles; - Permissions = session.Permissions; - } - - /// - /// Applies only to API 1.6 (george) and above. - /// - private void SetADDetails() - { - if (APIVersion < API_Version.API_1_6) - { - IsLocalSuperuser = true; - return; - } - - IsLocalSuperuser = get_is_local_superuser(); - if (IsLocalSuperuser) - return; + if (APIVersion == API_Version.API_2_6) + JsonRpcClient.JsonRpcVersion = JsonRpcVersion.v1; + else if (APIVersion >= API_Version.API_2_8) + JsonRpcClient.JsonRpcVersion = JsonRpcVersion.v2; - SessionSubject = get_subject(this, opaque_ref); - UserSid = get_auth_user_sid(); + IsLocalSuperuser = get_is_local_superuser(this, opaque_ref); - // Cache the details of this user to avoid making server calls later - // For example, some users get access to the pool through a group subject and will not be in the main cache - UserDetails.UpdateDetails(UserSid, this); - } - - /// - /// Applies only to API 1.7 (midnight-ride) and above. - /// Older versions have no RBAC, only AD. - /// - private void SetRbacPermissions() - { - if (APIVersion < API_Version.API_1_7) - return; - - // allRoles will contain every role on the server, permissions contains the subset of those that are available to this session. - Permissions = Session.get_rbac_permissions(this, opaque_ref); - Dictionary, Role> allRoles = Role.get_all_records(this); - // every Role object is either a single api call (a permission) or has subroles and contains permissions through its descendants. - // We take out the parent Roles (VM-Admin etc.) into the Session.Roles field - foreach (string s in Permissions) + if (!IsLocalSuperuser) { - foreach (XenRef xr in allRoles.Keys) - { - Role r = allRoles[xr]; - if (r.subroles.Count > 0 && r.name_label == s) - { - r.opaque_ref = xr.opaque_ref; - Roles.Add(r); - break; - } - } + SessionSubject = get_subject(this, opaque_ref); + UserSid = get_auth_user_sid(this, opaque_ref); + + // Cache the details of this user to avoid making server calls later + UserDetails.UpdateDetails(UserSid, this); } - } - public override void UpdateFrom(Session update) - { - throw new Exception("The method or operation is not implemented."); + Permissions = get_rbac_permissions(this, opaque_ref); } - [Obsolete("Use the calls setting individual fields of the API object instead.")] - public override string SaveChanges(Session session, string serverOpaqueRef, Session serverObject) + public override void UpdateFrom(Session update) { throw new Exception("The method or operation is not implemented."); } #region Properties + public API_Version APIVersion { get; private set; } = API_Version.UNKNOWN; + + public object Tag { get; set; } + /// /// Retrieves the current users details from the UserDetails map. These values are only updated when a new session is created. /// public virtual UserDetails CurrentUserDetails => UserSid == null ? null : UserDetails.Sid_To_UserDetails[UserSid]; - public JsonRpcClient JsonRpcClient { get; private set; } + public JsonRpcClient JsonRpcClient { get; } public string Url => JsonRpcClient.Url; + /// + /// The WebProxy to use for each HTTP request. + /// + public IWebProxy Proxy + { + get => JsonRpcClient.WebProxy; + set => JsonRpcClient.WebProxy = value; + } + + /// + /// The UserAgent to use for each HTTP request. If set to null or empty the DefaultUserAgent will be used. + /// + public string UserAgent + { + get => JsonRpcClient.UserAgent; + set => JsonRpcClient.UserAgent = value; + } + public string ConnectionGroupName { - get => JsonRpcClient?.ConnectionGroupName; + get => JsonRpcClient.ConnectionGroupName; set => JsonRpcClient.ConnectionGroupName = value; } public int Timeout { - get => JsonRpcClient?.Timeout ?? STANDARD_TIMEOUT; + get => JsonRpcClient.Timeout; set => JsonRpcClient.Timeout = value; } #if (NET8_0_OR_GREATER) public Func ServerCertificateValidationCallback { - get => JsonRpcClient?.ServerCertificateValidationCallback; + get => JsonRpcClient.ServerCertificateValidationCallback; set => JsonRpcClient.ServerCertificateValidationCallback = value; } #else public RemoteCertificateValidationCallback ServerCertificateValidationCallback { - get => JsonRpcClient?.ServerCertificateValidationCallback; + get => JsonRpcClient.ServerCertificateValidationCallback; set => JsonRpcClient.ServerCertificateValidationCallback = value; } #endif - public ICredentials Credentials => JsonRpcClient?.WebProxy?.Credentials; + public ICredentials Credentials => JsonRpcClient.WebProxy?.Credentials; /// /// Optional headers in name-value pairs to be passed in the HttpWebRequests. The @@ -307,18 +258,12 @@ public Dictionary RequestHeaders public string UserSid { get; private set; } /// - /// All permissions associated with the session at the time of log in. This is the list xapi uses until the session is logged out; + /// All permissions associated with the session at the time of log in. + /// This is the list xapi uses until the session is logged out; /// even if the permitted roles change on the server side, they don't apply until the next session. /// public string[] Permissions { get; private set; } - /// - /// All roles associated with the session at the time of log in. Do not rely on roles for determining what a user can do, - /// instead use Permissions. This list should only be used for UI purposes. - /// - [JsonConverter(typeof(XenRefListConverter))] - public List Roles { get; private set; } = new List(); - #endregion public string[] GetSystemMethods() @@ -328,9 +273,7 @@ public string[] GetSystemMethods() public static Session get_record(Session session, string sessionOpaqueRef) { - Session newSession = new Session(session.Url) { opaque_ref = sessionOpaqueRef }; - newSession.SetAPIVersion(); - return newSession; + return session.JsonRpcClient.session_get_record(session.opaque_ref, sessionOpaqueRef); } public void login_with_password(string username, string password) @@ -344,7 +287,6 @@ public void login_with_password(string username, string password, string version try { opaque_ref = JsonRpcClient.session_login_with_password(username, password, version); - SetupSessionDetails(); } catch (Failure exn) @@ -366,7 +308,6 @@ public void login_with_password(string username, string password, string version try { opaque_ref = JsonRpcClient.session_login_with_password(username, password, version, originator); - SetupSessionDetails(); } catch (Failure exn) @@ -383,6 +324,7 @@ public void login_with_password(string username, string password, string version } } + [Obsolete("Use method login_with_password(string username, string password, string version) instead")] public void login_with_password(string username, string password, API_Version version) { login_with_password(username, password, Helper.APIVersionString(version)); @@ -397,23 +339,18 @@ public void slave_local_login_with_password(string username, string password) public void logout() { - logout(this); + session_logout(this, opaque_ref); + opaque_ref = null; } - - /// - /// Log out of the given session2, using this session for the connection. - /// - /// The session to log out + + [Obsolete("Use static method session_logout(Session session, string opaqueRef) instead")] public void logout(Session session2) { logout(session2.opaque_ref); session2.opaque_ref = null; } - /// - /// Log out of the session with the given reference, using this session for the connection. - /// - /// The session to log out + [Obsolete("Use static method session_logout(Session session, string opaqueRef) instead")] public void logout(string self) { if (self == null) @@ -422,17 +359,25 @@ public void logout(string self) JsonRpcClient.session_logout(self); } + public static void session_logout(Session session, string opaqueRef) + { + session.JsonRpcClient.session_logout(opaqueRef); + } + public void local_logout() { - local_logout(this); + session_local_logout(this, opaque_ref); + opaque_ref = null; } + [Obsolete("Use static method session_local_logout(Session session, string opaqueRef) instead")] public void local_logout(Session session2) { local_logout(session2.opaque_ref); session2.opaque_ref = null; } + [Obsolete("Use static method session_local_logout(Session session, string opaqueRef) instead")] public void local_logout(string opaqueRef) { if (opaqueRef == null) @@ -441,22 +386,23 @@ public void local_logout(string opaqueRef) JsonRpcClient.session_local_logout(opaqueRef); } + public static void session_local_logout(Session session, string opaqueRef) + { + session.JsonRpcClient.session_local_logout(opaqueRef); + } + + [Obsolete("Use static method Session.change_password instead")] public void change_password(string oldPassword, string newPassword) { change_password(this, oldPassword, newPassword); } - /// - /// Change the password on the given session2, using this session for the connection. - /// - /// The session to change - /// - /// - public void change_password(Session session2, string oldPassword, string newPassword) + public static void change_password(Session session, string oldPassword, string newPassword) { - JsonRpcClient.session_change_password(session2.opaque_ref, oldPassword, newPassword); + session.JsonRpcClient.session_change_password(session.opaque_ref, oldPassword, newPassword); } + [Obsolete("Use static method Session.get_this_host instead")] public string get_this_host() { return get_this_host(this, opaque_ref); @@ -467,6 +413,7 @@ public static string get_this_host(Session session, string self) return session.JsonRpcClient.session_get_this_host(session.opaque_ref, self ?? ""); } + [Obsolete("Use static method Session.get_this_user instead")] public string get_this_user() { return get_this_user(this, opaque_ref); @@ -477,6 +424,7 @@ public static string get_this_user(Session session, string self) return session.JsonRpcClient.session_get_this_user(session.opaque_ref, self ?? ""); } + [Obsolete("Use static method Session.get_is_local_superuser instead")] public bool get_is_local_superuser() { return get_is_local_superuser(this, opaque_ref); @@ -492,6 +440,7 @@ public static string[] get_rbac_permissions(Session session, string self) return session.JsonRpcClient.session_get_rbac_permissions(session.opaque_ref, self ?? ""); } + [Obsolete("Use static method Session.get_last_active instead")] public DateTime get_last_active() { return get_last_active(this, opaque_ref); @@ -502,6 +451,7 @@ public static DateTime get_last_active(Session session, string self) return session.JsonRpcClient.session_get_last_active(session.opaque_ref, self ?? ""); } + [Obsolete("Use static method Session.get_pool instead")] public bool get_pool() { return get_pool(this, opaque_ref); @@ -512,6 +462,7 @@ public static bool get_pool(Session session, string self) return session.JsonRpcClient.session_get_pool(session.opaque_ref, self ?? ""); } + [Obsolete("Use static method Session.get_subject instead")] public XenRef get_subject() { return get_subject(this, opaque_ref); @@ -522,6 +473,7 @@ public static XenRef get_subject(Session session, string self) return session.JsonRpcClient.session_get_subject(session.opaque_ref, self ?? ""); } + [Obsolete("Use static method Session.get_auth_user_sid instead")] public string get_auth_user_sid() { return get_auth_user_sid(this, opaque_ref); @@ -532,8 +484,7 @@ public static string get_auth_user_sid(Session session, string self) return session.JsonRpcClient.session_get_auth_user_sid(session.opaque_ref, self ?? ""); } - #region AD SID enumeration and bootout - + [Obsolete("Use static method Session.get_all_subject_identifiers instead")] public string[] get_all_subject_identifiers() { return get_all_subject_identifiers(this); @@ -544,6 +495,7 @@ public static string[] get_all_subject_identifiers(Session session) return session.JsonRpcClient.session_get_all_subject_identifiers(session.opaque_ref); } + [Obsolete("Use static method Session.async_get_all_subject_identifiers instead")] public XenRef async_get_all_subject_identifiers() { return async_get_all_subject_identifiers(this); @@ -554,17 +506,18 @@ public static XenRef async_get_all_subject_identifiers(Session session) return session.JsonRpcClient.async_session_get_all_subject_identifiers(session.opaque_ref); } - public string logout_subject_identifier(string subjectIdentifier) + [Obsolete("Use static method Session.logout_subject_identifier instead")] + public void logout_subject_identifier(string subjectIdentifier) { - return logout_subject_identifier(this, subjectIdentifier); + logout_subject_identifier(this, subjectIdentifier); } - public static string logout_subject_identifier(Session session, string subjectIdentifier) + public static void logout_subject_identifier(Session session, string subjectIdentifier) { session.JsonRpcClient.session_logout_subject_identifier(session.opaque_ref, subjectIdentifier); - return string.Empty; } + [Obsolete("Use static method Session.async_logout_subject_identifier instead")] public XenRef async_logout_subject_identifier(string subjectIdentifier) { return async_logout_subject_identifier(this, subjectIdentifier); @@ -575,10 +528,7 @@ public static XenRef async_logout_subject_identifier(Session session, stri return session.JsonRpcClient.async_session_logout_subject_identifier(session.opaque_ref, subjectIdentifier); } - #endregion - - #region other_config stuff - + [Obsolete("Use static method Session.get_other_config instead")] public Dictionary get_other_config() { return get_other_config(this, opaque_ref); @@ -589,6 +539,7 @@ public static Dictionary get_other_config(Session session, strin return session.JsonRpcClient.session_get_other_config(session.opaque_ref, self ?? ""); } + [Obsolete("Use static method Session.set_other_config instead")] public void set_other_config(Dictionary otherConfig) { set_other_config(this, opaque_ref, otherConfig); @@ -599,6 +550,7 @@ public static void set_other_config(Session session, string self, Dictionary : IXenObject where S : XenObject /// public abstract void UpdateFrom(S record); - [Obsolete("Use the calls setting individual fields of the API object instead.")] - public abstract string SaveChanges(Session session, string serverOpaqueRef, S serverObject); - public string opaque_ref { get; set; } public event PropertyChangedEventHandler PropertyChanged; diff --git a/ocaml/sdk-gen/csharp/autogen/src/XenServer.csproj b/ocaml/sdk-gen/csharp/autogen/src/XenServer.csproj index 22acc1de24a..29757b4506b 100644 --- a/ocaml/sdk-gen/csharp/autogen/src/XenServer.csproj +++ b/ocaml/sdk-gen/csharp/autogen/src/XenServer.csproj @@ -1,7 +1,7 @@  0.0.0 - net80;netstandard2.0;net45 + net80;netstandard2.0;net462 Library XenAPI True @@ -11,7 +11,7 @@ $(AssemblyName).NET $(AssemblyName).NET .NET wrapper for the XenServer API - Copyright (c) 2007-2025 Cloud Software Group, Inc. All Rights Reserved. + Copyright (c) 2007-2026 Cloud Software Group, Inc. All Rights Reserved. citrix hypervisor virtualization sdk jsonrpc .net c# xen xenserver BSD-2-Clause https://github.com/xapi-project/xen-api diff --git a/ocaml/sdk-gen/csharp/gen_csharp_binding.ml b/ocaml/sdk-gen/csharp/gen_csharp_binding.ml index a442a4ede40..c6e941792c6 100644 --- a/ocaml/sdk-gen/csharp/gen_csharp_binding.ml +++ b/ocaml/sdk-gen/csharp/gen_csharp_binding.ml @@ -356,35 +356,7 @@ and gen_class out_chan cls = ) ) ; - print - ";\n\ - \ }\n\n\ - \ [Obsolete(\"Use the calls setting individual fields of the API \ - object instead.\")]\n\ - \ public override string SaveChanges(Session session, string \ - opaqueRef, %s server)\n\ - \ {\n\ - \ if (opaqueRef == null)\n\ - \ {" - exposed_class_name ; - - if cls.gen_constructor_destructor then - print - "\n\ - \ var reference = create(session, this);\n\ - \ return reference == null ? null : reference.opaque_ref;\n" - else - print - "\n\ - \ System.Diagnostics.Debug.Assert(false, \"Cannot create \ - instances of this type on the server\");\n\ - \ return \"\";\n" ; - - print " }\n else\n {\n" ; - - gen_save_changes out_chan exposed_class_name messages contents ; - - print "\n }\n }\n" ; + print ";\n }\n\n" ; let gen_exposed_method_overloads cls message = let generator x = gen_exposed_method cls message x in @@ -606,63 +578,6 @@ and exposed_call_params message classname params = in String.concat ", " ("session.opaque_ref" :: exposedParams) -(* 'messages' are methods, 'contents' are fields *) -and gen_save_changes out_chan exposed_class_name messages contents = - let fields = List.concat_map flatten_content contents in - let fields2 = - List.filter - (fun fr -> fr.qualifier == RW && not (List.mem "public" fr.full_name)) - fields - in - (* Find all StaticRO fields which have corresponding messages (methods) of the form set_readonlyField *) - let readonlyFieldsWithSetters = - List.filter - (fun field -> - field.qualifier == StaticRO - && List.exists - (fun msg -> - msg.msg_name = String.concat "" ["set_"; full_name field] - ) - messages - ) - fields - in - let length = List.length fields2 + List.length readonlyFieldsWithSetters in - let print format = fprintf out_chan format in - if length == 0 then - print - " throw new InvalidOperationException(\"This type has no \ - read/write properties\");" - else ( - List.iter (gen_save_changes_to_field out_chan exposed_class_name) fields2 ; - (* Generate calls to any set_ methods *) - List.iter - (gen_save_changes_to_field out_chan exposed_class_name) - readonlyFieldsWithSetters ; - print "\n return null;" - ) - -and flatten_content content = - match content with - | Field fr -> - [fr] - | Namespace (_, c) -> - List.concat_map flatten_content c - -and gen_save_changes_to_field out_chan exposed_class_name fr = - let print format = fprintf out_chan format in - let full_name_fr = full_name fr in - let equality = - (* Use AreEqual2 - see CA-19220 *) - sprintf "Helper.AreEqual2(_%s, server._%s)" full_name_fr full_name_fr - in - print - " if (!%s)\n\ - \ {\n\ - \ %s.set_%s(session, opaqueRef, _%s);\n\ - \ }\n" - equality exposed_class_name full_name_fr full_name_fr - and gen_exposed_field out_chan cls content = match content with | Field fr -> diff --git a/ocaml/sdk-gen/go/README.md b/ocaml/sdk-gen/go/README.md index 33e7eef8a38..984128d4d67 100644 --- a/ocaml/sdk-gen/go/README.md +++ b/ocaml/sdk-gen/go/README.md @@ -1,6 +1,6 @@ # XenServer SDK for Go -Copyright (c) 2023-2025 Cloud Software Group, Inc. All Rights Reserved. +Copyright (c) 2023-2026 Cloud Software Group, Inc. All Rights Reserved. XenServer SDK for Go is a complete SDK for XenServer, exposing the XenServer API as Go module. It is written in Go. @@ -18,10 +18,10 @@ terms of the BSD 2-Clause license. See LICENSE for details. For XenServer documentation see The XenServer Management API Reference is available at - + The XenServer Software Development Kit Guide is available at - + A number of examples to help you get started with the SDK is available at @@ -30,7 +30,7 @@ For community content, blogs, and downloads, visit and To network with other developers using XenServer visit - + ## Prerequisites diff --git a/ocaml/sdk-gen/java/autogen/xen-api/pom.xml b/ocaml/sdk-gen/java/autogen/xen-api/pom.xml index 5dc18e7ec61..460743379b2 100644 --- a/ocaml/sdk-gen/java/autogen/xen-api/pom.xml +++ b/ocaml/sdk-gen/java/autogen/xen-api/pom.xml @@ -8,7 +8,7 @@ jar XenServer Java SDK Mavenized build of the XenServer SDK for Java. - https://docs.xenserver.com/en-us/xenserver/8/developer + https://docs.xenserver.com/en-us/xenserver/developer Cloud Software Group, Inc. https://www.cloud.com @@ -55,7 +55,7 @@ com.fasterxml.jackson.core jackson-databind - 2.16.1 + 2.21.2 org.apache.httpcomponents.client5 @@ -90,7 +90,7 @@ maven-compiler-plugin 3.12.1 - 11 + 17 -Xlint:deprecation -Xlint:unchecked diff --git a/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/Connection.java b/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/Connection.java index bc8b5c644e4..bc1fccb99d5 100644 --- a/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/Connection.java +++ b/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/Connection.java @@ -68,29 +68,6 @@ public Connection(JsonRpcClient jsonRpcClient) { this.client = jsonRpcClient; } - /** - * Creates a connection to a particular server using a given url. This object can then be passed - * in to any other API calls. - *

- * Note this constructor does NOT call Session.loginWithPassword; the programmer is responsible for calling it, - * passing the Connection as a parameter. No attempt to connect to the server is made until login is called. - *

- * When this constructor is used, a call to dispose() will do nothing. The programmer is responsible for manually - * logging out the Session. - * - * @param httpClient The HttpClient used to make calls, this will be used by the underlying {@link #client} for handling requests - * @param url The URL of the server to connect to. Should be of the form http(s)://host-url/jsonrpc or http(s)://host-url. - * @param requestTimeout The reply timeout for JSON-RPC calls in seconds - * @deprecated This constructor is deprecated. To set the {@code requestTimeout} please {@link #setRequestTimeout(int)}. You may also use the {@link com.xensource.xenapi.JsonRpcClient#setRequestTimeout(int)} - * method of this object's {@link #client}. This option is only advisable if you are managing your own {@link com.xensource.xenapi.JsonRpcClient} as the underlying - * {@link #client} for this object. - */ - @Deprecated - public Connection(CloseableHttpClient httpClient, URL url, int requestTimeout) { - this.client = new JsonRpcClient(httpClient, url); - this.client.setRequestTimeout(requestTimeout); - } - /** * Creates a connection to a particular server using a given url. This object can then be passed * in to any other API calls. @@ -110,31 +87,6 @@ public Connection(URL url) { this.client = new JsonRpcClient(url); } - /** - * Creates a connection to a particular server using a given url. This object can then be passed - * in to any other API calls. - *

- * Note this constructor does NOT call Session.loginWithPassword; the programmer is responsible for calling it, - * passing the Connection as a parameter. No attempt to connect to the server is made until login is called. - *

- * When this constructor is used, a call to dispose() will do nothing. The programmer is responsible for manually - * logging out the Session. - * - * @param url The URL of the server to connect to. Should be of the form http(s)://host-url/jsonrpc or http(s)://host-url. - * @param requestTimeout The reply timeout for JSON-RPC calls in seconds - * @param connectionTimeout The connection timeout for JSON-RPC calls in seconds - * @deprecated This constructor is deprecated. To set {@code requestTimeout} or {@code connectionTimeout} please use {@link #setRequestTimeout(int)} or {@link #setConnectionTimeout(int)} respectively. - * You may also use the {@link com.xensource.xenapi.JsonRpcClient#setRequestTimeout(int)} method of this object's {@link #client}. - * This option is only advisable if you are managing your own {@link com.xensource.xenapi.JsonRpcClient} as the underlying - * {@link #client} for this object. - */ - @Deprecated - public Connection(URL url, int requestTimeout, int connectionTimeout) { - this.client = new JsonRpcClient(url); - this.client.setRequestTimeout(requestTimeout); - this.client.setConnectionTimeout(connectionTimeout); - } - /** * Creates a connection to a particular server using a given url. This object can then be passed * in to any other API calls. @@ -159,36 +111,6 @@ public Connection(URL url, String sessionReference) { this.sessionReference = sessionReference; } - /** - * Creates a connection to a particular server using a given url. This object can then be passed - * in to any other API calls. - *

- * Note this constructor does NOT call Session.loginWithPassword; the programmer is responsible for calling it, - * passing the Connection as a parameter. No attempt to connect to the server is made until login is called. - *

- * When this constructor is used, a call to dispose() will do nothing. The programmer is responsible for manually - * logging out the Session. - * - * @param url The URL of the server to connect to. Should be of the form http(s)://host-url/jsonrpc or http(s)://host-url. - * @param sessionReference A reference to a logged-in Session. Any method calls on this Connection will use it. - * This constructor does not call Session.loginWithPassword, and dispose() on the resulting - * Connection object does not call Session.logout. The programmer is responsible for - * ensuring the Session is logged in and out correctly. - * @param requestTimeout The reply timeout for JSON-RPC calls in seconds - * @param connectionTimeout The connection timeout for JSON-RPC calls in seconds - * @deprecated This constructor is deprecated. To set {@code requestTimeout} or {@code connectionTimeout} please use {@link #setRequestTimeout(int)} or {@link #setConnectionTimeout(int)} respectively. - * You may also use the {@link com.xensource.xenapi.JsonRpcClient#setRequestTimeout(int)} method of this object's {@link #client}. - * This option is only advisable if you are managing your own {@link com.xensource.xenapi.JsonRpcClient} as the underlying - * {@link #client} for this object. - */ - @Deprecated - public Connection(URL url, String sessionReference, int requestTimeout, int connectionTimeout) { - this.client = new JsonRpcClient(url); - this.client.setRequestTimeout(requestTimeout); - this.client.setConnectionTimeout(connectionTimeout); - this.sessionReference = sessionReference; - } - /** * Set the timeout in seconds for every request made by this object's {@link #client}. * If not set the value defaults to {@value JsonRpcClient#DEFAULT_REQUEST_TIMEOUT}. diff --git a/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/CustomDateDeserializer.java b/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/CustomDateDeserializer.java index 63be5c1c458..d3d43df7bc1 100644 --- a/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/CustomDateDeserializer.java +++ b/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/CustomDateDeserializer.java @@ -49,7 +49,7 @@ public class CustomDateDeserializer extends StdDeserializer { /** * Array of {@link SimpleDateFormat} objects representing the date formats * used in xen-api responses. - *
+ *
* RFC-3339 date formats can be returned in either Zulu or time zone agnostic. * This list is not an exhaustive list of formats supported by RFC-3339, rather * a set of formats that will enable the deserialization of xen-api dates. diff --git a/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/JsonRpcClient.java b/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/JsonRpcClient.java index 9d1389eaf28..f3db8252446 100644 --- a/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/JsonRpcClient.java +++ b/ocaml/sdk-gen/java/autogen/xen-api/src/main/java/com/xensource/xenapi/JsonRpcClient.java @@ -53,15 +53,14 @@ /** * Provides a JSON-RPC v2.0 client for making remote procedure calls to xapi's backend URL. - *
+ *
* This class enables the communication to the JSON-RPC backend. The client utilizes the HttpClient class for * sending HTTP POST requests with JSON payloads and the ObjectMapper class from the Jackson library for * serialization and deserialization of JSON data. - *
+ *
* The client can be customised by passing it as a parameter to corresponding constructor, enabling custom * handling of requests. - *
- *
+ *
* By default, the timeout for requests is set to {@value #DEFAULT_REQUEST_TIMEOUT}. The default timeout for connecting to the * JSON-RPC backend is set to {@value #DEFAULT_CONNECTION_TIMEOUT} seconds. The maximum number of concurrent connections handled * by the underlying {@link PoolingHttpClientConnectionManager} is {@value #MAX_CONCURRENT_CONNECTIONS}. diff --git a/ocaml/sdk-gen/java/autogen/xen-api/src/main/resources/README.txt b/ocaml/sdk-gen/java/autogen/xen-api/src/main/resources/README.txt index f5d13f889f5..4d469b5efcf 100644 --- a/ocaml/sdk-gen/java/autogen/xen-api/src/main/resources/README.txt +++ b/ocaml/sdk-gen/java/autogen/xen-api/src/main/resources/README.txt @@ -1,7 +1,7 @@ XenServerJava ============= -Copyright (c) 2007-2025 Cloud Software Group, Inc. All Rights Reserved. +Copyright (c) 2007-2026 Cloud Software Group, Inc. All Rights Reserved. XenServerJava is a complete SDK for XenServer, exposing the XenServer API as Java classes. @@ -21,10 +21,10 @@ Reference For XenServer documentation see https://docs.xenserver.com The XenServer Management API Reference is available at -https://docs.xenserver.com/en-us/xenserver/8/developer/management-api +https://docs.xenserver.com/en-us/xenserver/developer/api-reference The XenServer Software Development Kit Guide is available at -https://docs.xenserver.com/en-us/xenserver/8/developer/sdk-guide +https://docs.xenserver.com/en-us/xenserver/developer/sdk-guide A number of examples to help you get started with the SDK is available at https://github.com/xenserver/xenserver-samples @@ -33,7 +33,7 @@ For community content, blogs, and downloads, visit https://www.xenserver.com/blogs and https://www.citrix.com/community/ To network with other developers using XenServer visit -https://discussions.citrix.com/forum/101-hypervisor-formerly-xenserver/ +https://community.citrix.com/forums/forum/1118-xenserver-sdk/ Dependencies diff --git a/ocaml/sdk-gen/java/main.ml b/ocaml/sdk-gen/java/main.ml index 9fdab7102a4..ca779c54058 100644 --- a/ocaml/sdk-gen/java/main.ml +++ b/ocaml/sdk-gen/java/main.ml @@ -501,15 +501,6 @@ let get_types_json types = ("name", `String type_string) ; ("class_name", `String class_name) ; ("method_name", `String method_name) - ; ( "suppress_unchecked_warning" - , `Bool - ( match t with - | Map _ | Record _ | Option (Record _) | Option (Map _) -> - true - | _ -> - false - ) - ) ; ( "generate_reference_task_result_func" , `Bool generate_reference_task_result_func ) diff --git a/ocaml/sdk-gen/java/templates/Class.mustache b/ocaml/sdk-gen/java/templates/Class.mustache index 658deeb05f2..e96d2914145 100644 --- a/ocaml/sdk-gen/java/templates/Class.mustache +++ b/ocaml/sdk-gen/java/templates/Class.mustache @@ -61,9 +61,10 @@ public class {{class_name}} extends XenAPIObject { protected final String ref; /** - * For internal use only. + * Creates an object from a given XenAPI reference (OpaqueRef) + * @param ref The OpaqueRef from which to create the object. */ - {{{class_name}}}(String ref) { + public {{{class_name}}}(String ref) { this.ref = ref; } @@ -79,21 +80,17 @@ public class {{class_name}} extends XenAPIObject { * If obj is a {{{class_name}}}, compares XenAPI references for equality. */ @Override - public boolean equals(Object obj) - { - if (obj instanceof {{{class_name}}}) - { + public boolean equals(Object obj) { + if (obj instanceof {{{class_name}}}) { {{{class_name}}} other = ({{{class_name}}}) obj; return other.ref.equals(this.ref); - } else - { + } else { return false; } } @Override - public int hashCode() - { + public int hashCode() { return ref.hashCode(); } diff --git a/ocaml/sdk-gen/java/templates/Types.mustache b/ocaml/sdk-gen/java/templates/Types.mustache index 4da97c774cd..67906c33029 100644 --- a/ocaml/sdk-gen/java/templates/Types.mustache +++ b/ocaml/sdk-gen/java/templates/Types.mustache @@ -40,50 +40,46 @@ import java.util.regex.Pattern; */ public class Types { - /** - * Interface for all Record classes - */ - public interface Record - { - /** - * Convert a Record to a Map - */ - Map toMap(); - } - /** - * Base class for all XenAPI Exceptions - */ - public static class XenAPIException extends IOException { - public final String shortDescription; - public final String[] errorDescription; - XenAPIException(String shortDescription) - { - this.shortDescription = shortDescription; - this.errorDescription = null; - } - XenAPIException(String[] errorDescription) - { - this.errorDescription = errorDescription; - if (errorDescription.length > 0) - { - shortDescription = errorDescription[0]; - } else - { - shortDescription = ""; - } - } - public String toString() - { - if (errorDescription == null) - { - return shortDescription; - } else if (errorDescription.length == 0) - { - return ""; - } + /** + * Interface for all Record classes + */ + public interface Record + { + /** + * Convert a Record to a Map + */ + Map toMap(); + } + /** + * Base class for all XenAPI Exceptions + */ + public static class XenAPIException extends IOException { + public final String shortDescription; + public final String[] errorDescription; + + XenAPIException(String shortDescription) { + this.shortDescription = shortDescription; + this.errorDescription = null; + } + + XenAPIException(String[] errorDescription) { + this.errorDescription = errorDescription; + if (errorDescription.length > 0) { + shortDescription = errorDescription[0]; + } else { + shortDescription = ""; + } + } + + public String toString() { + if (errorDescription == null) { + return shortDescription; + } else if (errorDescription.length == 0) { + return ""; + } + StringBuilder sb = new StringBuilder(); - for (int i = 0; i < errorDescription.length - 1; i++) - { + for (int i = 0; i < errorDescription.length - 1; i++) { sb.append(errorDescription[i]); } sb.append(errorDescription[errorDescription.length - 1]); @@ -91,33 +87,30 @@ public class Types } } - /** - * Thrown if the response from the server contains an invalid status. - */ - public static class BadServerResponse extends XenAPIException - { - public BadServerResponse(JsonRpcResponseError responseError) - { - super(String.valueOf(responseError)); - } - } + /** + * Thrown if the response from the server contains an invalid status. + */ + public static class BadServerResponse extends XenAPIException { + public BadServerResponse(JsonRpcResponseError responseError) { + super(String.valueOf(responseError)); + } + } - /** - * Checks the provided server response was successful. If the call - * failed, throws a XenAPIException. If the server - * returned an invalid response, throws a BadServerResponse. - * Otherwise, returns the server response as passed in. - */ - public static void checkError(JsonRpcResponseError response) throws XenAPIException, BadServerResponse - { + /** + * Checks the provided server response was successful. If the call + * failed, throws a XenAPIException. If the server + * returned an invalid response, throws a BadServerResponse. + * Otherwise, returns the server response as passed in. + */ + public static void checkError(JsonRpcResponseError response) throws XenAPIException, BadServerResponse { var errorData = response.data; - if(errorData.length == 0){ + if(errorData.length == 0) { throw new BadServerResponse(response); } var errorName = response.message; {{#errors}} - if (errorName.equals("{{{name}}}")){ + if (errorName.equals("{{{name}}}")) { {{#err_params}} String p{{{index}}} = errorData.length > {{{index}}} ? errorData[{{{index}}}] : ""; {{/err_params}} @@ -180,37 +173,12 @@ public class Types /** * Create a new BadAsyncResult */ - public BadAsyncResult(String result) - { + public BadAsyncResult(String result) { super(result); this.result = result; } } - {{#types}} - /** - * Converts an {@link Object} to a {@link {{{name}}}} object. - *
- * This method takes an {@link Object} as input and attempts to convert it into a {@link {{{name}}}} object. - * If the input object is null, the method returns null. Otherwise, it creates a new {@link {{{name}}}} - * object using the input object's {@link String} representation. - *
- * @param object The {@link Object} to be converted to a {@link {{{name}}}} object. - * @return A {@link {{{name}}}} object created from the input {@link Object}'s {@link String} representation, - * or null if the input object is null. - * @deprecated this method will not be publicly exposed in future releases of this package. - */ - @Deprecated{{#suppress_unchecked_warning}} - @SuppressWarnings("unchecked"){{/suppress_unchecked_warning}} - public static {{{name}}} {{{method_name}}}(Object object) { - if (object == null) { - return null; - } - {{{method_body}}} - } - - {{/types}} - {{#types}}{{#generate_reference_task_result_func}} /** * Attempt to convert the {@link Task}'s result to a {@link {{{name}}}} object. @@ -218,12 +186,13 @@ public class Types * @param task The task from which to fetch the result. * @param connection The connection * @return the instantiated object if a valid value was found, null otherwise. - * @throws BadServerResponse Thrown if the response from the server contains an invalid status. + * @throws BadServerResponse if the response from the server contains an invalid status. * @throws XenAPIException if the call failed. - * @throws IOException if an error occurs during a send or receive. This includes cases where a payload is invalid JSON. + * @throws IOException if an error occurs during send or receive. This includes cases where a payload is invalid JSON. */ public static {{class_name}} to{{class_name}}(Task task, Connection connection) throws IOException { - return Types.to{{class_name}}(parseResult(task.getResult(connection))); + String result = parseResult(task.getResult(connection)); + return result == null || result.isEmpty() ? null : new {{class_name}}(result); } {{/generate_reference_task_result_func}} @@ -238,16 +207,4 @@ public class Types return matcher.group(1); } - - public static EventBatch toEventBatch(Object object) { - if (object == null) { - return null; - } - Map map = (Map) object; - EventBatch batch = new EventBatch(); - batch.token = toString(map.get("token")); - batch.validRefCounts = map.get("valid_ref_counts"); - batch.events = toSetOfEventRecord(map.get("events")); - return batch; - } } diff --git a/ocaml/sdk-gen/powershell/autogen/README.md b/ocaml/sdk-gen/powershell/autogen/README.md index 40812c3f7c8..dc4b260c6ba 100644 --- a/ocaml/sdk-gen/powershell/autogen/README.md +++ b/ocaml/sdk-gen/powershell/autogen/README.md @@ -1,6 +1,6 @@ # XenServer PowerShell Module -Copyright (c) 2013-2025 Cloud Software Group, Inc. All Rights Reserved. +Copyright (c) 2013-2026 Cloud Software Group, Inc. All Rights Reserved. The XenServer PowerShell Module is a complete SDK for XenServer, exposing the XenServer API as Windows PowerShell cmdlets. @@ -18,10 +18,10 @@ terms of the BSD 2-Clause license. See LICENSE.txt for details. For XenServer documentation see The XenServer Management API Reference is available at - + The XenServer Software Development Kit Guide is available at - + A number of examples to help you get started with the SDK is available at @@ -30,11 +30,11 @@ For community content, blogs, and downloads, visit and To network with other developers using XenServer visit - + ## Prerequisites -This library requires .NET 6.0 and PowerShell 7.2 or greater. +This library requires .NET 8.0 and PowerShell 7.4 or greater. ## Dependencies diff --git a/ocaml/sdk-gen/powershell/autogen/README_51.md b/ocaml/sdk-gen/powershell/autogen/README_51.md index 24ac038ee3c..47bd82e15c5 100644 --- a/ocaml/sdk-gen/powershell/autogen/README_51.md +++ b/ocaml/sdk-gen/powershell/autogen/README_51.md @@ -1,6 +1,6 @@ # XenServer PowerShell Module -Copyright (c) 2013-2025 Cloud Software Group, Inc. All Rights Reserved. +Copyright (c) 2013-2026 Cloud Software Group, Inc. All Rights Reserved. The XenServer PowerShell Module is a complete SDK for XenServer, exposing the XenServer API as Windows PowerShell cmdlets. @@ -18,10 +18,10 @@ terms of the BSD 2-Clause license. See LICENSE.txt for details. For XenServer documentation see The XenServer Management API Reference is available at - + The XenServer Software Development Kit Guide is available at - + A number of examples to help you get started with the SDK is available at @@ -30,11 +30,11 @@ For community content, blogs, and downloads, visit and To network with other developers using XenServer visit - + ## Prerequisites -This library requires .NET Framework 4.5 or greater and PowerShell 5.1 or greater. +This library requires .NET Framework 4.6.2 or greater and PowerShell 5.1 or greater. ## Dependencies diff --git a/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs b/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs index d22d5eadee0..943c91a7642 100644 --- a/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs +++ b/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs @@ -30,11 +30,7 @@ using System; using System.Collections; using System.Collections.Generic; -using System.IO; using System.Management.Automation; -using System.Reflection; -using System.Xml; - using XenAPI; namespace Citrix.XenServer @@ -44,11 +40,6 @@ internal class CommonCmdletFunctions private const string SessionsVariable = "global:Citrix.XenServer.Sessions"; private const string DefaultSessionVariable = "global:XenServer_Default_Session"; - static CommonCmdletFunctions() - { - Session.UserAgent = string.Format("XenServerPSModule/{0}", Assembly.GetExecutingAssembly().GetName().Version); - } - internal static Dictionary GetAllSessions(PSCmdlet cmdlet) { object obj = cmdlet.SessionState.PSVariable.GetValue(SessionsVariable); diff --git a/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs b/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs index 52cb8e21e54..8f60885d057 100644 --- a/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs +++ b/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs @@ -52,9 +52,12 @@ public class ConnectXenServerCommand : PSCmdlet private readonly object _certificateValidationLock = new object(); + private static readonly string DefaultUserAgent = $"XenServerPSModule/@SDK_VERSION@"; + public ConnectXenServerCommand() { Port = 443; + Originator = DefaultUserAgent; } #region Cmdlet Parameters @@ -85,7 +88,10 @@ public ConnectXenServerCommand() public string[] OpaqueRef { get; set; } [Parameter] - public string Originator { get; set; } = "XenServerPSModule/" + Helper.APIVersionString(API_Version.LATEST); + public string Originator { get; set; } + + [Parameter(HelpMessage = "The UserAgent to use for the requests to the server")] + public string UserAgent { get; set; } [Parameter] public SwitchParameter PassThru { get; set; } @@ -193,7 +199,7 @@ protected override void ProcessRecord() Session session; if (string.IsNullOrEmpty(OpaqueRef[i])) { - session = new Session(Url[i]); + session = new Session(Url[i]) { UserAgent = UserAgent }; try { session.login_with_password(connUser, connPassword, Helper.APIVersionString(API_Version.LATEST), Originator); @@ -235,12 +241,15 @@ protected override void ProcessRecord() }); } + if (inner != null) + throw inner; + throw; } } else { - session = new Session(Url[i], OpaqueRef[i]); + session = new Session(Url[i], OpaqueRef[i]){ UserAgent = UserAgent }; } session.Tag = Creds; diff --git a/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj b/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj index 35c2fc8fa42..962ca65d556 100644 --- a/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj +++ b/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj @@ -1,7 +1,7 @@ 0.0.0 - net8.0;net45 + net8.0;net462 Library True @@ -10,9 +10,9 @@ true - + - + diff --git a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml index ed84c2c7120..467b5b65c7e 100644 --- a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml +++ b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml @@ -17,11 +17,15 @@ module TypeSet = Set.Make (struct let compare = compare end) -let destdir = "autogen-out/src" +let destdir = "autogen-out" + +let srcdir = "autogen-out/src" let templdir = "templates" -type cmdlet = {filename: string; content: string} +type cmdlet = {cmdletname: string; content: string} + +let cmdlets_to_export = ref [] let api = Datamodel_utils.named_self := true ; @@ -68,6 +72,21 @@ let maps = ref TypeSet.empty let generated x = not (List.mem x.name ["blob"; "session"; "debug"; "event"; "vtpm"]) +let rec is_last x list = + match list with + | [] -> + false + | hd :: [] -> + if hd = x then + true + else + false + | hd :: tl -> + if hd = x then + false + else + is_last x tl + let rec main () = let json = `O @@ -91,7 +110,7 @@ let rec main () = in render_file ("ConvertTo-XenRef.mustache", "ConvertTo-XenRef.cs") - json templdir destdir ; + json templdir srcdir ; http_actions |> List.filter (fun (_, (_, _, sdk, _, _, _)) -> sdk) @@ -100,9 +119,45 @@ let rec main () = let filtered_classes = List.filter generated classes in let cmdlets = List.concat_map gen_cmdlets filtered_classes in - List.iter (fun x -> write_file x.filename x.content) cmdlets ; + List.iter (fun x -> write_file x.cmdletname x.content) cmdlets ; - filtered_classes |> List.iter gen_destructor + filtered_classes |> List.iter gen_destructor ; + + cmdlets_to_export := + [ + "Connect-XenServer" + ; "Disconnect-XenServer" + ; "Get-XenSession" + ; "Receive-XenPoolPatch" + ; "Send-XenOemPatchStream" + ; "Wait-XenTask" + ; "ConvertTo-XenRef" + ] + @ !cmdlets_to_export ; + + cmdlets_to_export := List.sort String.compare !cmdlets_to_export ; + + let module_json = + `O + [ + ( "cmdlets_to_export" + , `A + (List.map + (fun x -> + `O + [ + ("cmdlet_to_export", `String x) + ; ("is_last", `Bool (is_last x !cmdlets_to_export)) + ] + ) + !cmdlets_to_export + ) + ) + ] + in + render_file + ("XenServerPSModule.mustache", "XenServerPSModule.psd1") + module_json templdir destdir (****************) (* Http actions *) @@ -161,9 +216,11 @@ and gen_http_action action = ) ] in + let cmdlet_name = sprintf "%s-Xen%s" commonVerb stem in render_file - ("HttpAction.mustache", sprintf "%s-Xen%s.cs" commonVerb stem) - json templdir destdir + ("HttpAction.mustache", sprintf "%s.cs" cmdlet_name) + json templdir srcdir ; + cmdlets_to_export := cmdlet_name :: !cmdlets_to_export (*************************) (* Autogenerated cmdlets *) @@ -174,30 +231,30 @@ and gen_cmdlets obj = let cmdlets = [ - {filename= sprintf "Get-Xen%s.cs" stem; content= gen_class obj classname} + {cmdletname= sprintf "Get-Xen%s" stem; content= gen_class obj classname} ; { - filename= sprintf "New-Xen%s.cs" stem + cmdletname= sprintf "New-Xen%s" stem ; content= gen_constructor obj classname (List.filter is_constructor messages) } ; { - filename= sprintf "Remove-Xen%sProperty.cs" stem + cmdletname= sprintf "Remove-Xen%sProperty" stem ; content= gen_remover obj classname (List.filter is_remover messages) } ; { - filename= sprintf "Add-Xen%s.cs" stem + cmdletname= sprintf "Add-Xen%s" stem ; content= gen_adder obj classname (List.filter is_adder messages) } ; { - filename= sprintf "Set-Xen%s.cs" stem + cmdletname= sprintf "Set-Xen%s" stem ; content= gen_setter obj classname (List.filter is_setter messages) } ; { - filename= sprintf "Get-Xen%sProperty.cs" stem + cmdletname= sprintf "Get-Xen%sProperty" stem ; content= gen_getter obj classname (List.filter is_getter messages) } ; { - filename= sprintf "Invoke-Xen%s.cs" stem + cmdletname= sprintf "Invoke-Xen%s" stem ; content= gen_invoker obj classname (List.filter is_invoke messages) } ] @@ -205,8 +262,10 @@ and gen_cmdlets obj = cmdlets |> List.filter (fun x -> x.content <> "") -and write_file filename content = - let fn = Filename.concat destdir filename in +and write_file cmdletname content = + let filename = sprintf "%s.cs" cmdletname in + let fn = Filename.concat srcdir filename in + cmdlets_to_export := cmdletname :: !cmdlets_to_export ; with_output fn (fun x -> output_string x content) (*********************************) @@ -617,11 +676,13 @@ and gen_destructor obj = ; ("has_name", `Bool (has_name obj)) ] in + let cmdlet_name = + sprintf "Remove-Xen%s" (ocaml_class_to_csharp_class classname) + in render_file - ( "Remove-XenObject.mustache" - , sprintf "Remove-Xen%s.cs" (ocaml_class_to_csharp_class classname) - ) - json templdir destdir + ("Remove-XenObject.mustache", sprintf "%s.cs" cmdlet_name) + json templdir srcdir ; + cmdlets_to_export := cmdlet_name :: !cmdlets_to_export | _ -> assert false diff --git a/ocaml/sdk-gen/powershell/autogen/XenServerPSModule.psd1 b/ocaml/sdk-gen/powershell/templates/XenServerPSModule.mustache similarity index 90% rename from ocaml/sdk-gen/powershell/autogen/XenServerPSModule.psd1 rename to ocaml/sdk-gen/powershell/templates/XenServerPSModule.mustache index 968dfddce70..29336b1dec2 100644 --- a/ocaml/sdk-gen/powershell/autogen/XenServerPSModule.psd1 +++ b/ocaml/sdk-gen/powershell/templates/XenServerPSModule.mustache @@ -37,7 +37,7 @@ GUID = 'D695A8B9-039A-443C-99A4-0D48D7C6AD76' #Copyright Author = '' CompanyName = 'Cloud Software Group, Inc' -Copyright = 'Copyright (c) 2013-2025 Cloud Software Group, Inc. All rights reserved.' +Copyright = 'Copyright (c) 2013-2026 Cloud Software Group, Inc. All rights reserved.' # Requirements PowerShellVersion = '@PS_VERSION@' @@ -67,7 +67,11 @@ FileList = @('about_XenServer.help.txt', #Public interface FunctionsToExport = '' -CmdletsToExport = '*' +CmdletsToExport = @( +{{#cmdlets_to_export}} + '{{cmdlet_to_export}}'{{^is_last}},{{/is_last}} +{{/cmdlets_to_export}} +) VariablesToExport = @('Citrix.XenServer.Sessions','XenServer_Default_Session') AliasesToExport = '*' diff --git a/ocaml/tests/test_client.ml b/ocaml/tests/test_client.ml index fa35399a716..0a558c3f35e 100644 --- a/ocaml/tests/test_client.ml +++ b/ocaml/tests/test_client.ml @@ -10,7 +10,7 @@ work in unit tests. *) let make_client_params ~__context = let req = Xmlrpc_client.xmlrpc ~version:"1.1" "/" in - let rpc = Api_server.Server.dispatch_call req Unix.stdout in + let rpc = Api_server.Server.dispatch_call req None in let session_id = let session_id = Ref.make_secret () in let now = Clock.Date.now () in diff --git a/ocaml/tests/test_guest_agent.ml b/ocaml/tests/test_guest_agent.ml index 6bc0f227c7b..94774ac10c7 100644 --- a/ocaml/tests/test_guest_agent.ml +++ b/ocaml/tests/test_guest_agent.ml @@ -42,9 +42,7 @@ module Networks = Generic.MakeStateless (struct ) let construct_tree tree path = - let nodes = - Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path - in + let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in add_path_to_tree tree nodes let rec list_helper children = function @@ -60,9 +58,7 @@ module Networks = Generic.MakeStateless (struct ) let list (T (_root, children)) path = - let nodes = - Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path - in + let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in list_helper children nodes let transform input = @@ -231,9 +227,7 @@ module Initial_guest_metrics = Generic.MakeStateless (struct ) let construct_mtree mtree (path, leaf_value) = - let nodes = - Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path - in + let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in add_leaf_to_mtree nodes leaf_value mtree let rec list_helper children = function @@ -254,9 +248,7 @@ module Initial_guest_metrics = Generic.MakeStateless (struct | Lf (_, _) -> [] | Mt (_, children) -> - let nodes = - Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path - in + let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in list_helper children nodes let rec lookup_helper mtree = function @@ -274,9 +266,7 @@ module Initial_guest_metrics = Generic.MakeStateless (struct ) let lookup mtree path = - let nodes = - Xapi_stdext_std.Xstringext.String.split_f (fun s -> s = '/') path - in + let nodes = Astring.String.cuts ~empty:false ~sep:"/" path in lookup_helper mtree nodes let transform input = diff --git a/ocaml/tests/test_repository_helpers.ml b/ocaml/tests/test_repository_helpers.ml index 66c1f4b4b1e..4e698eb6843 100644 --- a/ocaml/tests/test_repository_helpers.ml +++ b/ocaml/tests/test_repository_helpers.ml @@ -4815,6 +4815,355 @@ module MergeLivepatchFailures = Generic.MakeStateless (struct ] end) +module GetAccumulativeLivepatches = Generic.MakeStateless (struct + module Io = struct + type input_t = {updates_info: UpdateInfo.t list; since: Livepatch.t} + + type output_t = (LivePatch.t * string) list + + let fields_of_input = + Fmt.Dump. + [ + field "updates_info" + (fun (r : input_t) -> + List.map + (fun x -> UpdateInfo.to_json x |> Yojson.Basic.pretty_to_string) + r.updates_info + ) + (list string) + ; field "since" + (fun (r : input_t) -> + Livepatch.to_json r.since |> Yojson.Basic.pretty_to_string + ) + string + ] + + let string_of_input_t = Fmt.(str "%a" Dump.(record @@ fields_of_input)) + + let string_of_output_t l = + Fmt.(str "%a" Dump.(list (pair string string))) + (List.map (fun (lp, id) -> (LivePatch.to_string lp, id)) l) + end + + let transform Io.{updates_info; since} = + let updates_info = List.map (fun x -> (x.UpdateInfo.id, x)) updates_info in + get_accumulative_livepatches ~updates_info ~since + |> List.map (fun (lp, x) -> (lp, x.UpdateInfo.id)) + + let running_build_id = "2dd4f262f044a1f5af78aaa6e71f97ce956ad74e" + + let lp = + LivePatch. + { + component= Xen + ; base_build_id= "" + ; base_version= "4.13.4" + ; base_release= "10.24.xs8" + ; to_version= "" + ; to_release= "" + } + + let update_info = + UpdateInfo. + { + id= "" + ; summary= "" + ; description= "" + ; guidance= [] + ; guidance_applicabilities= [] + ; spec_info= "" + ; url= "" + ; update_type= "security" + ; livepatches= [] + ; issued= Clock.Date.epoch + ; severity= Severity.None + ; title= "" + } + + let tests = + `QuickAndAutoDocumented + [ + ( Io. + { + updates_info= [] (* No updates provide any live patches *) + ; since= + Livepatch. + { + component= Xen + ; base_build_id= running_build_id + ; to_version= None (* No running live patch *) + ; to_release= None + } + } + , [] + ) + ; ( Io. + { + updates_info= + [ + { + update_info with + id= "UPDATE-1" + ; livepatches= + [ + { + lp with + base_build_id= running_build_id + ; to_version= "4.17.6" + ; to_release= "1" + } + ] + } + ] + ; since= + Livepatch. + { + component= Xen + ; base_build_id= running_build_id + ; to_version= None (* No running live patch *) + ; to_release= None + } + } + , [ + ( { + lp with + base_build_id= running_build_id + ; to_version= "4.17.6" + ; to_release= "1" + } + , "UPDATE-1" + ) + ] + ) + ; ( Io. + { + updates_info= + [ + { + update_info with + id= "UPDATE-1" + ; livepatches= + [ + { + lp with + base_build_id= running_build_id (* Can support *) + ; to_version= "4.17.6" + ; to_release= "1" + } + ] + } + ; { + update_info with + id= "UPDATE-2" + ; livepatches= + [ + { + lp with + base_build_id= running_build_id (* Can support *) + ; to_version= "4.17.6" + ; to_release= "2" + } + ; { + lp with + base_build_id= + "67edb2dca295cbc1591a1802c52015e0b875812d" + ; to_version= "4.17.6" + ; to_release= "2" + } + ] + } + ] + ; since= + Livepatch. + { + component= Xen + ; base_build_id= running_build_id + ; to_version= None (* No running live patch *) + ; to_release= None + } + } + , [ + ( { + lp with + base_build_id= running_build_id + ; to_version= "4.17.6" + ; to_release= "2" + } + , "UPDATE-2" + ) + ; ( { + lp with + base_build_id= running_build_id + ; to_version= "4.17.6" + ; to_release= "1" + } + , "UPDATE-1" + ) + ] + ) + ; ( Io. + { + updates_info= + [ + { + update_info with + id= "UPDATE-1" + ; livepatches= + [ + { + lp with + base_build_id= running_build_id (* Can support *) + ; to_version= "4.17.6" + ; to_release= "1" + } + ] + } + ; { + update_info with + id= "UPDATE-2" + ; livepatches= + [ + { + lp with + base_build_id= running_build_id (* Can support *) + ; to_version= "4.17.6" + ; to_release= "2" + } + ; { + lp with + base_build_id= + "67edb2dca295cbc1591a1802c52015e0b875812d" + ; to_version= "4.17.6" + ; to_release= "2" + } + ] + } + ; { + update_info with + id= "UPDATE-3" + ; livepatches= + (* Not suppported since this update *) + [ + { + lp with + base_build_id= + "67edb2dca295cbc1591a1802c52015e0b875812d" + ; to_version= "4.17.6" + ; to_release= "3" + } + ; { + lp with + base_build_id= + "332ed069fb106528e7161b31af07929375e4fdc6" + ; to_version= "4.17.6" + ; to_release= "3" + } + ] + } + ] + ; since= + Livepatch. + { + component= Xen + ; base_build_id= running_build_id + ; to_version= None (* No running live patch *) + ; to_release= None + } + } + , [] (* No applicable live patches returned. *) + ) + ; ( Io. + { + updates_info= + [ + { + update_info with + id= "UPDATE-1" + ; livepatches= + [ + { + lp with + base_build_id= running_build_id (* Can support *) + ; to_version= "4.17.6" + ; to_release= "1" + } + ] + } + ; { + update_info with + id= "UPDATE-2" + ; livepatches= + [ + { + lp with + base_build_id= running_build_id (* Can support *) + ; to_version= "4.17.6" + ; to_release= "2" + } + ; { + lp with + base_build_id= + "67edb2dca295cbc1591a1802c52015e0b875812d" + ; to_version= "4.17.6" + ; to_release= "2" + } + ] + } + ; { + update_info with + id= "UPDATE-3" + ; livepatches= + [ + { + lp with + base_build_id= + "67edb2dca295cbc1591a1802c52015e0b875812d" + ; to_version= "4.17.6" + ; to_release= "3" + } + ; { + lp with + base_build_id= + "332ed069fb106528e7161b31af07929375e4fdc6" + ; to_version= "4.17.6" + ; to_release= "3" + } + ] + } + ] + ; since= + Livepatch. + { + component= Xen + ; base_build_id= + "67edb2dca295cbc1591a1802c52015e0b875812d" + (* The build id of the running component has been updated. *) + ; to_version= None (* No running live patch *) + ; to_release= None + } + } + , [ + ( { + lp with + base_build_id= "67edb2dca295cbc1591a1802c52015e0b875812d" + ; to_version= "4.17.6" + ; to_release= "3" + } + , "UPDATE-3" + ) + ; ( { + lp with + base_build_id= "67edb2dca295cbc1591a1802c52015e0b875812d" + ; to_version= "4.17.6" + ; to_release= "2" + } + , "UPDATE-2" + ) + ] + ) + ] +end) + let tests = make_suite "repository_helpers_" [ @@ -4841,6 +5190,7 @@ let tests = ) ; ("set_pending_guidances", SetPendingGuidance.tests) ; ("merge_livepatch_failures", MergeLivepatchFailures.tests) + ; ("get_accumulative_livepatches", GetAccumulativeLivepatches.tests) ] let () = Alcotest.run "Repository Helpers" tests diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml index c0d91bd5663..8a18a7b1fc8 100644 --- a/ocaml/xapi-cli-server/cli_frontend.ml +++ b/ocaml/xapi-cli-server/cli_frontend.ml @@ -1881,7 +1881,7 @@ let rec cmdtable_data : (string * cmd_spec) list = ; help= "Calls the function within the plugin on the given vm with optional \ arguments (args:key=value). To pass a \"value\" string with special \ - characters in it (e.g. new line), an alternative syntax \ + characters in it (for example, new line), an alternative syntax \ args:key:file=local_file can be used in place, where the content of \ local_file will be retrieved and assigned to \"key\" as a whole." ; implementation= With_fd Cli_operations.vm_call_plugin @@ -1895,10 +1895,10 @@ let rec cmdtable_data : (string * cmd_spec) list = ; help= "Calls function fn within the plugin on the host where the VM is \ running with arguments (args:key=value). To pass a \"value\" string \ - with special characters in it (e.g. new line), an alternative \ - syntax args:key:file=local_file can be used in place, where the \ - content of local_file will be retrieved and assigned to \"key\" as \ - a whole." + with special characters in it (for example, new line), an \ + alternative syntax args:key:file=local_file can be used in place, \ + where the content of local_file will be retrieved and assigned to \ + \"key\" as a whole." ; implementation= With_fd Cli_operations.vm_call_host_plugin ; flags= [] } @@ -2262,8 +2262,8 @@ let rec cmdtable_data : (string * cmd_spec) list = ; "sm-config:" ] ; help= - "Create an SR, also a PBD. the device-config parameters can be \ - specified by e.g. device-config:foo=baa." + "Create an SR, also a PBD. The device-config parameters can be \ + specified by device-config:foo=baa, for example." ; implementation= With_fd Cli_operations.sr_create ; flags= [] } @@ -2274,7 +2274,7 @@ let rec cmdtable_data : (string * cmd_spec) list = ; optn= ["host-uuid"; "device-config:"; "sm-config:"] ; help= "Perform a storage probe. The device-config parameters can be \ - specified by e.g. device-config:devs=/dev/sdb1." + specified by device-config:devs=/dev/sdb1, for example." ; implementation= No_fd Cli_operations.sr_probe ; flags= [] } @@ -2285,9 +2285,9 @@ let rec cmdtable_data : (string * cmd_spec) list = ; optn= ["host-uuid"; "device-config:"; "sm-config:"] ; help= "Perform a storage probe. The device-config parameters can be \ - specified by e.g. device-config:devs=/dev/sdb1. Unlike sr-probe, \ - this command returns results in the same human-readable format for \ - every SR type." + specified by device-config:devs=/dev/sdb1, for example. Unlike \ + sr-probe, this command returns results in the same human-readable \ + format for every SR type." ; implementation= No_fd Cli_operations.sr_probe_ext ; flags= [] } diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 3af87afec06..aa5dc3d2842 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -1466,14 +1466,14 @@ let message_destroy_all (_ : printer) rpc session_id params = try Option.map Date.of_iso8601 before_str with _ -> fail - "invalid timestamp format for 'before' (expected RFC3339, e.g. \ + "invalid timestamp format for 'before' (expected RFC3339, for example, \ 2025-01-01T00:00:00Z)" in let after = try Option.map Date.of_iso8601 after_str with _ -> fail - "Invalid timestamp format for 'after' (expected RFC3339, e.g. \ + "Invalid timestamp format for 'after' (expected RFC3339, for example, \ 2025-01-01T00:00:00Z)" in let priority = diff --git a/ocaml/xapi-cli-server/cli_printer.ml b/ocaml/xapi-cli-server/cli_printer.ml index 294bb4036a0..b2b265f8dc9 100644 --- a/ocaml/xapi-cli-server/cli_printer.ml +++ b/ocaml/xapi-cli-server/cli_printer.ml @@ -61,9 +61,15 @@ let rec multi_line_record r = (* Used to escape commas in --minimal mode *) let escape_commas x = - (* Escaping rules: *) - let rules = [(',', "\\,"); (* , -> \, *) ('\\', "\\\\") (* \ -> \\ *)] in - Xapi_stdext_std.Xstringext.String.escaped ~rules x + let replace = function + | ',' -> + Some "\\," + | '\\' -> + Some "\\\\" + | _ -> + None + in + Xapi_stdext_std.Xstringext.String.replaced ~replace x let make_printer sock minimal = let buffer = ref [] in diff --git a/ocaml/xapi-consts/constants.ml b/ocaml/xapi-consts/constants.ml index f45d1e6983f..dd8e4e9416c 100644 --- a/ocaml/xapi-consts/constants.ml +++ b/ocaml/xapi-consts/constants.ml @@ -315,7 +315,7 @@ let owner_key = "owner" (* set in VBD other-config to indicate that clients can delete the attached VDI on VM uninstall if they want.. *) (* xapi-cli-server doesn't link xapi-globs *) -let use_event_next = ref true +let use_event_next = ref false (* the time taken to wait before restarting in a different mode for pool eject/join operations *) let fuse_time = ref 10. diff --git a/ocaml/xapi-guard/src/main.ml b/ocaml/xapi-guard/src/main.ml index 8e8cf4e787c..8bd28bb6cc4 100644 --- a/ocaml/xapi-guard/src/main.ml +++ b/ocaml/xapi-guard/src/main.ml @@ -333,7 +333,7 @@ open! Cmdliner let cmd = let info = Cmd.info daemon_name in let log_level = - let doc = "Syslog level. E.g. debug, info etc." in + let doc = "Syslog level. For example, debug, info etc." in let level_conv = let parse s = try `Ok (Syslog.level_of_string s) diff --git a/ocaml/xapi-idl/lib/debug_info.ml b/ocaml/xapi-idl/lib/debug_info.ml index e3845fa080d..d42512923f8 100644 --- a/ocaml/xapi-idl/lib/debug_info.ml +++ b/ocaml/xapi-idl/lib/debug_info.ml @@ -93,6 +93,8 @@ let with_dbg ?attributes ?(with_thread = false) ?(module_name = "") ~name ~dbg f | false -> f_with_trace () +let span_of di = di.tracing + let traceparent_of_dbg dbg = match String.split_on_char separator dbg with | [_; trace_context] -> ( diff --git a/ocaml/xapi-idl/lib/debug_info.mli b/ocaml/xapi-idl/lib/debug_info.mli index 2b0244ac94a..d2a2242befd 100644 --- a/ocaml/xapi-idl/lib/debug_info.mli +++ b/ocaml/xapi-idl/lib/debug_info.mli @@ -31,4 +31,6 @@ val with_dbg : -> (t -> 'a) -> 'a +val span_of : t -> Tracing.Span.t option + val traceparent_of_dbg : string -> string option diff --git a/ocaml/xapi-storage-cli/main.ml b/ocaml/xapi-storage-cli/main.ml index f581d6b6b48..ee7f6ba1e1b 100644 --- a/ocaml/xapi-storage-cli/main.ml +++ b/ocaml/xapi-storage-cli/main.ml @@ -578,8 +578,8 @@ let sr_attach_cmd = ; `P "Simple parameters may be written directly on the commandline as:" ; `P "key=value" ; `P - "If a particular value is stored in a file (e.g. as XML) then you may \ - write:" + "If a particular value is stored in a file (for example, as XML) then \ + you may write:" ; `P " key-filename=." ] @ help @@ -595,8 +595,8 @@ let sr_detach_cmd = `S "DESCRIPTION" ; `P "Disconnects from a connected storage repository, and frees any \ - associated resources (e.g. iSCSI sessions, other control connections \ - etc)." + associated resources (for example, iSCSI sessions, other control \ + connections etc)." ] @ help in @@ -651,7 +651,7 @@ let vdi_create_cmd = let format_arg = let doc = "Request a specific format for the disk on the backend storage \ - substrate, e.g. 'vhd' or 'raw'. Note that not all storage \ + substrate, for example, 'vhd' or 'raw'. Note that not all storage \ implementations support all formats. Every storage implementation will \ use its preferred format if no override is supplied." in diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 34372986c72..ca4661f2a88 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -2214,7 +2214,8 @@ let description = [ "Allow xapi storage adapters to be written as individual scripts." ; "To add a storage adapter, create a sub-directory in the --root directory" - ; "with the name of the adapter (e.g. org.xen.xcp.storage.mylvm) and place" + ; "with the name of the adapter (for example, org.xen.xcp.storage.mylvm) \ + and place" ; "the scripts inside." ] diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml index f53eda19ca6..2f6469de50a 100644 --- a/ocaml/xapi/api_server.ml +++ b/ocaml/xapi/api_server.ml @@ -33,7 +33,7 @@ let callback1 ?(json_rpc_version = Jsonrpc.V1) is_json req fd call = else let response = let@ req = Helper.with_tracing ~name:"Server.dispatch_call" req in - Server.dispatch_call req fd call + Server.dispatch_call req (Some fd) call in let translated = if diff --git a/ocaml/xapi/audit_log.ml b/ocaml/xapi/audit_log.ml index 2670a461339..c0c33495c23 100644 --- a/ocaml/xapi/audit_log.ml +++ b/ocaml/xapi/audit_log.ml @@ -113,12 +113,8 @@ let transfer_all_audit_files fd_out ?filter since = atransfer_try_gz "" (* map the ISO8601 timestamp format into the one in our logs *) -let log_timestamp_of_iso8601 iso8601_timestamp = - let module Xstringext = Xapi_stdext_std.Xstringext in - let step1 = iso8601_timestamp in - let step2 = Xstringext.String.replace "-" "" step1 in - let step3 = Xstringext.String.replace "Z" "" step2 in - step3 +let log_timestamp_of_iso8601 iso8601 = + Astring.String.filter (function '-' | 'Z' -> false | _ -> true) iso8601 (* Assume that RBAC access for the session_id already verified by xapi_http.ml diff --git a/ocaml/xapi/authx.ml b/ocaml/xapi/authx.ml index 22fe929d13e..e0349e9d81e 100644 --- a/ocaml/xapi/authx.ml +++ b/ocaml/xapi/authx.ml @@ -65,7 +65,7 @@ module AuthX : Auth_signature.AUTH_MODULE = struct | [] -> raise Not_found | line :: lines -> ( - let recs = Xapi_stdext_std.Xstringext.String.split ':' line in + let recs = String.split_on_char ':' line in let username = List.nth recs 0 in let uid = List.nth recs 2 in match fn username uid recs with @@ -311,9 +311,8 @@ module AuthX : Auth_signature.AUTH_MODULE = struct | _ -> raise Not_found - (* - In addition, there are some event hooks that auth modules implement as follows: -*) + (* In addition, there are some event hooks that auth modules implement as + follows: *) (* unit on_enable(((string*string) list) config_params) diff --git a/ocaml/xapi/config_file_sync.ml b/ocaml/xapi/config_file_sync.ml index b765f1ceae6..cf877745290 100644 --- a/ocaml/xapi/config_file_sync.ml +++ b/ocaml/xapi/config_file_sync.ml @@ -15,7 +15,6 @@ module D = Debug.Make (struct let name = "config_file_sync" end) open D -open Xapi_stdext_std.Xstringext let superuser = "root" @@ -58,7 +57,8 @@ let config_file_sync_handler (req : Http.Request.t) s _ = Xapi_http.with_context "Syncing dom0 config files over HTTP" req s (fun __context -> let uri = - String.split '/' req.Http.Request.path |> List.filter (fun x -> x <> "") + String.split_on_char '/' req.Http.Request.path + |> List.filter (fun x -> x <> "") in req.Http.Request.close <- true ; debug "sending headers" ; diff --git a/ocaml/xapi/console.ml b/ocaml/xapi/console.ml index efa1189c4f8..e88f666970e 100644 --- a/ocaml/xapi/console.ml +++ b/ocaml/xapi/console.ml @@ -265,9 +265,9 @@ let respond_console_limit_exceeded req s vm_id connected_users = error "The connected user list should not be empty." ; raise Failure | true, [user] -> - Printf.sprintf "User '%s' is" (Http_svr.escape user) + Printf.sprintf "User '%s' is" (Http_svr.escape_html user) | true, users -> - let escaped_users = List.map Http_svr.escape users in + let escaped_users = List.map Http_svr.escape_html users in Printf.sprintf "Users '%s' are" (String.concat ", " escaped_users) | false, _ -> "There're users" diff --git a/ocaml/xapi/context.ml b/ocaml/xapi/context.ml index 419c7d3f04d..3fc4d3bdb16 100644 --- a/ocaml/xapi/context.ml +++ b/ocaml/xapi/context.ml @@ -18,7 +18,10 @@ module D = Debug.Make (struct let name = "dummytaskhelper" end) (** Every operation has an origin: either the HTTP connection it came from or an internal subsystem (eg synchroniser thread / event handler thread) *) -type origin = Http of Http.Request.t * Unix.file_descr | Internal +type origin = + | Http of Http.Request.t * Unix.file_descr + | Internal + | Internal_Traced of Tracing.Span.t option let string_of_origin = function | Http (req, fd) -> @@ -32,7 +35,7 @@ let string_of_origin = function (* unfortunately all connections come from stunnel on localhost *) Printf.sprintf "HTTP request from %s with User-Agent: %s" peer (Option.value ~default:"unknown" req.Http.Request.user_agent) - | Internal -> + | Internal | Internal_Traced _ -> "Internal" (** A Context is used to represent every API invocation. It may be extended @@ -105,7 +108,7 @@ let default_database () = let preauth ~__context = match __context.origin with - | Internal -> + | Internal | Internal_Traced _ -> None | Http (_, s) -> ( match Unix.getsockname s with @@ -203,7 +206,7 @@ let trackid ?(with_brackets = false) ?(prefix = "") __context = trackid_of_session ~with_brackets ~prefix __context.session_id let _client_of_origin = function - | Internal -> + | Internal | Internal_Traced _ -> None | Http (req, fd) -> Http_svr.client_of_req_and_fd req fd @@ -233,7 +236,9 @@ let parent_of_origin (origin : origin) span_name = let* span_context = SpanContext.of_trace_context context in let span = Tracer.span_of_span_context span_context span_name in Some span - | _ -> + | Internal_Traced span -> + span + | Internal -> None let attribute_helper_fn f v = Option.fold ~none:[] ~some:f v @@ -312,7 +317,7 @@ let make_attributes ?task_name ?task_id ?task_uuid ?session_id ?origin () = ; attribute_helper_fn (fun origin -> match origin with - | Internal -> + | Internal | Internal_Traced _ -> [("xs.xapi.task.origin", "internal")] | Http (req, s) -> [attr_of_req req; attr_of_fd s] |> List.concat @@ -481,29 +486,28 @@ let get_http_other_config http_req = let of_http_req ?session_id ?(internal_async_subtask = false) ~generate_task_for ~supports_async ~label ~http_req ~fd () = let http_other_config = get_http_other_config http_req in + let origin = + match fd with None -> Internal | Some fd -> Http (http_req, fd) + in let new_task_context () = let subtask_of = Option.map Ref.of_string http_req.Http.Request.subtask_of in make ?session_id ?subtask_of ~http_other_config ~task_in_database:true - ~origin:(Http (http_req, fd)) - label + ~origin label in if internal_async_subtask then new_task_context () else match http_req.Http.Request.task with | Some task_id -> - from_forwarded_task ?session_id ~http_other_config - ~origin:(Http (http_req, fd)) + from_forwarded_task ?session_id ~http_other_config ~origin (Ref.of_string task_id) | None -> if generate_task_for && supports_async then new_task_context () else - make ?session_id ~http_other_config - ~origin:(Http (http_req, fd)) - label + make ?session_id ~http_other_config ~origin label let set_test_rpc context rpc = context.test_rpc <- Some rpc @@ -519,7 +523,11 @@ let get_client_ip context = context.client |> Option.map (fun (_, ip) -> Ipaddr.to_string ip) let get_user_agent context = - match context.origin with Internal -> None | Http (rq, _) -> rq.user_agent + match context.origin with + | Internal | Internal_Traced _ -> + None + | Http (rq, _) -> + rq.user_agent let finally_destroy_context ~__context f = let tracing = __context.tracing in diff --git a/ocaml/xapi/context.mli b/ocaml/xapi/context.mli index ac3250f8569..f5bb3ed3524 100644 --- a/ocaml/xapi/context.mli +++ b/ocaml/xapi/context.mli @@ -16,7 +16,10 @@ to include extra data without changing all the autogenerated signatures *) type t -type origin = Http of Http.Request.t * Unix.file_descr | Internal +type origin = + | Http of Http.Request.t * Unix.file_descr + | Internal + | Internal_Traced of Tracing.Span.t option (** {6 Constructors} *) @@ -49,7 +52,7 @@ val of_http_req : -> supports_async:bool -> label:string -> http_req:Http.Request.t - -> fd:Unix.file_descr + -> fd:Unix.file_descr option -> unit -> t diff --git a/ocaml/xapi/dbsync_slave.ml b/ocaml/xapi/dbsync_slave.ml index 16c3523139a..75a792bda17 100644 --- a/ocaml/xapi/dbsync_slave.ml +++ b/ocaml/xapi/dbsync_slave.ml @@ -17,7 +17,6 @@ *) module Rrdd = Rrd_client.Client -open Xapi_stdext_std.Xstringext module Unixext = Xapi_stdext_unix.Unixext module Date = Clock.Date open Create_misc @@ -86,9 +85,9 @@ let get_start_time () = match Unixext.string_of_file "/proc/stat" |> String.trim - |> String.split '\n' + |> String.split_on_char '\n' |> List.find (fun s -> String.starts_with ~prefix:"btime" s) - |> String.split ' ' + |> String.split_on_char ' ' with | _ :: btime :: _ -> let boot_time = Date.of_unix_time (float_of_string btime) in @@ -122,7 +121,7 @@ let refresh_localhost_info ~__context info = | None -> [] | Some {capabilities; _} -> - String.split ' ' capabilities + String.split_on_char ' ' capabilities in Db.Host.set_capabilities ~__context ~self:host ~value:caps ; Db.Host.set_address ~__context ~self:host ~value:(get_my_ip_addr ~__context) ; diff --git a/ocaml/xapi/extauth_plugin_ADwinbind.ml b/ocaml/xapi/extauth_plugin_ADwinbind.ml index 2fbf20ff17d..f328b971609 100644 --- a/ocaml/xapi/extauth_plugin_ADwinbind.ml +++ b/ocaml/xapi/extauth_plugin_ADwinbind.ml @@ -20,7 +20,6 @@ module D = Debug.Make (struct end) open D -open Xapi_stdext_std.Xstringext open Auth_signature module Listext = Xapi_stdext_std.Listext module Scheduler = Xapi_stdext_threads_scheduler.Scheduler @@ -50,8 +49,6 @@ let ( let* ) = Result.bind let ( ) x f = Rresult.R.reword_error f x -let ( >>| ) = Rresult.( >>| ) - let min_debug_level = 0 let max_debug_level = 10 @@ -723,37 +720,9 @@ module Wbinfo = struct let* stdout = call_wbinfo args in Ok (String.trim stdout) - type name = User of string | Other of string - - let string_of_name = function User x -> x | Other x -> x - - let name_of_sid = - (* example: - * $ wbinfo -s S-1-5-21-3143668282-2591278241-912959342-502 - CONNAPP\krbtgt 1 *) - (* the number returned after the name is the 'SID type' (grep for wbcSidType - * in samba source code). for our purposes, it is sufficient to assume that - * everything that is not a user is some 'other' type*) - let regex = Re.Perl.(compile (re {|^([^\s].*)\ (\d+)\s*$|})) in - let get_regex_match x = - Option.bind (Re.exec_opt regex x) (fun g -> - match Re.Group.all g with - | [|_; name; "1"|] -> - Some (User name) - | [|_; name; _|] -> - Some (Other name) - | _ -> - None - ) - in - fun sid -> - let args = ["--sid-to-name"; sid] in - let* stdout = call_wbinfo args in - match get_regex_match stdout with - | None -> - Error (parsing_ex args) - | Some x -> - Ok x + let sid_to_name sid = + let args = ["--sid-to-name"; sid] in + call_wbinfo args let gid_of_sid sid = let args = ["--sid-to-gid"; sid] in @@ -819,6 +788,70 @@ module Wbinfo = struct parse_uid_info stdout fun () -> parsing_ex args end +module Subject = struct + type t = User of string | Group of string + + let string_of_subject = function User x -> x | Group x -> x + + let from_wbinfo = + (* example: + * $ wbinfo -s S-1-5-21-3143668282-2591278241-912959342-502 + CONNAPP\krbtgt 1 *) + (* the number returned after the name is the 'SID type' (grep for wbcSidType + * in samba source code). for our purposes, it is sufficient to assume that + * everything that is not a user is some 'other' type*) + let regex = Re.Perl.(compile (re {|^([^\s].*)\s+(\d+)\s*$|})) in + let parse_name input sid = + match Re.exec_opt regex input with + | Some g -> ( + match Re.Group.all g with + | [|_; name; "1"|] -> + Ok (User name) + | [|_; name; _|] -> + Ok (Group name) + | _ -> + Error (generic_ex "Failed to parse output '%s' for sid %s" input sid) + ) + | None -> + Error (generic_ex "Failed to parse output '%s' for sid %s" input sid) + in + fun sid -> + let* stdout = Wbinfo.sid_to_name sid in + parse_name stdout sid + + let from_db ~__context sid = + let open Xapi_database.Db_filter_types in + match + Db.Subject.get_records_where ~__context + ~expr:(Eq (Field "subject_identifier", Literal sid)) + with + | (_, r) :: _ -> + let other_config = r.API.subject_other_config in + let* name = + List.assoc_opt "subject-name" other_config + |> Option.to_result + ~none:(generic_ex "subject-name not found in db for sid %s" sid) + in + + List.assoc_opt "subject-is-group" other_config + |> Option.map (fun s -> + match String.lowercase_ascii s with + | "true" -> + Group name + | _ -> + User name + ) + |> Option.to_result + ~none:(generic_ex "subject-is-group not found in db for sid %s" sid) + | [] -> + Error (generic_ex "Subject not found in db for sid %s" sid) + + let ( ||| ) a b = match a with Ok _ -> a | Error _ -> b + + let of_sid ~__context sid = + from_db ~__context sid ||| from_wbinfo sid |> maybe_raise +end + module Migrate_from_pbis = struct (* upgrade-pbis-to-winbind handles most of the migration from PBIS database * to winbind database @@ -1500,14 +1533,14 @@ module AuthADWinbind : Auth_signature.AUTH_MODULE = struct (Printf.sprintf "couldn't get SID from username='%s'" uname) in let* () = - match Wbinfo.name_of_sid sid >>| Wbinfo.string_of_name with - | Error e -> + match Subject.of_sid ~__context sid |> Subject.string_of_subject with + | uname -> + Wbinfo.kerberos_auth uname password + | exception e -> D.warn "authenticate_username_password: trying original uname. ex: %s" (Printexc.to_string e) ; Wbinfo.kerberos_auth orig_uname password - | Ok uname -> - Wbinfo.kerberos_auth uname password in Ok sid ) @@ -1617,18 +1650,20 @@ module AuthADWinbind : Auth_signature.AUTH_MODULE = struct it's a string*string list anyway for possible future expansion. Raises Not_found (*Subject_cannot_be_resolved*) if subject_id cannot be resolved by external auth service *) + (* Fallback uid/gid when the winbind daemon fails to resolve the SID *) + let invalid_id = -1 + let query_subject_information ~__context (sid : string) = Context.with_tracing ~__context __FUNCTION__ @@ fun __context -> cond_sync_ext_auth @@ fun () -> let res = - let* name = Wbinfo.name_of_sid sid in - match name with - | User _ -> - let* uid = Wbinfo.uid_of_sid sid in + match Subject.of_sid ~__context sid with + | Subject.User _ -> + let uid = Wbinfo.uid_of_sid sid |> Result.value ~default:invalid_id in query_subject_information_user ~__context uid sid - | Other name -> + | Subject.Group name -> (* if the name doesn't correspond to a user then it ought to be a group *) - let* gid = Wbinfo.gid_of_sid sid in + let gid = Wbinfo.gid_of_sid sid |> Result.value ~default:invalid_id in Ok (query_subject_information_group name gid sid) in (* we must raise Not_found here. see xapi_pool.ml:revalidate_subjects *) diff --git a/ocaml/xapi/fileserver.ml b/ocaml/xapi/fileserver.ml index 9820a55d5ce..8c83dac57f3 100644 --- a/ocaml/xapi/fileserver.ml +++ b/ocaml/xapi/fileserver.ml @@ -16,29 +16,17 @@ *) open Http -open Xapi_stdext_std.Xstringext +module Xstringext = Xapi_stdext_std.Xstringext.String module D = Debug.Make (struct let name = "fileserver" end) open D -let escape uri = - String.escaped - ~rules: - [ - ('<', "<") - ; ('>', ">") - ; ('\'', "'") - ; ('"', """) - ; ('&', "&") - ] - uri - let missing uri = " \ 404 Not Found

Not Found

The \ requested URL " - ^ escape uri + ^ Http_svr.escape_html uri ^ " was not found on this server.

Xapi \ Server
" diff --git a/ocaml/xapi/gpg.ml b/ocaml/xapi/gpg.ml index 1dd5c8141c8..def89c7890b 100644 --- a/ocaml/xapi/gpg.ml +++ b/ocaml/xapi/gpg.ml @@ -13,7 +13,6 @@ *) (** Wrapper around gpg *) -open Xapi_stdext_std.Xstringext open Xapi_stdext_pervasives.Pervasiveext module Unixext = Xapi_stdext_unix.Unixext @@ -26,7 +25,7 @@ let gpg_binary_path = "/usr/bin/gpg" exception InvalidSignature let parse_gpg_status status_data = - let lines = String.split '\n' status_data in + let lines = String.split_on_char '\n' status_data in let status_contains substr = List.exists (fun s -> String.starts_with ~prefix:substr s) lines in @@ -42,7 +41,7 @@ let parse_gpg_status status_data = let validsigline = List.find (fun s -> String.starts_with ~prefix:validsig s) lines in - match String.split ' ' validsigline with + match String.split_on_char ' ' validsigline with | _ :: _ :: fingerprint :: _ -> Some fingerprint | _ -> diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 854b9ce55fb..2cf210e1aeb 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -427,6 +427,11 @@ module TraceHelper = struct Tracing_propagator.Propagator.Http.inject_into trace_context end +(** Once the server functor has been instantiated, xapi sets this reference to the appropriate + "fake_rpc" (loopback non-HTTP) rpc function. + This way, internally the coordinator can short-circuit API calls without having to go over the network. *) +let rpc_fun : (Http.Request.t -> Rpc.call -> Rpc.response) option ref = ref None + let choose_rpc () = let open Xmlrpc_client in if !Xapi_globs.use_xmlrpc then @@ -445,19 +450,24 @@ let make_rpc' ~subtask_of ?task_id ~__context rpc : Rpc.response = let dorpc, path = choose_rpc () in let http = xmlrpc ~subtask_of ~version:"1.1" path in let http = TraceHelper.inject_span_into_req tracing http in - let transport = - if Pool_role.is_master () then - Unix Xapi_globs.unix_domain_socket - else - SSL - ( SSL.make ~use_stunnel_cache:true ~verify_cert:(Stunnel_client.pool ()) - ?task_id:(Option.map Ref.string_of task_id) - () - , Pool_role.get_master_address () - , !Constants.https_port - ) - in - dorpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http rpc + match !rpc_fun with + | Some rpcfun when Pool_role.is_master () -> + rpcfun http rpc + | _ -> + let transport = + if Pool_role.is_master () then + Unix Xapi_globs.unix_domain_socket + else + SSL + ( SSL.make ~use_stunnel_cache:true + ~verify_cert:(Stunnel_client.pool ()) + ?task_id:(Option.map Ref.string_of task_id) + () + , Pool_role.get_master_address () + , !Constants.https_port + ) + in + dorpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http rpc (* erase optional labeled arguments for partial applications to work *) let make_rpc ~__context rpc = diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index c768ee966a7..fbf5b53791f 100644 --- a/ocaml/xapi/import.ml +++ b/ocaml/xapi/import.ml @@ -19,7 +19,6 @@ module D = Debug.Make (struct let name = "import" end) open D module Listext = Xapi_stdext_std.Listext -module Xstringext = Xapi_stdext_std.Xstringext module Unixext = Xapi_stdext_unix.Unixext open Http open Importexport diff --git a/ocaml/xapi/map_check.ml b/ocaml/xapi/map_check.ml index 0583d7b2173..87f3ddb0fc7 100644 --- a/ocaml/xapi/map_check.ml +++ b/ocaml/xapi/map_check.ml @@ -109,7 +109,7 @@ let assert_value ~field ~key ~attr ~value = ) | EnumSet range -> (* enumset is a comma-separated string *) - let vs = Xapi_stdext_std.Xstringext.String.split ',' value in + let vs = String.split_on_char ',' value in List.fold_right (fun v acc -> match mem v range with @@ -118,7 +118,7 @@ let assert_value ~field ~key ~attr ~value = | Some v -> if acc = "" then v - else if Xapi_stdext_std.Xstringext.String.has_substr acc v then + else if Astring.String.is_infix ~affix:v acc then err value else v ^ "," ^ acc diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 5dece64745e..b26e1d748dd 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -208,6 +208,7 @@ let iter_with_drop ?(doc = "performing unknown operation") f xs = let log_exn ?(doc = "performing unknown operation") f x = try f x with e -> + Backtrace.is_important e ; debug "Caught exception while %s in message forwarder: %s" doc (ExnHelper.string_of_exn e) ; raise e @@ -332,9 +333,10 @@ functor let tolerate_connection_loss fn success timeout = try fn () with - | Api_errors.Server_error (ercode, params) + | Api_errors.Server_error (ercode, _) as e when ercode = Api_errors.cannot_contact_host -> + Backtrace.is_important e ; debug "Lost connection with slave during call (expected). Waiting for \ slave to come up again." ; @@ -346,8 +348,7 @@ functor let rec poll i = match i with | 0 -> - raise (Api_errors.Server_error (ercode, params)) - (* give up and re-raise exn *) + raise e (* give up and re-raise exn *) | i -> ( match success () with | Some result -> @@ -1317,6 +1318,7 @@ functor vbds ; vbds with e -> + Backtrace.is_important e ; debug "Caught exception marking VBD for %s on VM %s: %s" doc (Ref.string_of vm) (ExnHelper.string_of_exn e) ; @@ -1498,6 +1500,7 @@ functor (Helpers.will_have_qemu ~__context ~self:vm) ; Xapi_network_sriov_helpers.reserve_sriov_vfs ~__context ~host ~vm with e -> + Backtrace.is_important e ; clear_vif_reservations ~__context ~vm ; clear_reservations ~__context ~vm ; raise e @@ -1642,6 +1645,7 @@ functor ) ; try f () with exn -> + Backtrace.is_important exn ; if !restore_old_values_on_error then ( Db.VM.set_memory_dynamic_min ~__context ~self:vm ~value:old_dynamic_min ; @@ -5231,6 +5235,7 @@ functor (fun (vdi, op) -> mark_vdi ~__context ~vdi ~doc ~op) vdi with e -> + Backtrace.is_important e ; Option.iter (fun (sr, op) -> SR.unmark_sr ~__context ~sr ~doc ~op) sr ; @@ -6580,6 +6585,7 @@ functor -> ( match rest with | [] -> + Backtrace.is_important e ; debug "Ran out of hosts to try (and no cluster host on \ ourselves), reporting error" ; diff --git a/ocaml/xapi/nm.ml b/ocaml/xapi/nm.ml index 1474365a55a..a2aeb72d55f 100644 --- a/ocaml/xapi/nm.ml +++ b/ocaml/xapi/nm.ml @@ -14,7 +14,7 @@ module D = Debug.Make (struct let name = "nm" end) open D -open Xapi_stdext_std.Xstringext +module Stringext = Xapi_stdext_std.Xstringext.String module Listext = Xapi_stdext_std.Listext.List open Xapi_database.Db_filter_types open Network @@ -216,7 +216,7 @@ let create_bond ~__context bond mtu persistent = List.filter_map (fun (k, v) -> if String.starts_with ~prefix:"bond-" k then - Some (String.sub_to_end k 5, v) + Some (Stringext.sub_to_end k 5, v) else None ) @@ -470,7 +470,7 @@ let determine_static_routes net_rc = if List.mem_assoc "static-routes" net_rc.API.network_other_config then try let routes = - String.split ',' + String.split_on_char ',' (List.assoc "static-routes" net_rc.API.network_other_config) in List.map diff --git a/ocaml/xapi/pciops.ml b/ocaml/xapi/pciops.ml index 2126185474e..46cfdf377cc 100644 --- a/ocaml/xapi/pciops.ml +++ b/ocaml/xapi/pciops.ml @@ -126,7 +126,8 @@ let _unhide_pci ~__context pci = Printf.sprintf "(%s)" (Db.PCI.get_pci_id ~__context ~self:pci) in let new_value = - Xapi_stdext_std.Xstringext.String.replace bdf_paren "" raw_value + Astring.String.cuts ~empty:false ~sep:bdf_paren raw_value + |> String.concat "" in let cmd = match new_value with diff --git a/ocaml/xapi/pvs_proxy_control.ml b/ocaml/xapi/pvs_proxy_control.ml index ba1361796bc..6c1ddbd146b 100644 --- a/ocaml/xapi/pvs_proxy_control.ml +++ b/ocaml/xapi/pvs_proxy_control.ml @@ -21,7 +21,9 @@ open D let proxy_port_name vif = (* Interface names in Linux are at most 15 characters. We derive a name from the MAC address to ensure uniqueness, and make it fit. *) - let mac = Xapi_stdext_std.Xstringext.String.replace ":" "" vif.API.vIF_MAC in + let mac = + Astring.String.filter (function ':' -> false | _ -> true) vif.API.vIF_MAC + in Printf.sprintf "pvs%s" mac (** [proxies] returns all currently attached proxies *) diff --git a/ocaml/xapi/rbac_audit.ml b/ocaml/xapi/rbac_audit.ml index c4b02093bd5..663c41788df 100644 --- a/ocaml/xapi/rbac_audit.ml +++ b/ocaml/xapi/rbac_audit.ml @@ -368,8 +368,7 @@ and let has_to_audit action = let has_side_effect action = - not (Xapi_stdext_std.Xstringext.String.has_substr action ".get") - (* TODO: a bit slow? *) + not (Astring.String.is_infix ~affix:".get" action) in (!Xapi_globs.log_getter || has_side_effect action) && not @@ -463,9 +462,9 @@ let audit_line_of __context session_id allowed_denied ok_error result_error ?sexpr_of_args action permission ) in - let line = Xapi_stdext_std.Xstringext.String.replace "\n" " " _line in + let line = Xapi_stdext_std.Xstringext.String.replace '\n' ~by:" " _line in (* no \n in line *) - let line = Xapi_stdext_std.Xstringext.String.replace "\r" " " line in + let line = Xapi_stdext_std.Xstringext.String.replace '\r' ~by:" " line in (* no \r in line *) let audit_line = append_line "%s" line in (*D.debug "line=%s, audit_line=%s" line audit_line;*) @@ -480,7 +479,7 @@ let allowed_pre_fn ~__context ~action ?args () = if has_to_audit action (* for now, we only cache arg results for destroy actions *) - && Xapi_stdext_std.Xstringext.String.has_substr action ".destroy" + && Astring.String.is_infix ~affix:".destroy" action then let args' = add_dummy_args __context action args in Some (sexpr_of_parameters __context action args') diff --git a/ocaml/xapi/repository_helpers.ml b/ocaml/xapi/repository_helpers.ml index 1afa819a437..f463cd61be8 100644 --- a/ocaml/xapi/repository_helpers.ml +++ b/ocaml/xapi/repository_helpers.ml @@ -1115,11 +1115,57 @@ let get_livepatches_in_updateinfo ~updates_info ~component ~base_build_id = ) [] updates_info -(* Get all applicable livepatches which are newer than 'since' *) -let get_accumulative_livepatches ~since ~updates_info = - get_livepatches_in_updateinfo ~updates_info - ~component:since.Livepatch.component - ~base_build_id:since.Livepatch.base_build_id +(* Return true if the live patch for a component running with [base_build_id] + is supported in the latest relevant update. *) +let is_supported ~(updates_info : (UpdateInfo.id_t * UpdateInfo.t) list) + ~(component : Livepatch.component) ~(base_build_id : string) : bool = + let open LivePatch in + let open UpdateInfo in + let relevant_updates = + (* filter out most of the irrelevant update_info *) + updates_info + |> List.filter (fun (_, x) -> + List.exists (fun l -> l.component = component) x.livepatches + ) + in + relevant_updates + |> List.concat_map (fun (_, x) -> + x.livepatches + |> List.filter_map (fun lp -> + if lp.component = component then + Some (lp.to_version, lp.to_release) + else + None + ) + ) + |> get_latest_version_release + |> function + | Some (latest_to_version, latest_to_release) -> + let matched lp = + lp.component = component + && lp.to_version = latest_to_version + && lp.to_release = latest_to_release + && lp.base_build_id = base_build_id + in + relevant_updates + |> List.exists (fun (_, x) -> List.exists matched x.livepatches) + | None -> + false + +(* Get all applicable livepatches which are newer than 'since' and + is applicable in the latest relevant livepatch update. *) +let get_accumulative_livepatches ~(since : Livepatch.t) + ~(updates_info : (UpdateInfo.id_t * UpdateInfo.t) list) = + let component = since.Livepatch.component in + let base_build_id = since.Livepatch.base_build_id in + (fun f -> + if is_supported ~updates_info ~component ~base_build_id then + f () + else + [] + ) + @@ fun () -> + get_livepatches_in_updateinfo ~updates_info ~component ~base_build_id |> List.filter (fun (lp, _) -> let open LivePatch in match since with diff --git a/ocaml/xapi/server.mli b/ocaml/xapi/server.mli index c64558aad2c..1b51ae04d21 100644 --- a/ocaml/xapi/server.mli +++ b/ocaml/xapi/server.mli @@ -3,4 +3,4 @@ module Make : functor (_ : Custom_actions.CUSTOM_ACTIONS) -> sig val dispatch_call : - Http.Request.t -> Unix.file_descr -> Rpc.call -> Rpc.response end + Http.Request.t -> Unix.file_descr option -> Rpc.call -> Rpc.response end diff --git a/ocaml/xapi/server_helpers.mli b/ocaml/xapi/server_helpers.mli index 6651402acaa..9155469e26b 100644 --- a/ocaml/xapi/server_helpers.mli +++ b/ocaml/xapi/server_helpers.mli @@ -61,7 +61,7 @@ val do_dispatch : -> string -> (__context:Context.t -> 'a) -> ('a -> Rpc.t) - -> Unix.file_descr + -> Unix.file_descr option -> Http.Request.t -> string -> [< `Async | `InternalAsync | `Sync > `Sync `InternalAsync] diff --git a/ocaml/xapi/sm.ml b/ocaml/xapi/sm.ml index 1d198cf3f98..532f6fb44b1 100644 --- a/ocaml/xapi/sm.ml +++ b/ocaml/xapi/sm.ml @@ -15,7 +15,6 @@ * @group Storage *) -open Xapi_stdext_std.Xstringext open Smint open Printf diff --git a/ocaml/xapi/sm_exec.ml b/ocaml/xapi/sm_exec.ml index c4e2c46a1a9..8daf226ff58 100644 --- a/ocaml/xapi/sm_exec.ml +++ b/ocaml/xapi/sm_exec.ml @@ -30,8 +30,6 @@ module E = Debug.Make (struct let name = "mscgen" end) let cmd_name driver = sprintf "%s/%sSR" !Xapi_globs.sm_dir driver -let sm_username = "__sm__backend" - let with_dbg ~name ~dbg f = Debug_info.with_dbg ~module_name:"Sm_exec" ~name ~dbg f @@ -320,31 +318,6 @@ let methodResponse xml = (****************************************************************************************) (* Functions that actually execute the python backends *) -let with_session sr f = - Server_helpers.exec_with_new_task "sm_exec" (fun __context -> - let create_session () = - let host = !Xapi_globs.localhost_ref in - let session = - Xapi_session.login_no_password ~__context ~uname:None ~host - ~pool:false ~is_local_superuser:true ~subject:Ref.null - ~auth_user_sid:"" ~auth_user_name:sm_username ~rbac_permissions:[] - in - (* Give this session access to this particular SR *) - Option.iter - (fun sr -> - Db.Session.add_to_other_config ~__context ~self:session - ~key:Xapi_globs._sm_session ~value:(Ref.string_of sr) - ) - sr ; - session - in - let destroy_session session_id = - Xapi_session.destroy_db_session ~__context ~self:session_id - in - let session_id = create_session () in - finally (fun () -> f session_id) (fun () -> destroy_session session_id) - ) - let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string) (call : call) = with_dbg ~name:call.cmd ~dbg @@ fun di -> @@ -466,7 +439,8 @@ let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string) ) in if needs_session then - with_session call.sr_ref (fun session_id -> + Xapi_session.SM.with_session ~traceparent:(Debug_info.span_of di) + call.sr_ref (fun session_id -> do_call {call with session_ref= Some session_id} ) else diff --git a/ocaml/xapi/storage_mux.ml b/ocaml/xapi/storage_mux.ml index c2a0b7f32d2..e1d31f84844 100644 --- a/ocaml/xapi/storage_mux.ml +++ b/ocaml/xapi/storage_mux.ml @@ -103,7 +103,8 @@ module Mux = struct let m = Mutex.create () - let filename_of dp = Xapi_stdext_std.Xstringext.String.replace "/" "-" dp + let filename_of dp = + Xapi_stdext_std.Xstringext.String.replace '/' ~by:"-" dp let write dp info = let filename = filename_of dp in @@ -786,9 +787,9 @@ module Mux = struct (* Assume it has either the format: SR/VDI -- for a particular SR and VDI content_id -- for a particular content *) - let open Xapi_stdext_std.Xstringext in + let split = Xapi_stdext_std.Xstringext.String.split in with_dbg ~name:"get_by_name" ~dbg @@ fun di -> - match List.filter (fun x -> x <> "") (String.split ~limit:2 '/' name) with + match List.filter (fun x -> x <> "") (split ~limit:2 '/' name) with | [sr; name] -> let sr = Storage_interface.Sr.of_string sr in let module C = StorageAPI (Idl.Exn.GenClient (struct diff --git a/ocaml/xapi/system_domains.ml b/ocaml/xapi/system_domains.ml index c610424aeef..0b053d1dd39 100644 --- a/ocaml/xapi/system_domains.ml +++ b/ocaml/xapi/system_domains.ml @@ -17,155 +17,28 @@ let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute -module D = Debug.Make (struct let name = "system_domains" end) - -open D - (** If a VM is a system domain then xapi will perform lifecycle operations on demand, and will allow this VM to start even if a host is disabled. *) -let system_domain_key = "is_system_domain" - -let bool_of_string x = try bool_of_string x with _ -> false -let is_system_domain snapshot = - snapshot.API.vM_is_control_domain - || - let oc = snapshot.API.vM_other_config in - List.mem_assoc system_domain_key oc - && bool_of_string (List.assoc system_domain_key oc) +let is_system_domain snapshot = snapshot.API.vM_is_control_domain +(* NOTE: code that recognises the other_config:is_system_domain key has been dropped *) let get_is_system_domain ~__context ~self = is_system_domain (Db.VM.get_record ~__context ~self) -(* Notes on other_config keys: in the future these should become first-class fields. - For now note that although two threads may attempt to update these keys in parallel, - order shouldn't matter because everyone will always update them to the same value. - It's therefore safe to throw away exceptions. *) - -let set_is_system_domain ~__context ~self ~value = - Helpers.log_exn_continue - (Printf.sprintf "set_is_system_domain self = %s" (Ref.string_of self)) - (fun () -> - Db.VM.remove_from_other_config ~__context ~self ~key:system_domain_key ; - Db.VM.add_to_other_config ~__context ~self ~key:system_domain_key ~value - ) - () - -(** If a VM is a driver domain then it hosts backends for either disk or network - devices. We link PBD.other_config:storage_driver_domain_key to - VM.other_config:storage_driver_domain_key and we ensure the VM is marked as - a system domain. *) -let storage_driver_domain_key = "storage_driver_domain" - -let pbd_set_storage_driver_domain ~__context ~self ~value = - Helpers.log_exn_continue - (Printf.sprintf "pbd_set_storage_driver_domain self = %s" - (Ref.string_of self) - ) - (fun () -> - Db.PBD.remove_from_other_config ~__context ~self - ~key:storage_driver_domain_key ; - Db.PBD.add_to_other_config ~__context ~self ~key:storage_driver_domain_key - ~value - ) - () - -let vm_set_storage_driver_domain ~__context ~self ~value = - Helpers.log_exn_continue - (Printf.sprintf "vm_set_storage_driver_domain self = %s" (Ref.string_of self) - ) - (fun () -> - Db.VM.remove_from_other_config ~__context ~self - ~key:storage_driver_domain_key ; - Db.VM.add_to_other_config ~__context ~self ~key:storage_driver_domain_key - ~value - ) - () - -let record_pbd_storage_driver_domain ~__context ~pbd ~domain = - set_is_system_domain ~__context ~self:domain ~value:"true" ; - pbd_set_storage_driver_domain ~__context ~self:pbd - ~value:(Ref.string_of domain) ; - vm_set_storage_driver_domain ~__context ~self:domain ~value:(Ref.string_of pbd) - -let pbd_of_vm ~__context ~vm = - let other_config = Db.VM.get_other_config ~__context ~self:vm in - if List.mem_assoc storage_driver_domain_key other_config then - Some (Ref.of_string (List.assoc storage_driver_domain_key other_config)) - else - None - -let storage_driver_domain_of_pbd ~__context ~pbd = - let other_config = Db.PBD.get_other_config ~__context ~self:pbd in - let dom0 = Helpers.get_domain_zero ~__context in - if List.mem_assoc storage_driver_domain_key other_config then ( - let v = List.assoc storage_driver_domain_key other_config in - if Db.is_valid_ref __context (Ref.of_string v) then - Ref.of_string v - else - try Db.VM.get_by_uuid ~__context ~uuid:v - with _ -> - error "PBD %s has invalid %s key: falling back to dom0" - (Ref.string_of pbd) storage_driver_domain_key ; - dom0 - ) else - dom0 - -let storage_driver_domain_of_pbd ~__context ~pbd = - let domain = storage_driver_domain_of_pbd ~__context ~pbd in - set_is_system_domain ~__context ~self:domain ~value:"true" ; - pbd_set_storage_driver_domain ~__context ~self:pbd - ~value:(Ref.string_of domain) ; - vm_set_storage_driver_domain ~__context ~self:domain ~value:(Ref.string_of pbd) ; - domain - -let storage_driver_domain_of_vbd ~__context ~vbd = - let dom0 = Helpers.get_domain_zero ~__context in - let vdi = Db.VBD.get_VDI ~__context ~self:vbd in - if Db.is_valid_ref __context vdi then - let sr = Db.VDI.get_SR ~__context ~self:vdi in - let sr_pbds = Db.SR.get_PBDs ~__context ~self:sr in - let my_pbds = List.map fst (Helpers.get_my_pbds __context) in - match Xapi_stdext_std.Listext.List.intersect sr_pbds my_pbds with - | pbd :: _ -> - storage_driver_domain_of_pbd ~__context ~pbd - | _ -> - dom0 - else - dom0 - -let storage_driver_domain_of_sr_type ~__context ~_type = - let dom0 = Helpers.get_domain_zero ~__context in - dom0 - -let is_in_use ~__context ~self = - let other_config = Db.VM.get_other_config ~__context ~self in - List.mem_assoc storage_driver_domain_key other_config - && - let pbd = Ref.of_string (List.assoc storage_driver_domain_key other_config) in - if Db.is_valid_ref __context pbd then - Db.PBD.get_currently_attached ~__context ~self:pbd - else - false - -let queryable ~__context transport () = - let open Xmlrpc_client in - let tracing = Context.set_client_span __context in - let http = xmlrpc ~version:"1.0" "/" in - let http = Helpers.TraceHelper.inject_span_into_req tracing http in - let rpc = - XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"remote_smapiv2" ~transport ~http - in - let listMethods = Rpc.call "system.listMethods" [] in - try - let _ = rpc listMethods in - info "XMLRPC service found at %s" (string_of_transport transport) ; - true - with e -> - debug "Temporary failure querying storage service on %s: %s" - (string_of_transport transport) - (Printexc.to_string e) ; - false +(* NOTE: the storage domain functionality used to be based on + other-config:storage_driver_domain, which has been dropped *) + +let pbd_of_vm ~__context:_ ~vm:_ = None + +let storage_driver_domain_of_pbd ~__context ~pbd:_ = + Helpers.get_domain_zero ~__context + +let storage_driver_domain_of_vbd ~__context ~vbd:_ = + Helpers.get_domain_zero ~__context + +let storage_driver_domain_of_sr_type ~__context ~_type:_ = + Helpers.get_domain_zero ~__context type service = {uuid: string; ty: string; instance: string; url: string} [@@deriving rpc] @@ -186,11 +59,6 @@ let unregister_service service = Hashtbl.remove service_to_queue service ) -let get_service service = - with_lock service_to_queue_m (fun () -> - Hashtbl.find_opt service_to_queue service - ) - let list_services () = with_lock service_to_queue_m (fun () -> Hashtbl.fold (fun service _ acc -> service :: acc) service_to_queue [] diff --git a/ocaml/xapi/system_domains.mli b/ocaml/xapi/system_domains.mli index 33df12a6f54..8e1742c2a94 100644 --- a/ocaml/xapi/system_domains.mli +++ b/ocaml/xapi/system_domains.mli @@ -31,11 +31,6 @@ val storage_driver_domain_of_vbd : (** [storage_driver_domain_of_vbd __context pbd] returns the VM which is hosting the storage backends for [vbd] on this host *) -val record_pbd_storage_driver_domain : - __context:Context.t -> pbd:API.ref_PBD -> domain:API.ref_VM -> unit -(** [record_pbd_storage_driver_domain __context pbd domain] persists [domain] - as the driver domain for [pbd]. *) - val storage_driver_domain_of_sr_type : __context:Context.t -> _type:string -> API.ref_VM (** [storage_driver_domain_of_sr_type __context _type] returns the default VM which is hosting @@ -45,12 +40,6 @@ val pbd_of_vm : __context:Context.t -> vm:API.ref_VM -> API.ref_PBD option (** [pbd_of_vm __context vm] returns (Some pbd) if [vm] is a driver domain for [pbd] and None otherwise. *) -val is_in_use : __context:Context.t -> self:API.ref_VM -> bool -(** [is_in_use __context self] returns true if [self] is in use as a system domain *) - -val queryable : __context:Context.t -> Xmlrpc_client.transport -> unit -> bool -(** [queryable ip port ()] returns true if [ip]:[port] responsds to an XMLRPC query *) - (** One of many service running in a driver domain *) type service = {uuid: string; ty: string; instance: string; url: string} @@ -70,8 +59,5 @@ val register_service : service -> string -> unit val unregister_service : service -> unit (** [unregister_service service] forgets service [service] *) -val get_service : service -> string option -(** [get_service_address service] returns the queue_name associated with [service] or None *) - val list_services : unit -> services (** [list_services ()] returns all the registered services *) diff --git a/ocaml/xapi/vgpuops.ml b/ocaml/xapi/vgpuops.ml index d833fb98aa6..c2ae17a9538 100644 --- a/ocaml/xapi/vgpuops.ml +++ b/ocaml/xapi/vgpuops.ml @@ -15,7 +15,6 @@ module D = Debug.Make (struct let name = "vgpuops" end) open D module Listext = Xapi_stdext_std.Listext.List -open Xapi_stdext_std.Xstringext type vgpu_t = { vgpu_ref: API.ref_VGPU diff --git a/ocaml/xapi/wlb_reports.ml b/ocaml/xapi/wlb_reports.ml index 4f3868c79a9..9720112535e 100644 --- a/ocaml/xapi/wlb_reports.ml +++ b/ocaml/xapi/wlb_reports.ml @@ -92,7 +92,6 @@ open Printf open Http -open Xapi_stdext_std.Xstringext module D = Debug.Make (struct let name = "wlb_reports" end) diff --git a/ocaml/xapi/workload_balancing.ml b/ocaml/xapi/workload_balancing.ml index 9020b59542a..fc10900e473 100644 --- a/ocaml/xapi/workload_balancing.ml +++ b/ocaml/xapi/workload_balancing.ml @@ -16,7 +16,6 @@ *) open Printf -open Xapi_stdext_std.Xstringext module D = Debug.Make (struct let name = "workload_balancing" end) @@ -75,23 +74,12 @@ let raise_internal_error args = raise (Api_errors.Server_error (Api_errors.wlb_internal_error, args)) let split_host_port url = - try - if url.[0] = '[' then ( - (* IPv6 *) - let host_end = String.rindex url ']' in - if url.[host_end + 1] <> ':' then raise_url_invalid url ; - let host = String.sub url 1 (host_end - 1) in - let port = - String.sub url (host_end + 2) (String.length url - host_end - 2) - in - (host, int_of_string port) - ) else - match String.split_f (fun a -> a = ':') url with - | [host; port] -> - (host, int_of_string port) - | _ -> - raise_url_invalid url - with _ -> raise_url_invalid url + let uri = Uri.of_string ("//" ^ url) in + match (Uri.host uri, Uri.port uri) with + | None, _ | _, None -> + raise_url_invalid url + | Some host, Some port -> + (host, port) let wlb_host_port ~__context = let pool = Helpers.get_pool ~__context in diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml index 785950c384e..1293316ab53 100644 --- a/ocaml/xapi/xapi.ml +++ b/ocaml/xapi/xapi.ml @@ -159,11 +159,14 @@ let random_setup () = finally (fun () -> really_input chan s 0 n) (fun () -> close_in chan) ; Random.full_init (Array.init n (fun i -> Char.code (Bytes.get s i))) +let fake_rpc2 req rpc = Api_server.Server.dispatch_call req None rpc + let register_callback_fns () = let fake_rpc req sock xml : Rpc.response = Api_server.callback1 false req sock xml in Xapi_cli.rpc_fun := Some fake_rpc ; + Helpers.rpc_fun := Some fake_rpc2 ; Message_forwarding.register_callback_fns () let noevents = ref false diff --git a/ocaml/xapi/xapi_dr_task.ml b/ocaml/xapi/xapi_dr_task.ml index de7d15e0523..56626ea1368 100644 --- a/ocaml/xapi/xapi_dr_task.ml +++ b/ocaml/xapi/xapi_dr_task.ml @@ -13,7 +13,6 @@ *) open Client -open Xapi_stdext_std.Xstringext module D = Debug.Make (struct let name = "xapi_dr_task" end) diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index 5c7f352fe64..075ea6336b6 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -14,8 +14,6 @@ (** A central location for settings related to xapi *) -module String_plain = String (* For when we don't want the Xstringext version *) -open Xapi_stdext_std.Xstringext module StringSet = Set.Make (String) module D = Debug.Make (struct let name = "xapi_globs" end) @@ -242,8 +240,6 @@ let vbd_polling_idle_threshold_key = "polling-idle-threshold" (* set in VBD other-config *) -let vbd_backend_local_key = "backend-local" (* set in VBD other-config *) - let mac_seed = "mac_seed" (* set in a VM to generate MACs by hash chaining *) let ( ** ) = Int64.mul @@ -1108,7 +1104,7 @@ let max_traces = ref 10000 let max_span_depth = ref 100 -let use_xmlrpc = ref true +let use_xmlrpc = ref false let compress_tracing_files = ref true @@ -1189,7 +1185,8 @@ let make_batching name ~delay_before ~delay_between = (config, (name, Arg.String set, get, desc)) let event_from_delay, event_from_entry = - make_batching "event_from" ~delay_before:Mtime.Span.zero + make_batching "event_from" + ~delay_before:Mtime.Span.(50 * ms) ~delay_between:Mtime.Span.(50 * ms) let event_from_task_delay, event_from_task_entry = @@ -1392,12 +1389,12 @@ let citrix_patch_key = let trusted_patch_key = ref citrix_patch_key +let fields_of = Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white) + let gen_list_option name desc of_string string_of opt = let parse s = opt := [] ; - try - String.split_f String.isspace s - |> List.iter (fun x -> opt := of_string x :: !opt) + try fields_of s |> List.iter (fun x -> opt := of_string x :: !opt) with e -> D.error "Unable to parse %s=%s (expected space-separated list) error: %s" name s (Printexc.to_string e) @@ -1506,7 +1503,7 @@ let other_options = (fun s -> s) disable_dbsync_for ; ( "xenopsd-queues" - , Arg.String (fun x -> xenopsd_queues := String.split ',' x) + , Arg.String (fun x -> xenopsd_queues := String.split_on_char ',' x) , (fun () -> String.concat "," !xenopsd_queues) , "list of xenopsd instances to manage" ) @@ -1593,7 +1590,8 @@ let other_options = ; ( "nvidia_multi_vgpu_enabled_driver_versions" , Arg.String (fun x -> - nvidia_multi_vgpu_enabled_driver_versions := String.split ',' x + nvidia_multi_vgpu_enabled_driver_versions := + String.split_on_char ',' x ) , (fun () -> String.concat "," !nvidia_multi_vgpu_enabled_driver_versions) , "list of nvidia host driver versions with multiple vGPU supported.\n\ @@ -1861,7 +1859,7 @@ let other_options = , Arg.Bool (fun b -> ssh_auto_mode_default := b) , (fun () -> string_of_bool !ssh_auto_mode_default) , "Defaults to true; overridden to false via \ - /etc/xapi.conf.d/ssh-auto-mode.conf(e.g., in XenServer 8)" + /etc/xapi.conf.d/ssh-auto-mode.conf (for example, in XenServer 8)" ) ; ( "secure-boot-efi-path" , Arg.Set_string secure_boot_path diff --git a/ocaml/xapi/xapi_host_crashdump.ml b/ocaml/xapi/xapi_host_crashdump.ml index fbfb6dab643..d10ea4753ef 100644 --- a/ocaml/xapi/xapi_host_crashdump.ml +++ b/ocaml/xapi/xapi_host_crashdump.ml @@ -16,7 +16,6 @@ *) module Listext = Xapi_stdext_std.Listext -module Xstringext = Xapi_stdext_std.Xstringext module Date = Clock.Date open Xapi_stdext_pervasives.Pervasiveext open Xapi_support @@ -50,6 +49,8 @@ let delete_crashdump_dir filename = (ExnHelper.string_of_exn e) ; raise e +let fields_of = Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white) + (* Called once on host boot to resync the crash directory with the database *) let resynchronise ~__context ~host = debug "Xapi_host_crashdump.resynchronise" ; @@ -103,9 +104,7 @@ let resynchronise ~__context ~host = debug "Adding record corresponding to new crashdump %s" filename ; let cmd = Printf.sprintf "%s --bytes -s %s/%s" du crash_dir filename in let size = - match - Xstringext.String.(split_f isspace (Helpers.get_process_output cmd)) - with + match fields_of (Helpers.get_process_output cmd) with | size :: _ -> Int64.of_string size | _ -> diff --git a/ocaml/xapi/xapi_network.ml b/ocaml/xapi/xapi_network.ml index c2329074dc0..dfa15d0a18a 100644 --- a/ocaml/xapi/xapi_network.ml +++ b/ocaml/xapi/xapi_network.ml @@ -14,7 +14,6 @@ let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute open Client -open Xapi_stdext_std.Xstringext module D = Debug.Make (struct let name = "xapi_network" end) diff --git a/ocaml/xapi/xapi_pif.ml b/ocaml/xapi/xapi_pif.ml index b4c48b2f90a..8b44814aaee 100644 --- a/ocaml/xapi/xapi_pif.ml +++ b/ocaml/xapi/xapi_pif.ml @@ -19,7 +19,6 @@ module L = Debug.Make (struct let name = "license" end) open Xapi_database.Db_filter_types module Listext = Xapi_stdext_std.Listext.List -open Xapi_stdext_std.Xstringext module Date = Clock.Date open Network @@ -221,7 +220,9 @@ let refresh_all ~__context ~host = pifs let read_bridges_from_inventory () = - try String.split ' ' (Xapi_inventory.lookup Xapi_inventory._current_interfaces) + try + String.split_on_char ' ' + (Xapi_inventory.lookup Xapi_inventory._current_interfaces) with _ -> [] (* Ensure the PIF is not a bond slave. *) @@ -715,6 +716,8 @@ let forget ~__context ~self = let scan_m = Mutex.create () +let fields_of = Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white) + let scan ~__context ~host = let dbg = Context.string_of_task __context in refresh_all ~__context ~host ; @@ -724,15 +727,15 @@ let scan ~__context ~host = let output, _ = Forkhelpers.execute_command_get_output !Xapi_globs.non_managed_pifs [] in - let dsplit = String.split '\n' output in + let dsplit = String.split_on_char '\n' output in match dsplit with | [] | [""] | "" :: "" :: _ -> debug "No boot from SAN interface found" ; ([], []) | m :: u :: _ -> - (String.split_f String.isspace m, String.split_f String.isspace u) + (fields_of m, fields_of u) | m :: _ -> - (String.split_f String.isspace m, []) + (fields_of m, []) with e -> warn "Error when executing script %s: %s; ignoring" !Xapi_globs.non_managed_pifs diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 2bf02f90ac5..3f32cc959a4 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -16,7 +16,6 @@ open Client module Date = Clock.Date module Listext = Xapi_stdext_std.Listext module Unixext = Xapi_stdext_unix.Unixext -module Xstringext = Xapi_stdext_std.Xstringext module Pkgs = (val Pkg_mgr.get_pkg_mgr) diff --git a/ocaml/xapi/xapi_pool_update.ml b/ocaml/xapi/xapi_pool_update.ml index a1eb3f87037..51eb6d8f260 100644 --- a/ocaml/xapi/xapi_pool_update.ml +++ b/ocaml/xapi/xapi_pool_update.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Xapi_stdext_std.Xstringext +module Stringext = Xapi_stdext_std.Xstringext.String module Unixext = Xapi_stdext_unix.Unixext open Http open Helpers @@ -387,7 +387,7 @@ let parse_update_info xml = | "" -> [] | s -> - List.map guidance_from_string (String.split ',' s) + List.map guidance_from_string (String.split_on_char ',' s) with _ -> [] in let enforce_homogeneity = @@ -780,9 +780,10 @@ let resync_host ~__context ~host = let path_and_host_from_uri uri = (* remove any dodgy use of "." or ".." NB we don't prevent the use of symlinks *) let host_and_path = - String.sub_to_end uri (String.length Constants.get_pool_update_download_uri) + Stringext.sub_to_end uri + (String.length Constants.get_pool_update_download_uri) in - match String.split ~limit:2 '/' host_and_path with + match Stringext.split ~limit:2 '/' host_and_path with | [host; untrusted_path] -> let resolved_path = untrusted_path diff --git a/ocaml/xapi/xapi_secret.ml b/ocaml/xapi/xapi_secret.ml index 57492840ead..9ca6eb88276 100644 --- a/ocaml/xapi/xapi_secret.ml +++ b/ocaml/xapi/xapi_secret.ml @@ -15,8 +15,6 @@ * @group XenAPI functions *) -open Xapi_stdext_std.Xstringext - module D = Debug.Make (struct let name = "xapi_secret" end) open D diff --git a/ocaml/xapi/xapi_session.ml b/ocaml/xapi/xapi_session.ml index 968e9e78d0f..2868be43390 100644 --- a/ocaml/xapi/xapi_session.ml +++ b/ocaml/xapi/xapi_session.ml @@ -1589,3 +1589,77 @@ let create_from_db_file ~__context ~filename = in let db_ref = Some (Xapi_database.Db_ref.in_memory (Atomic.make db)) in create_readonly_session ~__context ~uname:"db-from-file" ~db_ref + +module SM = struct + let reusable_sessions : (string option, API.ref_session) Hashtbl.t = + Hashtbl.create 5 + + let sm_sessions_m = Mutex.create () + + let with_sm_sessions_lock f = + Xapi_stdext_threads.Threadext.Mutex.execute sm_sessions_m f + + let finally = Xapi_stdext_pervasives.Pervasiveext.finally + + let sm_username = "__sm__backend" + + let is_valid_session ~__context session_id = + try + (* Call an API function to check the session is still valid *) + let rpc = Helpers.make_rpc ~__context in + ignore (Client.Pool.get_all ~rpc ~session_id) ; + true + with Api_errors.Server_error (err, _) -> + debug "%s: Invalid session: %s" __FUNCTION__ err ; + false + + let session_access ~__context session sr = + (* Give this session access to this particular SR *) + Option.iter + (fun sr -> + Db.Session.add_to_other_config ~__context ~self:session + ~key:Xapi_globs._sm_session ~value:(Ref.string_of sr) + ) + sr + + let create_session ~__context sr = + let host = !Xapi_globs.localhost_ref in + let session = + login_no_password ~__context ~uname:None ~host ~pool:false + ~is_local_superuser:true ~subject:Ref.null ~auth_user_sid:"" + ~auth_user_name:sm_username ~rbac_permissions:[] + in + session_access ~__context session sr ; + session + + let get_session ~__context sr = + let sr_key = Option.map Ref.string_of sr in + with_sm_sessions_lock (fun () -> + match Hashtbl.find_opt reusable_sessions sr_key with + | Some session when is_valid_session ~__context session -> + session + | Some _ -> + Hashtbl.remove reusable_sessions sr_key ; + let new_session = create_session ~__context sr in + Hashtbl.add reusable_sessions sr_key new_session ; + new_session + | None -> + let new_session = create_session ~__context sr in + Hashtbl.add reusable_sessions sr_key new_session ; + new_session + ) + + let with_session ~traceparent sr f = + Server_helpers.exec_with_new_task "sm_exec" + ~origin:(Internal_Traced traceparent) (fun __context -> + if !Xapi_globs.reuse_pool_sessions then + let session_id = get_session ~__context sr in + f session_id + else + let session_id = create_session ~__context sr in + let destroy_session () = + destroy_db_session ~__context ~self:session_id + in + finally (fun () -> f session_id) destroy_session + ) +end diff --git a/ocaml/xapi/xapi_session.mli b/ocaml/xapi/xapi_session.mli index 10baf03abc2..2c1697423ea 100644 --- a/ocaml/xapi/xapi_session.mli +++ b/ocaml/xapi/xapi_session.mli @@ -112,3 +112,10 @@ val set_local_auth_max_threads : int64 -> unit val set_ext_auth_max_threads : int64 -> unit val clear_external_auth_cache : unit -> unit + +module SM : sig + val with_session : + traceparent:Tracing.Span.t option + -> [< Uuidx.all] Ref.t option + -> (Uuidx.secret Ref.t -> 'a) + -> 'a end diff --git a/ocaml/xapi/xapi_vbd_helpers.ml b/ocaml/xapi/xapi_vbd_helpers.ml index e90c0cda65a..9ebc9f48a82 100644 --- a/ocaml/xapi/xapi_vbd_helpers.ml +++ b/ocaml/xapi/xapi_vbd_helpers.ml @@ -15,7 +15,6 @@ * @group Storage *) -open Xapi_stdext_std.Xstringext module Listext = Xapi_stdext_std.Listext module Date = Clock.Date diff --git a/ocaml/xapi/xapi_vdi_helpers.ml b/ocaml/xapi/xapi_vdi_helpers.ml index 514bef0928c..47099164c9d 100644 --- a/ocaml/xapi/xapi_vdi_helpers.ml +++ b/ocaml/xapi/xapi_vdi_helpers.ml @@ -367,7 +367,7 @@ let find_backend_device path = let link = Unix.readlink (Printf.sprintf "/sys/dev/block/%d:%d/device" major minor) in - match List.rev (Xapi_stdext_std.Xstringext.String.split '/' link) with + match List.rev (String.split_on_char '/' link) with | id :: "xen" :: "devices" :: _ when Astring.String.is_prefix ~affix:"vbd-" id -> let id = int_of_string (String.sub id 4 (String.length id - 4)) in @@ -377,7 +377,7 @@ let find_backend_device path = xs.Xs.read (Printf.sprintf "device/vbd/%d/backend" id) in let params = xs.Xs.read (Printf.sprintf "%s/params" backend) in - match Xapi_stdext_std.Xstringext.String.split '/' backend with + match String.split_on_char '/' backend with | "local" :: "domain" :: bedomid :: _ -> if not (self = bedomid) then Helpers.internal_error diff --git a/ocaml/xapi/xapi_vif_helpers.ml b/ocaml/xapi/xapi_vif_helpers.ml index 4f6f4310ad5..fc1eb8a3127 100644 --- a/ocaml/xapi/xapi_vif_helpers.ml +++ b/ocaml/xapi/xapi_vif_helpers.ml @@ -12,8 +12,6 @@ * GNU Lesser General Public License for more details. *) -open Xapi_stdext_std.Xstringext - module D = Debug.Make (struct let name = "xapi_vif_helpers" end) open D diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index d6405f1499e..25526423f0e 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -1274,7 +1274,7 @@ let migrate_send' ~__context ~vm ~dest ~live:_ ~vdi_map ~vif_map ~vgpu_map ( Api_errors.operation_not_allowed , [ "Copy mode is disallowed on intra pool storage migration, try \ - efficient alternatives e.g. VM.copy/clone." + efficient alternatives, for example, VM.copy/clone." ] ) ) ; diff --git a/ocaml/xapi/xapi_vusb_helpers.ml b/ocaml/xapi/xapi_vusb_helpers.ml index 6a1a98088e5..98d0d31d642 100644 --- a/ocaml/xapi/xapi_vusb_helpers.ml +++ b/ocaml/xapi/xapi_vusb_helpers.ml @@ -12,8 +12,6 @@ * GNU Lesser General Public License for more details. *) -open Xapi_stdext_std.Xstringext - module D = Debug.Make (struct let name = "xapi_vusb_helpers" end) (**************************************************************************************) diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 1fa6fd8ff8c..017e3a1b4b2 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -17,9 +17,9 @@ module D = Debug.Make (struct let name = "xenops" end) open D module StringSet = Set.Make (String) open Network -open Xapi_stdext_std.Xstringext module Date = Clock.Date module Listext = Xapi_stdext_std.Listext.List +module Stringext = Xapi_stdext_std.Xstringext.String let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute @@ -129,7 +129,7 @@ let disk_of_vdi ~__context ~self = let vdi_of_disk ~__context x = let@ __context = Context.with_tracing ~__context __FUNCTION__ in - match String.split ~limit:2 '/' x with + match Stringext.split ~limit:2 '/' x with | [sr_uuid; location] -> ( let open Xapi_database.Db_filter_types in let sr = Db.SR.get_by_uuid ~__context ~uuid:sr_uuid in @@ -678,16 +678,7 @@ module MD = struct ) ) in - let backend_of_vbd vbd = - let vbd_oc = vbd.API.vBD_other_config in - if List.mem_assoc Xapi_globs.vbd_backend_local_key vbd_oc then ( - let path = List.assoc Xapi_globs.vbd_backend_local_key vbd_oc in - warn "Using local override for VBD backend: %s -> %s" vbd.API.vBD_uuid - path ; - Some (Local path) - ) else - disk_of_vdi ~__context ~self:vbd.API.vBD_VDI - in + let backend_of_vbd vbd = disk_of_vdi ~__context ~self:vbd.API.vBD_VDI in let can_attach_early = let sr_opt = try Some (Db.VDI.get_SR ~__context ~self:vbd.API.vBD_VDI) @@ -1190,8 +1181,8 @@ module MD = struct let affinity = try List.map - (fun x -> List.map int_of_string (String.split ',' x)) - (String.split ';' (List.assoc "mask" vm.API.vM_VCPUs_params)) + (fun x -> List.map int_of_string (String.split_on_char ',' x)) + (String.split_on_char ';' (List.assoc "mask" vm.API.vM_VCPUs_params)) with _ -> [] in let localhost = Helpers.get_localhost ~__context in @@ -1201,7 +1192,9 @@ module MD = struct let host_cpu_mask = try List.map int_of_string - (String.split ',' (List.assoc "mask" host_guest_VCPUs_params)) + (String.split_on_char ',' + (List.assoc "mask" host_guest_VCPUs_params) + ) with _ -> [] in let affinity = @@ -1996,7 +1989,9 @@ let update_vm_internal ~__context ~id ~self ~previous ~info ~localhost = String.sub path (String.length dir) (String.length path - String.length dir) in - match List.filter (fun x -> x <> "") (String.split '/' rest) with + match + List.filter (fun x -> x <> "") (String.split_on_char '/' rest) + with | x :: _ -> Some x | _ -> diff --git a/ocaml/xapi/xha_interface.ml b/ocaml/xapi/xha_interface.ml index 9f74e7b761d..18962fc604d 100644 --- a/ocaml/xapi/xha_interface.ml +++ b/ocaml/xapi/xha_interface.ml @@ -12,7 +12,6 @@ * GNU Lesser General Public License for more details. *) open API -open Xapi_stdext_std.Xstringext let hashtbl_of_list xs = let tbl = Hashtbl.create (List.length xs) in @@ -350,7 +349,10 @@ module LiveSetInformation = struct | Some u -> u in - let set f x = List.map f (String.split_f String.isspace x) in + let fields_of = + Astring.(String.fields ~empty:false ~is_sep:Char.Ascii.is_white) + in + let set f x = List.map f (fields_of x) in Some { id= uuid (find "HostID") diff --git a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml index d3b8864d703..9cf1cbb5650 100644 --- a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml +++ b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml @@ -437,7 +437,7 @@ let exec_tap_ctl_list () : ((string * string) * int) list = let minor_of_tapdev_unsafe tapdev = int_of_string (Unixext.file_lines_fold - (fun acc l -> acc ^ List.nth (Xstringext.String.split ':' l) 1) + (fun acc l -> acc ^ List.nth (String.split_on_char ':' l) 1) "" ("/sys/block/" ^ tapdev ^ "/dev") ) diff --git a/ocaml/xcp-rrdd/bin/rrdp-scripts/logrotate-rrdd-plugins b/ocaml/xcp-rrdd/bin/rrdp-scripts/logrotate-rrdd-plugins index d6d29055602..3ce83bfc4ed 100644 --- a/ocaml/xcp-rrdd/bin/rrdp-scripts/logrotate-rrdd-plugins +++ b/ocaml/xcp-rrdd/bin/rrdp-scripts/logrotate-rrdd-plugins @@ -1,5 +1,5 @@ /var/log/xcp-rrdd-plugins.log { postrotate - /bin/kill -HUP `cat /var/run/syslogd.pid 2> /dev/null` 2> /dev/null || true + /usr/bin/systemctl kill -s HUP rsyslog.service >/dev/null 2>&1 || true endscript } diff --git a/ocaml/xcp-rrdd/bin/rrdp-squeezed/rrdp_squeezed.ml b/ocaml/xcp-rrdd/bin/rrdp-squeezed/rrdp_squeezed.ml index 33ef08dc91a..c0795f34648 100644 --- a/ocaml/xcp-rrdd/bin/rrdp-squeezed/rrdp_squeezed.ml +++ b/ocaml/xcp-rrdd/bin/rrdp-squeezed/rrdp_squeezed.ml @@ -12,7 +12,6 @@ * GNU Lesser General Public License for more details. *) -open Xapi_stdext_std open Rrdd_plugin module Process = Process (struct let name = "xcp-rrdd-squeezed" end) @@ -81,7 +80,7 @@ module MemoryActions = struct path domid ; current_memory_values := IntMap.remove domid !current_memory_values in - match List.filter (fun x -> x <> "") (Xstringext.String.split '/' path) with + match List.filter (fun x -> x <> "") (String.split_on_char '/' path) with | ["local"; "domain"; domid; "memory"; "dynamic-max"] -> read_new_value domid current_dynamic_max_values | ["local"; "domain"; domid; "memory"; "dynamic-min"] -> diff --git a/ocaml/xe-cli/dune b/ocaml/xe-cli/dune index d4d3101fa6b..86a328a9ab8 100644 --- a/ocaml/xe-cli/dune +++ b/ocaml/xe-cli/dune @@ -17,7 +17,6 @@ xapi-log.backtrace xapi-cli-protocol xapi-stdext-pervasives - xapi-stdext-std xapi-stdext-unix ) ) diff --git a/ocaml/xe-cli/newcli.ml b/ocaml/xe-cli/newcli.ml index fa95520059b..065b13a04d4 100644 --- a/ocaml/xe-cli/newcli.ml +++ b/ocaml/xe-cli/newcli.ml @@ -13,7 +13,6 @@ *) (* New cli talking to the in-server cli interface *) -open Xapi_stdext_std.Xstringext open Xapi_stdext_pervasives open Cli_protocol @@ -318,7 +317,7 @@ let parse_args = || (extra_args.[!i] = ',' && extra_args.[!i - 1] <> '\\') then ( let seg = String.sub extra_args !pos (!i - !pos) in - l := String.filter_chars seg (( <> ) '\\') :: !l ; + l := Astring.String.filter (( <> ) '\\') seg :: !l ; incr i ; pos := !i ) else @@ -401,7 +400,7 @@ let with_open_channels f = match result with Ok r -> r | Error e -> raise e let http_response_code x = - match String.split ' ' x with + match String.split_on_char ' ' x with | _ :: code :: _ -> int_of_string code | _ -> diff --git a/ocaml/xenopsd/pvs/pvs_proxy_setup.ml b/ocaml/xenopsd/pvs/pvs_proxy_setup.ml index c458b395cae..e849a9e0b5f 100644 --- a/ocaml/xenopsd/pvs/pvs_proxy_setup.ml +++ b/ocaml/xenopsd/pvs/pvs_proxy_setup.ml @@ -563,7 +563,7 @@ module CLI = struct C.Arg.( required & pos 1 (some string) None - & info [] ~docv:"vif4.0" ~doc:"Device name, e.g. vif4.0" + & info [] ~docv:"vif4.0" ~doc:"Device name, for example, vif4.0" ) (** xenstore path *) diff --git a/ocaml/xenopsd/scripts/qemu-wrapper b/ocaml/xenopsd/scripts/qemu-wrapper index 554590d0713..6c7609f696d 100644 --- a/ocaml/xenopsd/scripts/qemu-wrapper +++ b/ocaml/xenopsd/scripts/qemu-wrapper @@ -23,6 +23,7 @@ import subprocess import ctypes import ctypes.util import os +import re from resource import getrlimit, RLIMIT_CORE, RLIMIT_FSIZE, setrlimit import xen.lowlevel.xs as xs @@ -53,6 +54,9 @@ CLONE_NEWNS = 0x00020000 # mount namespace CLONE_NEWNET = 0x40000000 # network namespace CLONE_NEWIPC = 0x08000000 # IPC namespace +QEMU_VERSION_REGEX = "QEMU emulator version (\d+)\.\d+\.\d+" +QEMU_UPGRADED_MAJOR_VERSION = 10 + def unshare(flags): libc = ctypes.CDLL(ctypes.util.find_library('c'), use_errno=True) unshare_prototype = ctypes.CFUNCTYPE(ctypes.c_int, ctypes.c_int, use_errno=True) @@ -78,6 +82,21 @@ def close_fds(): for i in open_fds: os.close(i) +def get_qemu_major_version(qemu_dm): + process = subprocess.run([qemu_dm, "-version"], capture_output=True, text=True) + process.check_returncode() + + qemu_version_line = process.stdout.splitlines()[0] + match = re.match(QEMU_VERSION_REGEX, qemu_version_line) + if not match: + print("Checking major version of qemu_dm=%s" % qemu_dm) + print("$ %s -version" % qemu_dm) + print(process.stdout) + print(process.stderr) + raise Exception("Could not identify QEMU major version") + + return int(match.group(1)) + def prepare_exec(): """Set up the execution environment for QEMU.""" @@ -129,6 +148,7 @@ def main(argv): break qemu_dm = '/usr/lib64/xen/bin/qemu-system-i386' + qemu_version = get_qemu_major_version(qemu_dm) qemu_args = ['qemu-dm-%d' % domid] mmio_start = HVM_BELOW_4G_MMIO_START @@ -154,7 +174,7 @@ def main(argv): '%s,accel=xen,max-ram-below-4g=%lu,' 'suppress-vmdesc=on,' 'allow-unassigned=true,trad_compat=%s%s' - % (machine, mmio_start, trad_compat, igdpt)]) + % (machine, mmio_start, trad_compat and "on" or "off", igdpt)]) qemu_args.extend(argv[2:]) @@ -283,11 +303,16 @@ def main(argv): raise qemu_args += ["-xen-domid-restrict"] - qemu_args += ["-chroot", root_dir] uid = pwd.getpwnam('qemu_base').pw_uid + domid gid = grp.getgrnam('qemu_base').gr_gid + domid - qemu_args += ["-runas", "%d:%d" % (uid, gid)] + + if qemu_version >= QEMU_UPGRADED_MAJOR_VERSION: + qemu_args += ["-run-with", "chroot=%s" % root_dir] + qemu_args += ["-run-with", "user=%d:%d" % (uid, gid)] + else: + qemu_args += ["-chroot", root_dir] + qemu_args += ["-runas", "%d:%d" % (uid, gid)] xenstore_write("/libxl/%d/dm-version" % domid, "qemu_xen") diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index adedf798d6f..a2971937d79 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -2788,7 +2788,7 @@ module Backend = struct ; ["-global"; "PIIX4_PM.revision_id=0x1"] ; ["-global"; "ide-hd.ver=0.10.2"] ; mult - ["piix3-ide-xen"; "piix3-usb-uhci"; nic_type] + ["piix3-ide"; "piix3-ide-xen"; "piix3-usb-uhci"; nic_type] ["subvendor_id=0x5853"; "subsystem_id=0x0001"] |> List.concat_map (fun x -> ["-global"; x]) ] diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index facdee7845d..fdb8b9c27f4 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -1852,13 +1852,16 @@ module VM = struct "VM = %s; using memory_dynamic_min = %Ld and \ memory_dynamic_max = %Ld" vm.Vm.id vm.memory_dynamic_min vm.memory_dynamic_max ; - (vm.memory_dynamic_min, vm.memory_dynamic_max, None) + ( vm.memory_dynamic_min +++ overhead_bytes + , vm.memory_dynamic_max +++ overhead_bytes + , None + ) ) in - let min_kib = kib_of_bytes_used (min_bytes +++ overhead_bytes) + let min_kib = kib_of_bytes_used min_bytes and memory_total_source_kib = Option.map kib_of_bytes_used memory_total_source_bytes - and max_kib = kib_of_bytes_used (max_bytes +++ overhead_bytes) in + and max_kib = kib_of_bytes_used max_bytes in (* XXX: we would like to be able to cancel an in-progress with_reservation *) let dbg = Xenops_task.get_dbg task in diff --git a/ocaml/xs-trace/xs_trace.ml b/ocaml/xs-trace/xs_trace.ml index cce16119e47..175abbd4296 100644 --- a/ocaml/xs-trace/xs_trace.ml +++ b/ocaml/xs-trace/xs_trace.ml @@ -70,12 +70,13 @@ module Cli = struct open Cmdliner let src = - let doc = "The trace file, e.g. /path/to/trace.ndjson" in + let doc = "The trace file, for example, /path/to/trace.ndjson" in Arg.(required & pos 0 (some string) None (info [] ~docv:"SRC" ~doc)) let dst = let doc = - "The destination endpoint URL, e.g. http://localhost:9411/api/v2/spans" + "The destination endpoint URL, for example, \ + http://localhost:9411/api/v2/spans" in Arg.(required & pos 1 (some string) None (info [] ~docv:"DST" ~doc)) diff --git a/opam/xapi-debug.opam b/opam/xapi-debug.opam index 9febe70fb5f..bbfb1827c25 100644 --- a/opam/xapi-debug.opam +++ b/opam/xapi-debug.opam @@ -58,6 +58,7 @@ depends: [ "xapi-stdext-pervasives" "xapi-stdext-unix" "xapi-stdext-zerocheck" + "xapi-work-queues" "xen-api-client" "xen-api-client-lwt" "xenctrl" diff --git a/opam/xapi-storage-cli.opam b/opam/xapi-storage-cli.opam index c91efa52615..ab152653112 100644 --- a/opam/xapi-storage-cli.opam +++ b/opam/xapi-storage-cli.opam @@ -18,6 +18,7 @@ depends: [ "xapi-idl" {= version} "xapi-types" {= version} "xapi-stdext-zerocheck" {= version} + "xapi-work-queues" {= version} "odoc" {with-doc} ] build: [ diff --git a/opam/xapi-tools.opam b/opam/xapi-tools.opam index 4eb45997bff..d5f44ad1193 100644 --- a/opam/xapi-tools.opam +++ b/opam/xapi-tools.opam @@ -32,6 +32,7 @@ depends: [ "rrdd-plugin" "xapi-stdext-std" "xapi-tracing-export" + "xapi-work-queues" "xen-api-client" "alcotest" {with-test} "ppx_deriving_rpc" {with-test} diff --git a/opam/xapi-work-queues.opam b/opam/xapi-work-queues.opam index 5a6da110c01..cce534ec435 100644 --- a/opam/xapi-work-queues.opam +++ b/opam/xapi-work-queues.opam @@ -7,6 +7,8 @@ homepage: "https://xapi-project.github.io/" bug-reports: "https://github.com/xapi-project/xen-api/issues" depends: [ "dune" {>= "3.20"} + "ppx_deriving_rpc" + "xapi-stdext-threads" "odoc" {with-doc} ] build: [ diff --git a/opam/xapi.opam b/opam/xapi.opam index 1c0f62a6cee..1db83dc844e 100644 --- a/opam/xapi.opam +++ b/opam/xapi.opam @@ -87,6 +87,7 @@ depends: [ "xapi-tracing" {= version} "xapi-tracing-export" {= version} "xapi-types" {= version} + "xapi-work-queues" {= version} "xen-api-client-lwt" {= version} "xenctrl" "xenstore_transport" diff --git a/scripts/audit-logrotate b/scripts/audit-logrotate index 486fe826e44..3a13805a127 100644 --- a/scripts/audit-logrotate +++ b/scripts/audit-logrotate @@ -2,7 +2,6 @@ missingok sharedscripts postrotate - /bin/kill -HUP `cat /var/run/syslogd.pid 2> /dev/null` 2> /dev/null || true - /bin/kill -HUP `cat /var/run/rsyslogd.pid 2> /dev/null` 2> /dev/null || true + /usr/bin/systemctl kill -s HUP rsyslog.service >/dev/null 2>&1 || true endscript } diff --git a/scripts/xapi-logrotate.conf b/scripts/xapi-logrotate.conf index e9d4845d582..6eda2f421df 100644 --- a/scripts/xapi-logrotate.conf +++ b/scripts/xapi-logrotate.conf @@ -14,6 +14,6 @@ rotate 100 postrotate - /bin/kill -HUP `cat /var/run/syslogd.pid 2> /dev/null` 2> /dev/null || true + /usr/bin/systemctl kill -s HUP rsyslog.service >/dev/null 2>&1 || true endscript }