<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 OUnit
open Test_common
open Test_highlevel
open Xenops_interface

let test_vm_name = "__test_vm"

type vm_config = {
	oc: (string * string) list;
	platform: (string * string) list;
}

let string_of_vm_config conf =
	Printf.sprintf "other_config = %s, platform = %s"
		(string_of_string_map conf.oc)
		(string_of_string_map conf.platform)

let load_vm_config __context conf =
	let (_: API.ref_VM) = make_vm ~__context
		~name_label:test_vm_name
		~hVM_boot_policy:"BIOS order"
		~other_config:conf.oc
		~platform:conf.platform
		()
	in ()

let run_builder_of_vm __context =
	let vms = Db.VM.get_by_name_label ~__context ~label:test_vm_name in
	let vm = List.nth vms 0 in
	let vm_record = Db.VM.get_record ~__context ~self:vm in
	Xapi_xenops.builder_of_vm ~__context ~vm:vm_record "0" false

(* Test the behaviour of the "hvm_serial" other_config/platform key. *)
module HVMSerial = Generic.Make(Generic.EncapsulateState(struct
	module Io = struct
		type input_t = vm_config
		type output_t = string option

		let string_of_input_t = string_of_vm_config
		let string_of_output_t = function
			| Some s -> Printf.sprintf "Some %s" s
			| None -> "None"
	end

	module State = XapiDb

	let load_input = load_vm_config

	let extract_output __context _ =
		match run_builder_of_vm __context with
		| Vm.HVM {Vm.serial = serial} -> serial
		| _ -> failwith "expected HVM metadata"

	let tests =
		[
			(* Should default to "pty" if nothing is set. *)
			(
				{oc=[]; platform=[]},
				Some "pty"
			);
			(* other_config value should override default if no platform value. *)
			(
				{oc=["hvm_serial", "none"]; platform=[]},
				Some "none"
			);
			(* Should be able to disable serial emulation via the platform key. *)
			(
				{oc=[]; platform=["hvm_serial", "none"]},
				Some "none"
			);
			(* platform value should override other_config value. *)
			(
				{oc=["hvm_serial", "none"]; platform=["hvm_serial", "pty"]},
				Some "pty"
			);
			(* platform value should override other_config value. *)
			(
				{oc=["hvm_serial", "pty"]; platform=["hvm_serial", "none"]},
				Some "none"
			);
			(* Windows debugger redirects the serial port to tcp - this should be
			 * configurable via the other_config key. *)
			(
				{oc=["hvm_serial", "tcp:1.2.3.4:7001"]; platform=[]},
				Some "tcp:1.2.3.4:7001"
			);
			(* Windows debugger should be configurable via the platform key too. *)
			(
				{oc=[]; platform=["hvm_serial", "tcp:1.2.3.4:7001"]},
				Some "tcp:1.2.3.4:7001"
			);
			(* Windows debugger setting via the platform key should override anything
			 * set in other_config. *)
			(
				{oc=["hvm_serial", "none"]; platform=["hvm_serial", "tcp:1.2.3.4:7001"]},
				Some "tcp:1.2.3.4:7001"
			);
		]
end))

let vgpu_platform_data = [
	"vgpu_pci_id", "0000:0a:00.0";
	"vgpu_config", "/usr/share/nvidia/vgx/grid_k100.conf";
]

