Test

.gitignore

@@ -201,6 +201,7 @@ ocaml/idl/ocaml_backend/META
 ocaml/xenops/META
 ocaml/xapi/rrddump
 ocaml/xapi/sparse_dd
+ocaml/license/daily-license-check
 ocaml/license/v6d
 ocaml/license/v6d-reopen-logs
 ocaml/license/v6testd

.travis.yml

@@ -1,8 +1,21 @@
 language: c
-install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
-script: bash -ex .travis-opam.sh
+services: docker
+install:
+        - wget https://raw.githubusercontent.com/xenserver/xenserver-build-env/master/utils/travis-build-repo.sh
+script: bash travis-build-repo.sh
+after_success:
+    - test $TRAVIS_PULL_REQUEST == "false" && test $TRAVIS_BRANCH == "master" && bash deploy.sh
 sudo: true
 env:
-        - OCAML_VERSION=4.02 PACKAGE=xapi FORK_USER=xapi-project EXTRA_REMOTES=git://github.com/xapi-project/opam-repo-dev
+    global:
+        - CONTAINER_NAME=build-env
+        - REPO_PACKAGE_NAME=xapi
+        - REPO_CONFIGURE_CMD=./configure
+        - REPO_BUILD_CMD=make
+        - REPO_TEST_CMD='make test'
+        - REPO_DOC_CMD='make doc-json'
+        - secure: tokxJl2litqu/T6UUwzkLRZzlbxnbYqVG2QRKKQz3tkIXyZHQWTS2NAyH7mwDgdBq2dDVSxAUxS1jWq/vGraX7MmbVz37Pz8wjykoIfIRtQuEx+REDAvAzWSw+1LTpUf7ZcI+F2SpgJrnH87uN5AAc220UqIx8TvAtGrita+2+o=
+    matrix:
+        - OCAML_VERSION=4.02
 notifications:
     slack: citrix:BHYQZbI8m036ELU21gZil75Y

Makefile

@@ -38,7 +38,7 @@ all: version
 	omake -j 8 phase3
 
 .PHONY: phase1 phase2 phase3
-phase1:
+phase1: version
 	omake phase1
 phase2:
 	omake phase2
@@ -97,10 +97,20 @@ clean:
 otags:
 	otags -vi -r . -o tags
 
+.PHONY: doc-html
+doc-html: phase1
+	omake doc-html
+
+.PHONY: doc-pdf
+doc-pdf: phase1
+	omake doc-pdf
+
+.PHONY: doc-json
+doc-json: phase1
+	omake doc-json
+
 .PHONY: doc
-doc:
-	omake phase1 phase2 # autogenerated files might be required
-	omake doc
+doc: doc-html doc-pdf doc-json
 
 PLATFORM_VERSION ?= 0.0.0
 

OMakefile

@@ -34,7 +34,7 @@ if $(equal $(DISABLE_WARN_ERROR), true)
 else
   WARN = -warn-error
 
-OCAMLFLAGS = -g -dtypes -bin-annot -thread $(WARN) +a-4-6-9-27-28-29
+OCAMLFLAGS = -g -dtypes -bin-annot -thread $(WARN) +a-3-4-6-9-27-28-29
 
 # c compiling stuff
 OCAMLCFLAGS += -g
@@ -164,7 +164,7 @@ OCAML_PHASE3_XEN = \
 	ocaml/xapi/xapi \
 	ocaml/xapi/quicktestbin \
 	ocaml/xapi/storage_impl_test \
-	ocaml/license/v6d
+	ocaml/license/daily-license-check
 
 #ocaml/xapi/monitor_fake_plugin
 

deploy.sh

