Rewrite the database upgrade update_snapshots to use the type-safe Db.* API rather...

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

diff --git a/ocaml/database/db_upgrade.ml b/ocaml/database/db_upgrade.ml
index 20c25c33de870ceb8eb5d2ebf9a4656cc21fbd91..26cd339593b7ed9e25480da0cff5d35e1830e095 100644 (file)
--- a/ocaml/database/db_upgrade.ml
+++ b/ocaml/database/db_upgrade.ml
@@ -58,39 +58,10 @@ let apply_upgrade_rules rules previous_version db =
                        db
     ) db required_rules
   
-
-
-let update_snapshots db = 
-       (* GEORGE -> MIDNIGHT RIDE *)
-       let ts = Database.tableset db in
-       let vm_table = TableSet.find Names.vm ts in
-       let vm_rows = Table.rows vm_table in
-       let update_snapshots vm_row vm_table : Table.t =
-               let vm = Row.find Names.ref vm_row in
-               let snapshot_rows = List.filter (fun s -> Row.find Names.snapshot_of s = vm) vm_rows in
-               let compare s1 s2 =
-                       let t1 = Row.find Names.snapshot_time s1 in
-                       let t2 = Row.find Names.snapshot_time s2 in
-                       compare t1 t2 in
-               let ordered_snapshot_rows = List.sort compare snapshot_rows in
-               debug "Snapshots(%s) = {%s}" vm (String.concat ", " (List.map (fun s -> Row.find Names.ref s) ordered_snapshot_rows));
-               let rec aux snaps vm_table = match snaps with
-                       | [] | [_] -> vm_table
-                       | s1 :: s2 :: t ->
-                               let row' = Row.add Names.parent (Row.find Names.ref s1) s2 in
-                               let vm_table = Table.add (Row.find Names.ref s2) s2 vm_table in
-                               aux (s2 :: t) vm_table in
-               aux (ordered_snapshot_rows @ [ vm_row]) vm_table in
-       let vm_table = Table.fold (fun _ vm_row tbl -> update_snapshots vm_row tbl) vm_table vm_table in
-       set_table Names.vm vm_table db
-
 (** A list of all the custom database upgrade rules known to the system. *)
 let upgrade_rules = 
   let george = Datamodel.george_release_schema_major_vsn, Datamodel.george_release_schema_minor_vsn in
-  [ { description = "Updating snapshot parent references";
-      version = george;
-      fn = update_snapshots } ]
-
+  [ ]
 (** {Generic database upgrade handling} *)
 
 (** Automatically insert blank tables and new columns with default values *)

diff --git a/ocaml/xapi/xapi_db_upgrade.ml b/ocaml/xapi/xapi_db_upgrade.ml
index 33b2298e97e8a4dafac9fa28d5343969bbe6b6af..576146a82c42522f22112eace2cd66ae63b0cf78 100644 (file)
--- a/ocaml/xapi/xapi_db_upgrade.ml
+++ b/ocaml/xapi/xapi_db_upgrade.ml
@@ -169,12 +169,34 @@ let upgrade_bios_strings = {
                                update_vms Xapi_globs.generic_bios_strings
 }
 
+let update_snapshots = {
+       description = "Updating snapshot parent references";
+       version = (fun x -> x <= george);
+       fn = fun ~__context ->
+               let all_vms = Db.VM.get_all ~__context in
+               let update_snapshots self =
+                       let snapshots = List.filter (fun snap -> Db.VM.get_snapshot_of ~__context ~self:snap = self) all_vms in
+                       let compare s1 s2 =
+                               let t1 = Db.VM.get_snapshot_time ~__context ~self:s1 in
+                               let t2 = Db.VM.get_snapshot_time ~__context ~self:s2 in
+                               compare t1 t2 in
+                       let ordered_snapshots = List.sort compare snapshots in
+                       debug "Snapshots(%s) = {%s}" (Ref.string_of self) (String.concat ", " (List.map Ref.string_of ordered_snapshots));
+                       let rec aux snaps = match snaps with
+                               | [] | [_] -> ()
+                               | s1 :: s2 :: t ->
+                                       Db.VM.set_parent ~__context ~self:s2 ~value:s1;
+                                       aux (s2 :: t) in
+                       aux (ordered_snapshots @ [ self]) in
+               List.iter update_snapshots all_vms
+}
 
 let rules = [
        upgrade_vm_memory_overheads;
        upgrade_wlb_configuration;
        upgrade_vm_memory_for_dmc;
        upgrade_bios_strings;
+       update_snapshots;
 ]
 
 (* Maybe upgrade most recent db *)