module VideoMode = Generic.Make(Generic.EncapsulateState(struct
	module Io = struct
		type input_t = vm_config
		type output_t = Vm.video_card

		let string_of_input_t = string_of_vm_config
		let string_of_output_t = function
			| Vm.Cirrus -> "Cirrus"
			| Vm.Standard_VGA -> "Standard_VGA"
			| Vm.Vgpu -> "Vgpu"
	end

	module State = XapiDb

	let load_input = load_vm_config

	let extract_output __context _ =
		match run_builder_of_vm __context with
		| Vm.HVM {Vm.video = video_mode} -> video_mode
		| _ -> failwith "expected HVM metadata"

	let tests = [
		(* Default video mode should be Cirrus. *)
		{oc=[]; platform=[]}, Vm.Cirrus;
		(* Unrecognised video mode should default to Cirrus. *)
		{oc=[]; platform=["vga", "foo"]}, Vm.Cirrus;
		(* Video modes set in the platform map should be respected. *)
		{oc=[]; platform=["vga", "cirrus"]}, Vm.Cirrus;
		{oc=[]; platform=["vga", "std"]}, Vm.Standard_VGA;
		(* We should be able to enable vGPU mode. *)
		{oc=[]; platform=vgpu_platform_data}, Vm.Vgpu;
		(* vGPU mode should override whatever's set for the "vga" key. *)
		{oc=[]; platform=["vga", "cirrus"] @ vgpu_platform_data}, Vm.Vgpu;
		{oc=[]; platform=["vga", "std"] @ vgpu_platform_data}, Vm.Vgpu;
	]
end))

module VideoRam = Generic.Make(Generic.EncapsulateState(struct
	module Io = struct
		type input_t = vm_config
		type output_t = int<commit_msg>CP-6853: Add some extra video mode override tests<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 OUnit
open Test_common
open Test_highlevel
open Xenops_interface

let test_vm_name = "__test_vm"

type vm_config = {
	oc: (string * string) list;
	platform: (string * string) list;
}

let string_of_vm_config conf =
	Printf.sprintf "other_config = %s, platform = %s"
		(string_of_string_map conf.oc)
		(string_of_string_map conf.platform)

let load_vm_config __context conf =
	let (_: API.ref_VM) = make_vm ~__context
		~name_label:test_vm_name
		~hVM_boot_policy:"BIOS order"
		~other_config:conf.oc
		~platform:conf.platform
		()
	in ()

let run_builder_of_vm __context =
	let vms = Db.VM.get_by_name_label ~__context ~label:test_vm_name in
	let vm = List.nth vms 0 in
	let vm_record = Db.VM.get_record ~__context ~self:vm in
	Xapi_xenops.builder_of_vm ~__context ~vm:vm_record "0" false

(* Test the behaviour of the "hvm_serial" other_config/platform key. *)
module HVMSerial = Generic.Make(Generic.EncapsulateState(struct
	module Io = struct
		type input_t = vm_config
		type output_t = string option

		let string_of_input_t = string_of_vm_config
		let string_of_output_t = function
			| Some s -> Printf.sprintf "Some %s" s
			| None -> "None"
	end

	module State = XapiDb

	let load_input = load_vm_config

	let extract_output __context _ =
		match run_builder_of_vm __context with
		| Vm.HVM {Vm.serial = serial} -> serial
		| _ -> failwith "expected HVM metadata"

	let tests =
		[
			(* Should default to "pty" if nothing is set. *)
			(
				{oc=[]; platform=[]},
				Some "pty"
			);
			(* other_config value should override default if no platform value. *)
			(
				{oc=["hvm_serial", "none"]; platform=[]},
				Some "none"
			);
			(* Should be able to disable serial emulation via the platform key. *)
			(
				{oc=[]; platform=["hvm_serial", "none"]},
				Some "none"
			);
			(* platform value should override other_config value. *)
			(
				{oc=["hvm_serial", "none"]; platform=["hvm_serial", "pty"]},
				Some "pty"
			);
			(* platform value should override other_config value. *)
			(
				{oc=["hvm_serial", "pty"]; platform=["hvm_serial", "none"]},
				Some "none"
			);
			(* Windows debugger redirects the serial port to tcp - this should be
			 * configurable via the other_config key. *)
			(
				{oc=["hvm_serial", "tcp:1.2.3.4:7001"]; platform=[]},
				Some "tcp:1.2.3.4:7001"
			);
			(* Windows debugger should be configurable via the platform key too. *)
			(
				{oc=[]; platform=["hvm_serial", "tcp:1.2.3.4:7001"]},
				Some "tcp:1.2.3.4:7001"
			);
			(* Windows debugger setting via the platform key should override anything
			 * set in other_config. *)
			(
				{oc=["hvm_serial", "none"]; platform=["hvm_serial", "tcp:1.2.3.4:7001"]},
				Some "tcp:1.2.3.4:7001"
			);
		]
end))

let vgpu_pci_id = "vgpu_pci_id", "0000:0a:00.0"
let vgpu_config = "vgpu_config", "/usr/share/nvidia/vgx/grid_k100.conf"

let vgpu_platform_data = [vgpu_pci_id; vgpu_config]

module VideoMode = Generic.Make(Generic.EncapsulateState(struct
	module Io = struct
		type input_t = vm_config
		type output_t = Vm.video_card

		let string_of_input_t = string_of_vm_config
		let string_of_output_t = function
			| Vm.Cirrus -> "Cirrus"
			| Vm.Standard_VGA -> "Standard_VGA"
			| Vm.Vgpu -> "Vgpu"
	end

	module State = XapiDb

	let load_input = load_vm_config

	let extract_output __context _ =
		match run_builder_of_vm __context with
		| Vm.HVM {Vm.video = video_mode} -> video_mode
		| _ -> failwith "expected HVM metadata"

	let tests = [
		(* Default video mode should be Cirrus. *)
		{oc=[]; platform=[]}, Vm.Cirrus;
		(* Unrecognised video mode should default to Cirrus. *)
		{oc=[]; platform=["vga", "foo"]}, Vm.Cirrus;
		(* Video modes set in the platform map should be respected. *)
		{oc=[]; platform=["vga", "cirrus"]}, Vm.Cirrus;
		{oc=[]; platform=["vga", "std"]}, Vm.Standard_VGA;
		(* We should be able to enable vGPU mode. *)
		{oc=[]; platform=vgpu_platform_data}, Vm.Vgpu;
		(* vGPU mode should override whatever's set for the "vga" key. *)
		{oc=[]; platform=["vga", "cirrus"] @ vgpu_platform_data}, Vm.Vgpu;
		{oc=[]; platform=["vga", "std"] @ vgpu_platform_data}, Vm.Vgpu;
		(* If somehow only one of the vGPU keys is set, this shouldn't
		 * trigger vGPU mode. This should only ever happen if a user is
		 * experimenting with vgpu_manual_setup. *)
		{oc=[]; platform=[vgpu_pci_id]}, Vm.Cirrus;
		{oc=[]; platform=["vga", "cirrus"; vgpu_pci_id]}, Vm.Cirrus;
		{oc=[]; platform=["vga", "std"; vgpu_pci_id]}, Vm.Standard_VGA;
		{oc=[]; platform=[vgpu_config]}, Vm.Cirrus;
		{oc=[]; platform=["vga", "cirrus"; vgpu_config]}, Vm.Cirrus;
		{oc=[]; platform=["vga", "std"; vgpu_config]}, Vm.Standard_VGA;
	]
end))

module VideoRam = Generic.Make(Generic.EncapsulateState(struct
	module Io = struct
		type input_t = vm_config
		type output_t = int
{'fraction_non_alphanumeric': 0.13233421490841416, 'fraction_numerical': 0.01273386227838182, 'mean_word_length': 3.9015842534805567, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 21, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 12, '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': '7468666', 'n_tokens_mistral': 3985, 'n_tokens_neox': 3612, 'n_words': 1019}