@@ -0,0 +1,39 @@
+#!/bin/bash
+
+# Make sure we're not echoing any sensitive data
+set +x
+set -o errexit -o nounset
+
+if [ "$TRAVIS_BRANCH" != "master" ]
+then
+  echo "This commit was made against the $TRAVIS_BRANCH and not the master! No deploy!"
+  exit 0
+fi
+
+# Error out if $GH_TOKEN is empty or unset
+: ${GH_TOKEN:?"GH_TOKEN needs to be uploaded via travis-encrypt"}
+
+# Print a hash of the token for debugging
+echo Token MD5: $(echo $GH_TOKEN | md5sum)
+
+rev=$(git rev-parse --short HEAD)
+
+# Copy data we're interested in out of the container
+docker cp ${CONTAINER_NAME}:/home/builder/xen-api/ocaml/idl/json_backend/xenapi.json $HOME/
+docker cp ${CONTAINER_NAME}:/home/builder/xen-api/ocaml/idl/json_backend/release_info.json $HOME/
+
+# Go to home and setup git
+cd $HOME
+git config --global user.email "travis@travis-ci.org"
+git config --global user.name "Travis"
+
+# Using token clone xapi-project.github.io.git
+git clone "https://$GH_TOKEN@github.com/xapi-project/xapi-project.github.io.git" 2>&1 | sed -e "s/$GH_TOKEN/!REDACTED!/g"
+
+# Copy data we're interested in into the right place
+cd xapi-project.github.io
+cp -f $HOME/xenapi.json _data/
+cp -f $HOME/release_info.json _data/
+
+git commit -am "Updated XenAPI docs based on xen-api/${rev}"
+git push origin master 2>&1 | sed -e "s/$GH_TOKEN/!REDACTED!/g"

mk/Makefile

@@ -39,8 +39,6 @@ export PRODUCT_VERSION_TEXT_SHORT
 build: $(OUTPUT_CLI_RT) $(OUTPUT_SDK) $(MY_SOURCES)/MANIFEST
 	$(call mkdir_clean,$(MY_MAIN_CDFILES)/client_install)
 	install -m 755 $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-xe-*.rpm $(MY_MAIN_CDFILES)/client_install/xe-cli-$(PRODUCT_VERSION)-$(BUILD_NUMBER).$(DOMAIN0_ARCH_OPTIMIZED).rpm
-	# Copy in the 32-bit CLI from clearwater RTM build
-	install -m 755 $(CARBON_DISTFILES)/xe-cli-32bit/xe-cli-6.2.0-70442c.i686.rpm $(MY_MAIN_CDFILES)/client_install/xe-cli-6.2.0-70442c.i686.rpm
 	# Delete this as soon as xenrt has been updated to fetch the file from
 	# the new place:
 	$(call mkdir_clean,$(MY_LINUX_CDFILES)/client_install)
