<commit_before>(*
 * Copyright (C) Citrix Systems Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published
 * by the Free Software Foundation; version 2.1 only. with the special
 * exception on linking described in file LICENSE.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *)

open Xenops_interface
open Xenops_utils
open Xenops_server_plugin
open Xenops_helpers
open Xenstore
open Xenops_utils
open Xenops_task

module D = Debug.Make(struct let name = service_name end)
open D

let _sys_hypervisor_type = "/sys/hypervisor/type"

let run cmd args =
	debug "%s %s" cmd (String.concat " " args);
	fst(Forkhelpers.execute_command_get_output cmd args)

type qemu_frontend =
	| Name of string (* block device path or bridge name *)
	| Device of Device_common.device
with rpc

type attached_vdi = {
	domid: int;
	attach_info: Storage_interface.attach_info;
}

module VmExtra = struct
	(** Extra data we store per VM. The persistent data is preserved when
		the domain is suspended so it can be re-used in the following 'create'
		which is part of 'resume'. The non-persistent data will be regenerated.
		When a VM is shutdown for other reasons (eg reboot) we throw all this
		information away and generate fresh data on the following 'create' *)
	type persistent_t = {
		build_info: Domain.build_info option;
		ty: Vm.builder_info option;
		last_start_time: float;
	} with rpc

	type non_persistent_t = {
		create_info: Domain.create_info;
		vcpu_max: int;
		vcpus: int;
		shadow_multiplier: float;
		memory_static_max: int64;
		suspend_memory_bytes: int64;
		qemu_vbds: (Vbd.id * (int * qemu_frontend)) list;
		qemu_vifs: (Vif.id * (int * qemu_frontend)) list;
		pci_msitranslate: bool;
		pci_power_mgmt: bool;
	} with rpc

	type t = {
		persistent: persistent_t;
		non_persistent: non_persistent_t;
	} with rpc
end

module DB = struct
	include TypedTable(struct
		include VmExtra
		let namespace = "extra"
		type key = string
		let key vm = [ vm ]
	end)
end

(* Used to signal when work needs to be done on a VM *)
let updates = Updates.empty ()

let event_wait task timeout p =
	let finished = ref false in
	let success = ref false in
	let event_id = ref None in
	while not !finished do
		let deltas, next_id = Updates.get (Printf.sprintf "event_wait task %s" task.Xenops_task.id) !event_id timeout updates in
		if deltas = [] then finished := true;
		List.iter (fun d -> if p d then (success := true; finished := true)) deltas;
		event_id := Some next_id;
	done;
	!success

let safe_rm xs path =
	debug "xenstore-rm %s" path;
	try
		xs.Xs.rm path
	with _ -> ()

let this_domid ~xs = int_of_string (xs.Xs.read "domid")

let uuid_of_string x = match Uuidm.of_string x with
	| Some x -> x
	| None ->
		let msg = Printf.sprintf "string '%s' is not a valid UUID" x in
		error "%s" msg;
		failwith msg

let uuid_of_vm vm = uuid_of_string vm.Vm.id

let uuid_of_di di = Xenctrl_uuid.uuid_of_handle di.Xenctrl.handle

(* During a live migrate, there will be multiple domains with the same uuid.
   The convention is: we construct things on the newest domain (e.g. VBD.plug)
   and we destroy things on the oldest domain (e.g. VBD.unplug). In the normal
   case there is only one domain, so oldest = newest *)

type domain_selection =
	| Oldest (* operate on the oldest domain *)
	| Newest (* operate on the newest domain *)<commit_msg>If we're in dom0 then 'xenstore-read domid' will probably fail, since no-one will have created the key for us.<commit_after>(*
 * Copyright (C) Citrix Systems Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published
 * by the Free Software Foundation; version 2.1 only. with the special
 * exception on linking described in file LICENSE.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *)

open Xenops_interface
open Xenops_utils
open Xenops_server_plugin
open Xenops_helpers
open Xenstore
open Xenops_utils
open Xenops_task

module D = Debug.Make(struct let name = service_name end)
open D

let _sys_hypervisor_type = "/sys/hypervisor/type"

let run cmd args =
	debug "%s %s" cmd (String.concat " " args);
	fst(Forkhelpers.execute_command_get_output cmd args)

type qemu_frontend =
	| Name of string (* block device path or bridge name *)
	| Device of Device_common.device
with rpc

type attached_vdi = {
	domid: int;
	attach_info: Storage_interface.attach_info;
}

module VmExtra = struct
	(** Extra data we store per VM. The persistent data is preserved when
		the domain is suspended so it can be re-used in the following 'create'
		which is part of 'resume'. The non-persistent data will be regenerated.
		When a VM is shutdown for other reasons (eg reboot) we throw all this
		information away and generate fresh data on the following 'create' *)
	type persistent_t = {
		build_info: Domain.build_info option;
		ty: Vm.builder_info option;
		last_start_time: float;
	} with rpc

	type non_persistent_t = {
		create_info: Domain.create_info;
		vcpu_max: int;
		vcpus: int;
		shadow_multiplier: float;
		memory_static_max: int64;
		suspend_memory_bytes: int64;
		qemu_vbds: (Vbd.id * (int * qemu_frontend)) list;
		qemu_vifs: (Vif.id * (int * qemu_frontend)) list;
		pci_msitranslate: bool;
		pci_power_mgmt: bool;
	} with rpc

	type t = {
		persistent: persistent_t;
		non_persistent: non_persistent_t;
	} with rpc
end

module DB = struct
	include TypedTable(struct
		include VmExtra
		let namespace = "extra"
		type key = string
		let key vm = [ vm ]
	end)
end

(* Used to signal when work needs to be done on a VM *)
let updates = Updates.empty ()

let event_wait task timeout p =
	let finished = ref false in
	let success = ref false in
	let event_id = ref None in
	while not !finished do
		let deltas, next_id = Updates.get (Printf.sprintf "event_wait task %s" task.Xenops_task.id) !event_id timeout updates in
		if deltas = [] then finished := true;
		List.iter (fun d -> if p d then (success := true; finished := true)) deltas;
		event_id := Some next_id;
	done;
	!success

let safe_rm xs path =
	debug "xenstore-rm %s" path;
	try
		xs.Xs.rm path
	with _ -> ()

let this_domid ~xs =
	(* If we're in dom0 then no-one will have created the "domid" key. *)
	try
		int_of_string (xs.Xs.read "domid")
	with _ -> 0

let uuid_of_string x = match Uuidm.of_string x with
	| Some x -> x
	| None ->
		let msg = Printf.sprintf "string '%s' is not a valid UUID" x in
		error "%s" msg;
		failwith msg

let uuid_of_vm vm = uuid_of_string vm.Vm.id

let uuid_of_di di = Xenctrl_uuid.uuid_of_handle di.Xenctrl.handle

(* During a live migrate, there will be multiple domains with the same uuid.
   The convention is: we construct things on the newest domain (e.g. VBD.plug)
   and we destroy things on the oldest domain (e.g. VBD.unplug). In the normal
   case there is only one domain, so oldest = newest *)

type domain_selection =
	| Oldest (* operate on the oldest domain *)
	| Newest (* operate on the newest domain *)
{'fraction_non_alphanumeric': 0.07828418230563003, 'fraction_numerical': 0.0020107238605898124, 'mean_word_length': 3.8542615484710474, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 12, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5360954', 'n_tokens_mistral': 2522, 'n_tokens_neox': 2439, 'n_words': 977}