Database: every function which takes Time.t -> Time.t has the third T…

…ime.t

Some of the functions omitted the third Time.t (the deleted time), because
the object could not have been deleted yet. Elsewhere we have the convention
that a live object has deleted = 0L.

This patch makes all the Time.t -> Time.t (-> Time.t) functions consistent.

Signed-off-by: David Scott <dave.scott@eu.citrix.com>

ocaml/database/db_backend.ml

@@ -42,7 +42,7 @@ let blow_away_non_persistent_fields (schema: Schema.t) db =
 	(* Generate a new row given a table schema *)
 	let row schema row : Row.t * int64 =
 		Row.fold 
-			(fun name created updated v (acc,max_upd) ->
+			(fun name created updated _ v (acc,max_upd) ->
 				try
 					let col = Schema.Table.find name schema in
 					let v',updated' = if col.Schema.Column.persistent then v,updated else col.Schema.Column.empty,g in
@@ -54,13 +54,13 @@ let blow_away_non_persistent_fields (schema: Schema.t) db =
 	let table tblname tbl : Table.t =
 		let schema = Schema.Database.find tblname schema.Schema.database in
 		Table.fold
-			(fun objref created updated r acc ->
+			(fun objref created updated _ r acc ->
 				let (r,updated) = row schema r in
 				Table.update updated objref Row.empty (fun _ -> r) (Table.add created objref r acc)) tbl Table.empty in
 	Database.update
 		(fun ts -> 
 			TableSet.fold 
-				(fun tblname created updated tbl acc ->
+				(fun tblname created updated _ tbl acc ->
 					let tbl' = table tblname tbl in
 					TableSet.add updated tblname tbl' acc) ts TableSet.empty)
 		db

ocaml/database/db_cache_impl.ml

@@ -111,7 +111,7 @@ let read_set_ref t rcd =
 		Printf.printf "Illegal read_set_ref query { table = %s; where_field = %s; where_value = %s; return = %s }; falling back to linear scan\n%!" rcd.table rcd.where_field rcd.where_value rcd.return;
 		let tbl = TableSet.find rcd.table (Database.tableset db) in
 		Table.fold
-			(fun rf _ _ row acc ->
+			(fun rf _ _ _ row acc ->
 				if Row.find rcd.where_field row = rcd.where_value 
 				then Row.find rcd.return row :: acc else acc)
 			tbl []
@@ -127,7 +127,7 @@ let read_set_ref t rcd =
 let read_record_internal db tblname objref =
 	let tbl = TableSet.find tblname (Database.tableset db) in
 	let row = Table.find_exn tblname objref tbl in
-	let fvlist = Row.fold (fun k _ _ d env -> (k,d)::env) row [] in
+	let fvlist = Row.fold (fun k _ _ _ d env -> (k,d)::env) row [] in
 	(* Unfortunately the interface distinguishes between Set(Ref _) types and 
 	   ordinary fields *)
 	let schema = Schema.table tblname (Database.schema db) in
@@ -155,7 +155,7 @@ let delete_row_locked t tblname objref =
 	let db = get_database t in
 	Database.notify (PreDelete(tblname, objref)) db;
 	update_database t (remove_row tblname objref);
-	Database.notify (Delete(tblname, objref, Row.fold (fun k _ _ v acc -> (k, v) :: acc) row [])) (get_database t)
+	Database.notify (Delete(tblname, objref, Row.fold (fun k _ _ _ v acc -> (k, v) :: acc) row [])) (get_database t)
 
 let delete_row t tblname objref = 
 	with_lock (fun () -> delete_row_locked t tblname objref)
@@ -176,7 +176,7 @@ let create_row_locked t tblname kvs' new_objref =
 	let row = Row.add_defaults g schema row in
 	W.debug "create_row %s (%s) [%s]" tblname new_objref (String.concat "," (List.map (fun (k,v)->"("^k^","^"v"^")") kvs'));
 	update_database t (add_row tblname new_objref row);
-	Database.notify (Create(tblname, new_objref, Row.fold (fun k _ _ v acc -> (k, v) :: acc) row [])) (get_database t)
+	Database.notify (Create(tblname, new_objref, Row.fold (fun k _ _ _ v acc -> (k, v) :: acc) row [])) (get_database t)
 
 let create_row t tblname kvs' new_objref =
 	with_lock (fun () -> create_row_locked t tblname kvs' new_objref)
@@ -186,7 +186,7 @@ let read_field_where t rcd =
 	let db = get_database t in
 	let tbl = TableSet.find rcd.table (Database.tableset db) in
 	Table.fold
-		(fun r _ _ row acc ->
+		(fun r _ _ _ row acc ->
 			let field = Row.find rcd.where_field row in
 			if field = rcd.where_value then Row.find rcd.return row :: acc else acc
 		) tbl []
@@ -209,7 +209,7 @@ let db_get_by_name_label t tbl label =
 (* Read references from tbl *)
 let read_refs t tblname =
 	let tbl = TableSet.find tblname (Database.tableset (get_database t)) in
-	Table.fold (fun r _ _ _ acc -> r :: acc) tbl []
+	Table.fold (fun r _ _ _ _ acc -> r :: acc) tbl []
 
 (* Return a list of all the refs for which the expression returns true. *)
 let find_refs_with_filter_internal db (tblname: string) (expr: Db_filter_types.expr) =
@@ -218,7 +218,7 @@ let find_refs_with_filter_internal db (tblname: string) (expr: Db_filter_types.e
 		| Db_filter_types.Literal x -> x
 		| Db_filter_types.Field x -> Row.find x row in
 	Table.fold
-		(fun r _ _ row acc ->
+		(fun r _ _ _ row acc ->
 			if Db_filter.eval_expr (eval_val row) expr
 			then Row.find Db_names.ref row :: acc else acc
 		) tbl []
@@ -377,8 +377,8 @@ let make t connections default_schema =
 
 (** Return an association list of table name * record count *)
 let stats t = 
-	TableSet.fold (fun name _ _ tbl acc ->
-		let size = Table.fold (fun _ _ _ _ acc -> acc + 1) tbl 0 in
+	TableSet.fold (fun name _ _ _ tbl acc ->
+		let size = Table.fold (fun _ _ _ _ _ acc -> acc + 1) tbl 0 in
 		(name, size) :: acc)
 		(Database.tableset (get_database t))
 		[]

ocaml/database/db_cache_types.ml

@@ -29,7 +29,7 @@ module type MAP = sig
         type value
 	val add: Time.t -> string -> value -> t -> t
 	val empty : t
-	val fold : (string -> Time.t -> Time.t -> value -> 'b -> 'b) -> t -> 'b -> 'b
+	val fold : (string -> Time.t -> Time.t -> Time.t -> value -> 'b -> 'b) -> t -> 'b -> 'b
 	val find : string -> t -> value
 	val mem : string -> t -> bool
 	val iter : (string -> value -> unit) -> t -> unit
@@ -44,7 +44,7 @@ module Make = functor(V: VAL) -> struct
 		v : V.v }
 	type map_t = x StringMap.t
 	let empty = StringMap.empty
-	let fold f = StringMap.fold (fun key x -> f key x.created x.updated x.v)
+	let fold f = StringMap.fold (fun key x -> f key x.created x.updated 0L x.v)
 	let add generation key value = StringMap.add key {created=generation; updated=generation; v=value}
 	let find key map = (StringMap.find key map).v 
 	let mem = StringMap.mem
@@ -150,7 +150,7 @@ module Table : TABLE = struct
 					acc
 		in fold_over_deleted t.deleted acc
 	let rows t =
-		fold (fun _ _ _ r rs -> r :: rs) t []
+		fold (fun _ _ _ _ r rs -> r :: rs) t []
 end
 
 module StringTableMap = Make(struct type v = Table.t end)
@@ -281,9 +281,9 @@ module Database = struct
 		(* Recompute the keymap *)
 		let keymap =
 			TableSet.fold
-				(fun tblname _ _ tbl acc ->
+				(fun tblname _ _ _ tbl acc ->
 					Table.fold
-						(fun rf _ _ row acc ->
+						(fun rf _ _ _ row acc ->
 							let acc = KeyMap.add_unique tblname Db_names.ref (Ref rf) (tblname, rf) acc in
 							if Row.mem Db_names.uuid row
 							then KeyMap.add_unique tblname Db_names.uuid (Uuid (Row.find Db_names.uuid row)) (tblname, rf) acc
@@ -303,15 +303,15 @@ module Database = struct
 						   VBDs may be missing a VBDs field altogether on
 						   upgrade) *)
 						let many_tbl' = Table.fold
-							(fun vm _ _ row acc ->
+							(fun vm _ _ _ row acc ->
 								let row' = Row.add g many_fldname (SExpr.string_of (SExpr.Node [])) row in
 								Table.add g vm row' acc)
 							many_tbl Table.empty in
 
 						(* Build up a table of VM -> VBDs *)
 
 						let vm_to_vbds = Table.fold
-							(fun vbd _ _ row acc ->
+							(fun vbd _ _ _ row acc ->
 								let vm = Row.find one_fldname row in
 								let existing = if Schema.ForeignMap.mem vm acc then Schema.ForeignMap.find vm acc else [] in
 								Schema.ForeignMap.add vm (vbd :: existing) acc)

ocaml/database/db_cache_types.mli

@@ -13,7 +13,7 @@ module type MAP = sig
         type value
         val add: Time.t -> string -> value -> t -> t
         val empty : t
-        val fold : (string -> Time.t -> Time.t -> value -> 'b -> 'b) -> t -> 'b -> 'b
+        val fold : (string -> Time.t -> Time.t -> Time.t -> value -> 'b -> 'b) -> t -> 'b -> 'b
         val find : string -> t -> value
         val mem : string -> t -> bool
         val iter : (string -> value -> unit) -> t -> unit

ocaml/database/db_upgrade.ml

@@ -21,7 +21,7 @@ open Pervasiveext
 
 (** Automatically insert blank tables and new columns with default values *)
 let generic_database_upgrade db =
-  let existing_table_names = TableSet.fold (fun name _ _ _ acc -> name :: acc) (Database.tableset db) [] in
+  let existing_table_names = TableSet.fold (fun name _ _ _ _ acc -> name :: acc) (Database.tableset db) [] in
   let schema_table_names = Schema.table_names (Database.schema db) in
   let created_table_names = Listext.List.set_difference schema_table_names existing_table_names in
   let g = Manifest.generation (Database.manifest db) in
@@ -36,7 +36,7 @@ let generic_database_upgrade db =
       (fun db tblname ->
 		  let tbl = TableSet.find tblname (Database.tableset db) in
 		  let schema = Schema.table tblname (Database.schema db) in
-		  let add_fields_to_row objref _ _ r tbl : Table.t =
+		  let add_fields_to_row objref _ _ _ r tbl : Table.t =
 			  let row = Row.add_defaults g schema r in
 			  Table.add g objref row tbl in
 			let tbl = Table.fold add_fields_to_row tbl Table.empty in

ocaml/database/db_xml.ml

@@ -43,13 +43,13 @@ module To = struct
 
   (* Marshal a whole database table to an Xmlm output abstraction *)
   let table schema (output: Xmlm.output) name (tbl: Table.t) = 
-    let record rf ctime mtime (row: Row.t) _ = 
+    let record rf ctime mtime _ (row: Row.t) _ = 
 		let preamble = 
 			if persist_generation_counts 
 			then [("__mtime",Generation.to_string mtime); ("__ctime",Generation.to_string ctime); ("ref",rf)] 
 			else [("ref",rf)] 
 		in
-	  let (tag: Xmlm.tag) = make_tag "row" (List.rev (Row.fold (fun k _ _ v acc -> (k, Xml_spaces.protect v) :: acc) row preamble)) in
+	  let (tag: Xmlm.tag) = make_tag "row" (List.rev (Row.fold (fun k _ _ _ v acc -> (k, Xml_spaces.protect v) :: acc) row preamble)) in
       Xmlm.output output (`El_start tag);
       Xmlm.output output `El_end in
     let tag = make_tag "table" [ "name", name ] in

ocaml/db_process/xapi_db_process.ml

@@ -99,7 +99,7 @@ let find_my_host_row() =
   let localhost_uuid = Xapi_inventory.lookup Xapi_inventory._installation_uuid in
   let db = Db_ref.get_database (Db_backend.make ()) in
   let tbl = TableSet.find Db_names.host (Database.tableset db) in
-  Table.fold (fun r _ _ row acc -> if Row.find Db_names.uuid row = localhost_uuid then (Some (r, row)) else acc) tbl None
+  Table.fold (fun r _ _ _ row acc -> if Row.find Db_names.uuid row = localhost_uuid then (Some (r, row)) else acc) tbl None
 
 let _iscsi_iqn = "iscsi_iqn"
 let _other_config = "other_config"

ocaml/xapi/xapi_event.ml

@@ -505,10 +505,10 @@ let from_inner __context session subs from from_t deadline =
 
 	let valid_ref_counts =
 		Db_cache_types.TableSet.fold
-			(fun tablename _ _ table acc ->
+			(fun tablename _ _ _ table acc ->
 				(String.lowercase tablename,
 					(Db_cache_types.Table.fold
-						(fun r _ _ _ acc -> Int32.add 1l acc) table 0l))::acc)
+						(fun r _ _ _ _ acc -> Int32.add 1l acc) table 0l))::acc)
 		tableset [] in
 
 	{

opam

@@ -10,7 +10,6 @@ depends: [
   "ocamlfind"
   "xapi-idl"
   "xapi-libs-transitional"
-  "xen-api-client"
   "xapi-netdev"
   "omake"
   "cdrom"