let db =
((fun x -> x)
++ (Db_backend.blow_away_non_persistent_fields schema)
- ++ (Db_upgrade.maybe_upgrade)
++ (Db_upgrade.generic_database_upgrade))
(Database.make schema) in
(* make a foo with bars = [] *)
let db =
((Db_backend.blow_away_non_persistent_fields default_schema)
- ++ Db_upgrade.maybe_upgrade
++ Db_upgrade.generic_database_upgrade
++ populate) empty in
+++ /dev/null
-(*
- * Copyright (C) 2006-2009 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.
- *)
-(* DB upgrade steps that would be difficult to do in db_upgrade.ml
- This module is an ugly hack to work around the problems with creating new
- rows in db_upgrade.ml:non_generic_db_upgrade_rules (a context is required,
- which would have to be built manually).
-*)
-module D = Debug.Debugger(struct let name = "db_hiupgrade" end)
-open D
-
-open Stringext
-
-let upgrade_vm_memory_overheads ~__context () =
- List.iter
- (fun vm -> Xapi_vm_helpers.update_memory_overhead ~__context ~vm)
- (Db.VM.get_all ~__context)
-
-let upgrade_wlb_configuration ~__context () =
- (* there can be only one pool *)
- let pool = List.hd (Db.Pool.get_all ~__context) in
- (* get a Secret reference that makes sense, if there is no password ("")
- then use null, otherwise convert if clear-text and else keep what's
- there *)
- let wlb_passwd_ref =
- let old_wlb_pwd = Ref.string_of
- (Db.Pool.get_wlb_password ~__context ~self:pool) in
- if old_wlb_pwd = ""
- then Ref.null
- else if String.startswith "OpaqueRef:" old_wlb_pwd
- then Db.Pool.get_wlb_password ~__context ~self:pool
- else Xapi_secret.create ~__context ~value:old_wlb_pwd ~other_config:[]
- in
- Db.Pool.set_wlb_password ~__context ~self:pool ~value:wlb_passwd_ref
-
-(* This function is called during the xapi startup (xapi.ml:server_init).
- By the time it's called we've lost information about whether we need
- to upgrade, hence it has to be idempotent.
- N.B. This function is release specific:
- REMEMBER TO UPDATE IT AS WE MOVE TO NEW RELEASES.
-*)
-let hi_level_db_upgrade_rules ~__context () =
- try
- upgrade_vm_memory_overheads ~__context ();
- upgrade_wlb_configuration ~__context ();
- with e ->
- error
- "Could not perform high-level database upgrade: '%s'"
- (Printexc.to_string e)
open Db_cache_types
open Stringext
open Pervasiveext
-open Vm_memory_constraints.Vm_memory_constraints
(* ---------------------- upgrade db file from last release schema -> current schema.
) db required_rules
-let (+++) = Int64.add
-
-(** On upgrade to the first ballooning-enabled XenServer, we reset memory
-properties to safe defaults to avoid triggering something bad.
-{ul
- {- For guest domains, we replace the current set of possibly-invalid memory
- constraints {i s} with a new set of valid and unballooned constraints {i t}
- such that:
- {ol
- {- t.dynamic_max := s.static_max}
- {- t.target := s.static_max}
- {- t.dynamic_min := s.static_max}
- {- t.static_min := minimum (s.static_min, s.static_max)}}}
- {- For control domains, we respect the administrator's choice of target:
- {ol
- {- t.dynamic_max := s.target}
- {- t.dynamic_min := s.target}}}
-}
-*)
-let upgrade_vm_records db : Database.t =
- debug "Upgrading VM.memory_dynamic_{min,max} in guest and control domains.";
- let ts = Database.tableset db in
- let vm_table = TableSet.find Names.vm ts in
-
- let update_row vm_row =
- (* Helper functions to access the database. *)
- let get field_name = Int64.of_string
- (Row.find field_name vm_row) in
- let set field_name value vm_row = Row.add
- field_name (Int64.to_string value) vm_row in
- if Row.find Names.is_control_domain vm_row = "true" then begin
- let target = get Names.memory_target in
- debug "VM %s (%s) dynamic_{min,max} <- %Ld"
- (Row.find Names.uuid vm_row)
- (Row.find Names.name_label vm_row)
- target;
- ((set Names.memory_dynamic_min target)
- ++ (set Names.memory_dynamic_max target))
- vm_row
- end else begin
- (* Note this will also transform templates *)
- let safe_constraints = reset_to_safe_defaults ~constraints:
- { static_min = get Names.memory_static_min
- ; dynamic_min = get Names.memory_dynamic_min
- ; target = get Names.memory_target
- ; dynamic_max = get Names.memory_dynamic_max
- ; static_max = get Names.memory_static_max
- } in
- debug "VM %s (%s) dynamic_{min,max},target <- %Ld"
- (Row.find Names.uuid vm_row)
- (Row.find Names.name_label vm_row)
- safe_constraints.static_max;
- ((set Names.memory_static_min (safe_constraints.static_min ))
- ++ (set Names.memory_dynamic_min (safe_constraints.dynamic_min))
- ++ (set Names.memory_target (safe_constraints.target))
- ++ (set Names.memory_dynamic_max (safe_constraints.dynamic_max))
- ++ (set Names.memory_static_max (safe_constraints.static_max )))
- vm_row
- end in
- let vm_table = Table.fold (fun r row acc -> Table.add r (update_row row) acc) vm_table Table.empty in
- set_table Names.vm vm_table db
-
-
(* GEORGE OEM -> BODIE/MNR *)
let upgrade_bios_strings db =
let oem_manufacturer =
[ { description = "Updating snapshot parent references";
version = george;
fn = update_snapshots };
- { description = "Upgrading VM memory fields for DMC";
- version = george;
- fn = upgrade_vm_records };
{ description = "Upgrading VM BIOS strings";
version = george;
fn = upgrade_bios_strings } ]
Table.fold add_fields_to_row tbl db
) db schema_table_names
-(* Maybe upgrade most recent db *)
-let maybe_upgrade db =
- let (previous_major_vsn, previous_minor_vsn) as previous_vsn = Manifest.schema (Database.manifest db) in
- let (latest_major_vsn, latest_minor_vsn) as latest_vsn = Datamodel.schema_major_vsn, Datamodel.schema_minor_vsn in
- let previous_string = Printf.sprintf "(%d, %d)" previous_major_vsn previous_minor_vsn in
- let latest_string = Printf.sprintf "(%d, %d)" latest_major_vsn latest_minor_vsn in
- debug "Database schema version is %s; binary schema version is %s" previous_string latest_string;
- if previous_vsn > latest_vsn then begin
- warn "Database schema version %s is more recent than binary %s: downgrade is unsupported." previous_string previous_string;
- db
- end else begin
- if previous_vsn < latest_vsn then begin
- let db = apply_upgrade_rules upgrade_rules previous_vsn db in
- debug "Upgrade rules applied, bumping schema version to %d.%d" latest_major_vsn latest_minor_vsn;
- (Database.update_manifest ++ Manifest.update_schema)
- (fun _ -> Some (latest_major_vsn, latest_minor_vsn)) db
- end else begin
- debug "Database schemas match, no upgrade required";
- db
- end
- end
sparse_encoding \
create_storage \
create_networks \
+ xapi_db_upgrade \
xapi_fist \
xapi_udhcpd \
xapi_network_types \
wlb_reports \
remote_requests \
xapi_secret \
- ../database/db_hiupgrade \
certificates \
../license/v6client \
../license/v6rpc \
then try and bring up networking again (now racing with itself since dhclient will already be
running etc.) -- see CA-11087 *)
"starting up database engine", [ Startup.OnlyMaster ], start_database_engine;
- "hi-level database upgrade", [ Startup.OnlyMaster ], Db_hiupgrade.hi_level_db_upgrade_rules ~__context;
+ "hi-level database upgrade", [ Startup.OnlyMaster ], Xapi_db_upgrade.hi_level_db_upgrade_rules ~__context;
"HA metadata VDI liveness monitor", [ Startup.OnlyMaster; Startup.OnThread ], Redo_log_alert.loop;
"bringing up management interface", [], bring_up_management_if ~__context;
"Starting periodic scheduler", [Startup.OnThread], Xapi_periodic_scheduler.loop;
--- /dev/null
+(*
+ * Copyright (C) 2006-2009 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.
+ *)
+(* DB upgrade steps that would be difficult to do in db_upgrade.ml
+ This module is an ugly hack to work around the problems with creating new
+ rows in db_upgrade.ml:non_generic_db_upgrade_rules (a context is required,
+ which would have to be built manually).
+*)
+module D = Debug.Debugger(struct let name = "db_hiupgrade" end)
+open D
+
+open Stringext
+open Pervasiveext
+
+(** The type of an upgrade rule. The rules should ideally be idempotent and composable.
+ All new fields will have been created with default values and new tables will exist. *)
+type upgrade_rule = {
+ description: string;
+ version: (int * int) -> bool; (** rule will be applied if this is true *)
+ fn: __context:Context.t -> unit;
+}
+
+(** Apply all the rules needed for the previous_version *)
+let apply_upgrade_rules ~__context rules previous_version =
+ debug "Looking for database upgrade rules:";
+ let required_rules = List.filter (fun r -> r.version previous_version) rules in
+ List.iter
+ (fun r ->
+ debug "Applying database upgrade rule: %s" r.description;
+ try
+ r.fn ~__context
+ with exn ->
+ error "Database upgrade rule '%s' failed: %s" r.description (Printexc.to_string exn)
+ ) required_rules
+
+let george = Datamodel.george_release_schema_major_vsn, Datamodel.george_release_schema_minor_vsn
+
+let upgrade_vm_memory_overheads = {
+ description = "Upgrade VM.memory_overhead fields";
+ version = (fun _ -> true);
+ fn = fun ~__context ->
+ List.iter
+ (fun vm -> Xapi_vm_helpers.update_memory_overhead ~__context ~vm)
+ (Db.VM.get_all ~__context)
+}
+
+let upgrade_wlb_configuration = {
+ description = "Upgrade WLB to use secrets";
+ version = (fun _ -> true);
+ fn = fun ~__context ->
+ (* there can be only one pool *)
+ let pool = List.hd (Db.Pool.get_all ~__context) in
+ (* get a Secret reference that makes sense, if there is no password ("")
+ then use null, otherwise convert if clear-text and else keep what's
+ there *)
+ let wlb_passwd_ref =
+ let old_wlb_pwd = Ref.string_of
+ (Db.Pool.get_wlb_password ~__context ~self:pool) in
+ if old_wlb_pwd = ""
+ then Ref.null
+ else if String.startswith "OpaqueRef:" old_wlb_pwd
+ then Db.Pool.get_wlb_password ~__context ~self:pool
+ else Xapi_secret.create ~__context ~value:old_wlb_pwd ~other_config:[]
+ in
+ Db.Pool.set_wlb_password ~__context ~self:pool ~value:wlb_passwd_ref
+}
+
+(** On upgrade to the first ballooning-enabled XenServer, we reset memory
+properties to safe defaults to avoid triggering something bad.
+{ul
+ {- For guest domains, we replace the current set of possibly-invalid memory
+ constraints {i s} with a new set of valid and unballooned constraints {i t}
+ such that:
+ {ol
+ {- t.dynamic_max := s.static_max}
+ {- t.target := s.static_max}
+ {- t.dynamic_min := s.static_max}
+ {- t.static_min := minimum (s.static_min, s.static_max)}}}
+ {- For control domains, we respect the administrator's choice of target:
+ {ol
+ {- t.dynamic_max := s.target}
+ {- t.dynamic_min := s.target}}}
+}
+*)
+let upgrade_vm_memory_for_dmc = {
+ description = "Upgrading VM memory fields for DMC";
+ version = (fun x -> x <= george);
+ fn =
+ fun ~__context ->
+ debug "Upgrading VM.memory_dynamic_{min,max} in guest and control domains.";
+ let module VMC = Vm_memory_constraints.Vm_memory_constraints in
+
+ let update_vm (vm_ref, vm_rec) =
+ if vm_rec.API.vM_is_control_domain then begin
+ let target = vm_rec.API.vM_memory_target in
+ debug "VM %s (%s) dynamic_{min,max} <- %Ld"
+ vm_rec.API.vM_uuid
+ vm_rec.API.vM_name_label
+ target;
+ Db.VM.set_memory_dynamic_min ~__context ~self:vm_ref ~value:target;
+ Db.VM.set_memory_dynamic_max ~__context ~self:vm_ref ~value:target;
+ end else begin
+ (* Note this will also transform templates *)
+ let safe_constraints = VMC.reset_to_safe_defaults ~constraints:
+ { VMC.static_min = vm_rec.API.vM_memory_static_min
+ ; dynamic_min = vm_rec.API.vM_memory_dynamic_min
+ ; target = vm_rec.API.vM_memory_target
+ ; dynamic_max = vm_rec.API.vM_memory_dynamic_max
+ ; static_max = vm_rec.API.vM_memory_static_max
+ } in
+ debug "VM %s (%s) dynamic_{min,max},target <- %Ld"
+ vm_rec.API.vM_uuid vm_rec.API.vM_name_label
+ safe_constraints.VMC.static_max;
+ Db.VM.set_memory_static_min ~__context ~self:vm_ref ~value:safe_constraints.VMC.static_min;
+ Db.VM.set_memory_dynamic_min ~__context ~self:vm_ref ~value:safe_constraints.VMC.dynamic_min;
+ Db.VM.set_memory_target ~__context ~self:vm_ref ~value:safe_constraints.VMC.target;
+ Db.VM.set_memory_dynamic_max ~__context ~self:vm_ref ~value:safe_constraints.VMC.dynamic_max;
+
+ Db.VM.set_memory_static_max ~__context ~self:vm_ref ~value:safe_constraints.VMC.static_max;
+ end in
+ List.iter update_vm (Db.VM.get_all_records ~__context)
+}
+
+let rules = [
+ upgrade_vm_memory_overheads;
+ upgrade_wlb_configuration;
+ upgrade_vm_memory_for_dmc;
+]
+
+(* Maybe upgrade most recent db *)
+let maybe_upgrade ~__context =
+ let db_ref = Context.database_of __context in
+ let db = Db_ref.get_database db_ref in
+ let (previous_major_vsn, previous_minor_vsn) as previous_vsn = Db_cache_types.Manifest.schema (Db_cache_types.Database.manifest db) in
+ let (latest_major_vsn, latest_minor_vsn) as latest_vsn = Datamodel.schema_major_vsn, Datamodel.schema_minor_vsn in
+ let previous_string = Printf.sprintf "(%d, %d)" previous_major_vsn previous_minor_vsn in
+ let latest_string = Printf.sprintf "(%d, %d)" latest_major_vsn latest_minor_vsn in
+ debug "Database schema version is %s; binary schema version is %s" previous_string latest_string;
+ if previous_vsn > latest_vsn then begin
+ warn "Database schema version %s is more recent than binary %s: downgrade is unsupported." previous_string previous_string;
+ end else begin
+ if previous_vsn < latest_vsn then begin
+ apply_upgrade_rules ~__context rules previous_vsn;
+ debug "Upgrade rules applied, bumping schema version to %d.%d" latest_major_vsn latest_minor_vsn;
+ Db_ref.update_database db_ref
+ ((Db_cache_types.Database.update_manifest ++ Db_cache_types.Manifest.update_schema)
+ (fun _ -> Some (latest_major_vsn, latest_minor_vsn)))
+ end else begin
+ debug "Database schemas match, no upgrade required";
+ end
+ end
+
+(* This function is called during the xapi startup (xapi.ml:server_init).
+ By the time it's called we've lost information about whether we need
+ to upgrade, hence it has to be idempotent.
+ N.B. This function is release specific:
+ REMEMBER TO UPDATE IT AS WE MOVE TO NEW RELEASES.
+*)
+let hi_level_db_upgrade_rules ~__context () =
+ try
+ maybe_upgrade ~__context;
+ with e ->
+ error
+ "Could not perform high-level database upgrade: '%s'"
+ (Printexc.to_string e)
projects / xcp / xen-api.git / commitdiff