PR-1223 main merge

ocaml/client_records/records.ml

@@ -757,6 +757,9 @@ let vm_record rpc session_id vm =
 				~set:(fun x -> Client.VM.set_memory_static_min rpc session_id vm (Record_util.bytes_of_string "memory-static-min" x)) ();
 			make_field ~name:"suspend-VDI-uuid"
 				~get:(fun () -> get_uuid_from_ref (x ()).API.vM_suspend_VDI) ();
+			make_field ~name:"suspend-SR-uuid"
+				~get:(fun () -> get_uuid_from_ref (x ()).API.vM_suspend_SR) ()
+				~set:(fun x -> Client.VM.set_suspend_SR rpc session_id vm (Client.SR.get_by_uuid rpc session_id x));
 			make_field ~name:"VCPUs-params"
 				~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vM_VCPUs_params)
 				~add_to_map:(fun k v -> match k with
@@ -859,7 +862,7 @@ let vm_record rpc session_id vm =
 				~add_to_map:(fun k v -> Client.VM.add_to_xenstore_data rpc session_id vm k v)
 				~remove_from_map:(fun k -> Client.VM.remove_from_xenstore_data rpc session_id vm k) 
 				~get_map:(fun () -> (x ()).API.vM_xenstore_data) ();
-			make_field ~name:"ha-always-run"
+			make_field ~name:"ha-always-run" ~deprecated:true
 				~get:(fun () -> string_of_bool ((x ()).API.vM_ha_always_run))
 				~set:(fun x -> Client.VM.set_ha_always_run rpc session_id vm (bool_of_string x)) ();
 			make_field ~name:"ha-restart-priority"
@@ -925,6 +928,8 @@ let vm_record rpc session_id vm =
 			make_field ~name:"order"
 				~get:(fun () -> Int64.to_string (x ()).API.vM_shutdown_delay)
 				~set:(fun x -> Client.VM.set_order rpc session_id vm (safe_i64_of_string "order" x)) ();
+			make_field ~name:"version"
+				~get:(fun () -> Int64.to_string (x ()).API.vM_version) ();
 		]}
 
 let host_crashdump_record rpc session_id host = 
@@ -1412,9 +1417,9 @@ let vm_appliance_record rpc session_id vm_appliance =
 		fields =
 			[
 				make_field ~name:"uuid" ~get:(fun () -> (x ()).API.vM_appliance_uuid) ();
-				make_field ~name:"name_label" ~get:(fun () -> (x ()).API.vM_appliance_name_label)
+				make_field ~name:"name-label" ~get:(fun () -> (x ()).API.vM_appliance_name_label)
 					~set:(fun x -> Client.VM_appliance.set_name_label rpc session_id !_ref x) ();
-				make_field ~name:"name_description" ~get:(fun () -> (x ()).API.vM_appliance_name_description)
+				make_field ~name:"name-description" ~get:(fun () -> (x ()).API.vM_appliance_name_description)
 					~set:(fun x -> Client.VM_appliance.set_name_description rpc session_id !_ref x) ();
 				make_field ~name:"VMs" ~get:(fun () -> String.concat "; " (List.map get_uuid_from_ref (x ()).API.vM_appliance_VMs))
 					~get_set:(fun () -> List.map get_uuid_from_ref (x ()).API.vM_appliance_VMs) ();
@@ -1427,6 +1432,24 @@ let vm_appliance_record rpc session_id vm_appliance =
 			]
 	}
 
+let dr_task_record rpc session_id dr_task =
+	let _ref = ref dr_task in
+	let empty_record = ToGet (fun () ->
+		Client.DR_task.get_record ~rpc ~session_id ~self:!_ref) in
+	let record = ref empty_record in
+	let x () = lzy_get record in
+	{
+		setref = (fun r -> _ref := r; record := empty_record);
+		setrefrec = (fun (a, b) -> _ref := a; record := Got b);
+		record = x;
+		getref = (fun () -> !_ref);
+		fields =
+			[
+				make_field ~name:"uuid" ~get:(fun () -> (x ()).API.dR_task_uuid) ();
+				make_field ~name:"introduced-SRs" ~get:(fun () -> String.concat "; " (List.map get_uuid_from_ref (x ()).API.dR_task_introduced_SRs)) ();
+			]
+	}
+
 
 (*let record_from_ref rpc session_id ref =
   let all = [

ocaml/database/db_backend.ml

@@ -15,6 +15,7 @@ open Db_exn
 open Db_lock
 open Db_cache_types
 open Pervasiveext
+open Threadext
 
 module D = Debug.Debugger(struct let name = "sql" end)
 open D
@@ -30,7 +31,6 @@ let master_database = ref (Db_cache_types.Database.make Schema.empty)
 
 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
    don't waste writes storing non-persistent field values on disk.. At the moment there's not much to worry about, since there are
    few non-persistent fields. However, if this number increases we may want to consider calling this fn on every flush instead.. *)
@@ -63,4 +63,17 @@ let blow_away_non_persistent_fields (schema: Schema.t) db =
 					let tbl' = table tblname tbl in
 					TableSet.add tblname tbl' acc) ts TableSet.empty)
 		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 =
+	Mutex.execute db_registration_mutex (fun () ->
+		Hashtbl.replace foreign_databases session db_ref)
+
+let unregister_session session =
+	Mutex.execute db_registration_mutex (fun () ->
+		Hashtbl.remove foreign_databases session)
+
+let is_session_registered session =
+	Hashtbl.mem foreign_databases session

ocaml/database/db_cache.ml

@@ -34,17 +34,16 @@ let get = function
 	| Db_ref.In_memory _ -> (module Local_db  : DB_ACCESS)
 	| Db_ref.Remote      -> (module Remote_db : DB_ACCESS)
 
-let apply_delta_to_cache entry =
+let apply_delta_to_cache entry db_ref =
 	let module DB = (Local_db : DB_ACCESS) in
-	let t = Db_backend.make () in
     let context = Context.make "redo_log" in
     match entry with 
 		| Redo_log.CreateRow(tblname, objref, kvs) ->
 			debug "Redoing create_row %s (%s)" tblname objref;
-			DB.create_row t tblname kvs objref
+			DB.create_row db_ref tblname kvs objref
 		| Redo_log.DeleteRow(tblname, objref) ->
 			debug "Redoing delete_row %s (%s)" tblname objref;
-			DB.delete_row t tblname objref
+			DB.delete_row db_ref tblname objref
 		| Redo_log.WriteField(tblname, objref, fldname, newval) ->
 			debug "Redoing write_field %s (%s) [%s -> %s]" tblname objref fldname newval;
-			DB.write_field t tblname objref fldname newval
+			DB.write_field db_ref tblname objref fldname newval

ocaml/database/db_connections.ml

@@ -59,11 +59,9 @@ let dec_and_read_db_flush_thread_refcount() =
     )
 
 let pre_exit_hook () =
-  if Redo_log.is_enabled() then begin
-    (* We're about to exit. Close the redo log. *)
-    Redo_log.shutdown();
-    R.debug "Closed redo log"
-  end
+  (* We're about to exit. Close the active redo logs. *)
+  Redo_log.with_active_redo_logs (Redo_log.shutdown);
+  R.debug "Closed all active redo logs."
 
 (* The connection flushing calls each lock the connection they're flushing to.
    The backend flush calls have to do enough locking (i.e. with the db_lock) to ensure that they