@@ -88,8 +86,6 @@ $(OUTPUT_CLI_RT) $(OUTPUT_SDK): $(MY_MAIN_PACKAGES)/.dirstamp $(RPM_DIRECTORIES)
 	cp $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-tests-*.rpm $(MY_MAIN_PACKAGES)
 	cp $(RPM_RPMSDIR)/*/xapi-www-*.rpm $(MY_MAIN_PACKAGES)
 	cp $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-xe-*.rpm $(MY_MAIN_PACKAGES)
-	mkdir -p $(MY_XCP_PACKAGES)
-	cp $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-v6d-*.rpm $(MY_XCP_PACKAGES)
 
 .PHONY: clean
 clean:

ocaml/auth/extauth_plugin_ADpbis.ml

@@ -28,7 +28,7 @@ struct
  *
 *)
 
-let user_friendly_error_msg = "The Active Directory Plug-in could not complete the command. Additional information in the XenServer log."
+let user_friendly_error_msg = "The Active Directory Plug-in could not complete the command. Additional information in the logs."
 
 open Pervasiveext
 open Xstringext

ocaml/client_records/record_util.ml

@@ -106,6 +106,7 @@ let vdi_operation_to_string = function
   | `destroy -> "destroy"
   | `force_unlock -> "force_unlock"
   | `snapshot -> "snapshot"
+  | `mirror -> "mirror"
   | `forget -> "forget"
   | `update -> "update"
   | `generate_config -> "generate_config"
@@ -124,6 +125,7 @@ let sr_operation_to_string = function
   | `vdi_resize -> "VDI.resize"
   | `vdi_clone -> "VDI.clone"
   | `vdi_snapshot -> "VDI.snapshot"
+  | `vdi_mirror -> "VDI.mirror"
   | `pbd_create -> "PBD.create"
   | `pbd_destroy -> "PBD.destroy"
 
@@ -387,6 +389,16 @@ let ip_configuration_mode_of_string m =
   | "static" -> `Static
   | s        -> raise (Record_failure ("Expected 'dhcp','none' or 'static', got "^s))
 
+let vif_ipv4_configuration_mode_to_string = function
+  | `None -> "None"
+  | `Static -> "Static"
+
+let vif_ipv4_configuration_mode_of_string m =
+  match String.lowercase m with
+  | "none"   -> `None
+  | "static" -> `Static
+  | s        -> raise (Record_failure ("Expected 'none' or 'static', got "^s))
+
 let ipv6_configuration_mode_to_string = function
   | `None -> "None"
   | `DHCP -> "DHCP"
@@ -401,6 +413,16 @@ let ipv6_configuration_mode_of_string m =
   | "autoconf" -> `Autoconf
   | s        -> raise (Record_failure ("Expected 'dhcp','none' 'autoconf' or 'static', got "^s))
 
+let vif_ipv6_configuration_mode_to_string = function
+  | `None -> "None"
+  | `Static -> "Static"
+
+let vif_ipv6_configuration_mode_of_string m =
+  match String.lowercase m with
+  | "none"   -> `None
+  | "static" -> `Static
+  | s        -> raise (Record_failure ("Expected 'none' or 'static', got "^s))
+
 let primary_address_type_to_string = function
   | `IPv4 -> "IPv4"
   | `IPv6 -> "IPv6"
@@ -460,6 +482,12 @@ let on_boot_to_string onboot =
 		| `reset -> "reset"
 		| `persist -> "persist"
 
+let tristate_to_string tristate =
+	match tristate with
+		| `yes -> "true"
+		| `no -> "false"
+		| `unspecified -> "unspecified"
+
 let wrap f err x = try f x with _ -> err x
 let generic_error x = raise (Record_failure ("Unknown value: "^x))
 let rpc_to_string = function | Rpc.String s -> s | _ -> failwith "Bad RPC type in record_util"

ocaml/client_records/records.ml

@@ -402,6 +402,12 @@ let vif_record rpc session_id vif =
 		~add_to_set:(fun value -> Client.VIF.add_ipv6_allowed rpc session_id vif value)
 		~remove_from_set:(fun value -> Client.VIF.remove_ipv6_allowed rpc session_id vif value)
 		~set:(fun value -> Client.VIF.set_ipv6_allowed rpc session_id vif (String.split ',' value)) ();
+	make_field ~name:"ipv4-configuration-mode" ~get:(fun () -> Record_util.vif_ipv4_configuration_mode_to_string (x ()).API.vIF_ipv4_configuration_mode) ();
+	make_field ~name:"ipv4-addresses" ~get:(fun () -> String.concat "; " (x ()).API.vIF_ipv4_addresses) ();
+	make_field ~name:"ipv4-gateway" ~get:(fun () -> (x ()).API.vIF_ipv4_gateway) ();
+	make_field ~name:"ipv6-configuration-mode" ~get:(fun () -> Record_util.vif_ipv6_configuration_mode_to_string (x ()).API.vIF_ipv6_configuration_mode) ();
+	make_field ~name:"ipv6-addresses" ~get:(fun () -> String.concat "; " (x ()).API.vIF_ipv6_addresses) ();
+	make_field ~name:"ipv6-gateway" ~get:(fun () -> (x ()).API.vIF_ipv6_gateway) ();
       ]}
 
 
@@ -527,6 +533,8 @@ let pool_record rpc session_id pool =
 					Client.Pool.remove_from_guest_agent_config rpc session_id pool k)
 				~get_map:(fun () -> (x ()).API.pool_guest_agent_config)
 				();
+			make_field ~name:"cpu_info" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.pool_cpu_info) ~get_map:(fun () -> (x ()).API.pool_cpu_info) ();
+			make_field ~name:"policy-no-vendor-device" ~get:(fun () -> string_of_bool (x ()).API.pool_policy_no_vendor_device) ~set:(fun s -> Client.Pool.set_policy_no_vendor_device rpc session_id pool (safe_bool_of_string "policy-no-vendor-device" s)) ();
 		]}
 
 let subject_record rpc session_id subject = 
@@ -870,17 +878,19 @@ let vm_record rpc session_id vm =
 			make_field ~name:"networks"
 				~get:(fun () -> default nid (may (fun m -> Record_util.s2sm_to_string "; " m.API.vM_guest_metrics_networks) (xgm ()) ))
 				~get_map:(fun () -> default [] (may (fun m -> m.API.vM_guest_metrics_networks) (xgm ()))) ();
-			make_field ~name:"network-paths-optimized"
-				~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_network_paths_optimized) (xgm ()) )) ();
-			make_field ~name:"storage-paths-optimized"
-				~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_storage_paths_optimized) (xgm ()) )) ();
+			make_field ~name:"PV-drivers-detected"
+				~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_PV_drivers_detected) (xgm ()) )) ();
 			make_field ~name:"other"
 				~get:(fun () -> default nid (may (fun m -> Record_util.s2sm_to_string "; " m.API.vM_guest_metrics_other) (xgm ()) ))
 				~get_map:(fun () -> default [] (may (fun m -> m.API.vM_guest_metrics_other) (xgm()))) ();
 			make_field ~name:"live"
 				~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_live) (xgm ()) )) ();
 			make_field ~name:"guest-metrics-last-updated"
 				~get:(fun () -> default nid (may (fun m -> Date.to_string m.API.vM_guest_metrics_last_updated) (xgm ()) )) ();
+			make_field ~name:"can-use-hotplug-vbd"
+				~get:(fun () -> default nid (may (fun m -> Record_util.tristate_to_string m.API.vM_guest_metrics_can_use_hotplug_vbd) (xgm ()) )) ();
+			make_field ~name:"can-use-hotplug-vif"
+				~get:(fun () -> default nid (may (fun m -> Record_util.tristate_to_string m.API.vM_guest_metrics_can_use_hotplug_vif) (xgm ()) )) ();
 			make_field ~name:"cooperative"
 				(* NB this can receive VM_IS_SNAPSHOT *)
 				~get:(fun () -> string_of_bool (try Client.VM.get_cooperative rpc session_id vm with _ -> true))
@@ -908,9 +918,9 @@ let vm_record rpc session_id vm =
 				~get:(fun () -> (x ()).API.vM_generation_id) ();
 			make_field ~name:"hardware-platform-version"
 				~get:(fun () -> Int64.to_string (x ()).API.vM_hardware_platform_version) ();
-			make_field ~name:"auto-update-drivers"
-				~get:(fun () -> string_of_bool (x ()).API.vM_auto_update_drivers)
-				~set:(fun x -> Client.VM.set_auto_update_drivers rpc session_id vm (safe_bool_of_string "auto-update-drivers" x)) ();
+			make_field ~name:"has-vendor-device"
+				~get:(fun () -> string_of_bool (x ()).API.vM_has_vendor_device)
+				~set:(fun x -> Client.VM.set_has_vendor_device rpc session_id vm (safe_bool_of_string "has-vendor-device" x)) ();
 		]}
 
 let host_crashdump_record rpc session_id host = 
@@ -1086,6 +1096,7 @@ let host_record rpc session_id host =
 			make_field ~name:"virtual-hardware-platform-versions" 
 				~get:(fun () -> String.concat "; " (List.map Int64.to_string (x ()).API.host_virtual_hardware_platform_versions)) 
 				~get_set:(fun () -> List.map Int64.to_string (x ()).API.host_virtual_hardware_platform_versions) ();
+			make_field ~name:"control-domain-uuid" ~get:(fun () -> get_uuid_from_ref (x ()).API.host_control_domain) ();
 		]}
 
 let vdi_record rpc session_id vdi =
@@ -1133,6 +1144,7 @@ let vdi_record rpc session_id vdi =
 			make_field ~name:"managed" ~get:(fun () -> string_of_bool (x ()).API.vDI_managed) ();
 			make_field ~name:"parent" ~get:(fun () -> get_uuid_from_ref (x ()).API.vDI_parent) ();
 			make_field ~name:"missing" ~get:(fun () -> string_of_bool (x ()).API.vDI_missing) ();
+			make_field ~name:"is-tools-iso" ~get:(fun () -> string_of_bool (x ()).API.vDI_is_tools_iso) ();
 			make_field ~name:"other-config" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vDI_other_config)
 				~add_to_map:(fun k v -> Client.VDI.add_to_other_config rpc session_id vdi k v)
 				~remove_from_map:(fun k -> Client.VDI.remove_from_other_config rpc session_id vdi k)
@@ -1319,6 +1331,7 @@ let sr_record rpc session_id sr =
 				~set:(fun x -> Client.SR.set_shared rpc session_id sr (safe_bool_of_string "shared" x)) ();
 			make_field ~name:"introduced-by"
 				~get:(fun () -> (get_uuid_from_ref (x ()).API.sR_introduced_by)) ();
+			make_field ~name:"is-tools-sr" ~get:(fun () -> string_of_bool (x ()).API.sR_is_tools_sr) ();
 			make_field ~name:"other-config" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.sR_other_config)
 				~add_to_map:(fun k v -> Client.SR.add_to_other_config rpc session_id sr k v)
 				~remove_from_map:(fun k -> Client.SR.remove_from_other_config rpc session_id sr k)

ocaml/database/db_backend.ml

@@ -29,6 +29,8 @@ let display_sql_writelog_val = ref true (* compute/write sql-writelog debug stri
 
 let master_database = ref (Db_cache_types.Database.make Schema.empty)
 
+let __test_set_master_database db = master_database := db
+
 let make () = Db_ref.in_memory (ref master_database)
 
 (* !!! Right now this is called at cache population time. It would probably be preferable to call it on flush time instead, so we
@@ -69,9 +71,12 @@ let blow_away_non_persistent_fields (schema: Schema.t) db =
 let db_registration_mutex = Mutex.create ()
 let foreign_databases: ((API.ref_session, Db_ref.t) Hashtbl.t) = Hashtbl.create 5
 
-let register_session_with_database session db_ref =
+let create_registered_session create_session db_ref =
 	Mutex.execute db_registration_mutex
-		(fun () -> Hashtbl.replace foreign_databases session db_ref)
+		(fun () ->
+			let session = create_session () in
+			Hashtbl.replace foreign_databases session db_ref;
+			session)
 
 let unregister_session session =
 	Mutex.execute db_registration_mutex

ocaml/database/db_backend.mli

@@ -0,0 +1,32 @@
+(*
+ * 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.
+ *)
+
+val db_FLUSH_TIMER : float
+
+(** A setter for the master database. Only used by the unit testing code. *)
+val __test_set_master_database : Db_cache_types.Database.t -> unit
+
+val make : unit -> Db_ref.t
+
+val blow_away_non_persistent_fields :
+	Schema.t -> Db_cache_types.Database.t -> Db_cache_types.Database.t
+
+val create_registered_session :
+	(unit -> API.ref_session) -> Db_ref.t -> API.ref_session
+
+val unregister_session : API.ref_session -> unit
+
+val is_session_registered : API.ref_session -> bool
+
+val get_registered_database : API.ref_session -> Db_ref.t option