From 8ab33c6b387e85ccb847d3c8764de1f029c2f359 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Fri, 16 Feb 2018 15:35:48 +0000 Subject: [PATCH 1/5] Resurrect a database unit test Signed-off-by: Jon Ludlam --- ocaml/database/database_server_main.ml | 10 +- ocaml/database/database_test.ml | 692 +++++++++++++++++++++++++ ocaml/database/database_test.mli | 17 + ocaml/database/jbuild | 38 ++ ocaml/database/schema.ml | 19 +- ocaml/database/test_schemas.ml | 13 +- 6 files changed, 777 insertions(+), 12 deletions(-) create mode 100644 ocaml/database/database_test.ml create mode 100644 ocaml/database/database_test.mli diff --git a/ocaml/database/database_server_main.ml b/ocaml/database/database_server_main.ml index 899ecada91f..3e99284dad2 100644 --- a/ocaml/database/database_server_main.ml +++ b/ocaml/database/database_server_main.ml @@ -1,3 +1,6 @@ +open Xapi_stdext_threads +open Xapi_stdext_unix +open Xapi_stdext_threads open Threadext type mode = @@ -63,15 +66,16 @@ let _ = Unixext.unlink_safe !listen_path; let sockaddr = Unix.ADDR_UNIX !listen_path in let socket = Http_svr.bind sockaddr "unix_rpc" in - let server = Http_svr.Server.empty in - Http_svr.add_handler server Http.Post "/post_remote_db_access" (Http_svr.BufIO remote_database_access_handler_v1); - Http_svr.add_handler server Http.Post "/post_remote_db_access_v2" (Http_svr.BufIO remote_database_access_handler_v2); + let server = Http_svr.Server.empty () in + Http_svr.Server.add_handler server Http.Post "/post_remote_db_access" (Http_svr.BufIO remote_database_access_handler_v1); + Http_svr.Server.add_handler server Http.Post "/post_remote_db_access_v2" (Http_svr.BufIO remote_database_access_handler_v2); Http_svr.start server socket; Printf.printf "server listening\n%!"; if !self_test then begin Printf.printf "Running unit-tests\n%!"; Local_tests.main true; Printf.printf "All tests passed\n%!"; + finished := true; end; (* Wait for either completion *) Mutex.execute m diff --git a/ocaml/database/database_test.ml b/ocaml/database/database_test.ml new file mode 100644 index 00000000000..48c8aa9a1e6 --- /dev/null +++ b/ocaml/database/database_test.ml @@ -0,0 +1,692 @@ +(* + * Copyright (C) 2010 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. + *) + open Xapi_stdext_monadic + open Xapi_stdext_unix + +let name_label = "name__label" +let name_description = "name__description" + +module Tests = functor(Client: Db_interface.DB_ACCESS) -> struct + + let name = "thevmname" + let invalid_name = "notavmname" + + let make_vm r uuid = + [ + "uuid", uuid; + name_description, ""; +(* "protection_policy", "";*) + "other_config", "()"; + "tags", "()"; + name_label, name; + ] + + let make_vbd vm r uuid = [ +(* "ref", r; *) + "uuid", uuid; + "VM", vm; + "type", "user"; + ] + + let expect_missing_row tbl r f = + try + f () + with Db_exn.DBCache_NotFound("missing row", tbl', r') when tbl' = tbl && r = r' -> () + + let expect_missing_tbl tbl f = + try + f () + with Db_exn.DBCache_NotFound("missing table", tbl', "") when tbl' = tbl -> () + + let expect_uniqueness_violation tbl fld v f = + try + f () + with Db_exn.Uniqueness_constraint_violation(tbl', fld', v') when tbl' = tbl && fld' = fld && v' = v -> () + + let expect_missing_uuid tbl uuid f = + try + f () + with Db_exn.Read_missing_uuid(tbl', "", uuid') when tbl' = tbl && uuid' = uuid -> () + + let expect_missing_column name f = + try + f () + with Db_exn.DBCache_NotFound("missing column", _, name') when name' = name -> () + + let expect_missing_field name f = + try + f () + with Db_exn.DBCache_NotFound("missing field", name', _) when name' = name -> () + let test_invalid_where_record fn_name fn = + Printf.printf "%s ...\n" fn_name; + expect_missing_tbl "Vm" + (fun () -> + let (_: string list) = fn { Db_cache_types.table = "Vm"; return = ""; where_field = ""; where_value = "" } in + failwith (Printf.sprintf "%s " fn_name) + ); + Printf.printf "%s \n" fn_name; + expect_missing_field "wibble" + (fun () -> + let (_: string list) = fn { Db_cache_types.table = "VM"; return = "wibble"; where_field = name_label; where_value = name } in + failwith (Printf.sprintf "%s " fn_name) + ); + Printf.printf "%s \n" fn_name; + expect_missing_field "wibble" + (fun () -> + let (_: string list) = fn { Db_cache_types.table = "VM"; return = name_label; where_field = "wibble"; where_value = "" } in + failwith (Printf.sprintf "%s " fn_name) + ) + + (* Verify the ref_index contents are correct for a given [tblname] and [key] (uuid/ref) *) + let check_ref_index t tblname key = match Ref_index.lookup key with + | None -> + (* We should fail to find the row *) + expect_missing_row tblname key + (fun () -> let (_: string) = Client.read_field t tblname "uuid" key in ()); + expect_missing_uuid tblname key + (fun () -> let (_: string) = Client.db_get_by_uuid t tblname key in ()) + | Some { Ref_index.name_label = name_label'; uuid = uuid; _ref = _ref } -> + (* key should be either uuid or _ref *) + if key <> uuid && (key <> _ref) + then failwith (Printf.sprintf "check_ref_index %s key %s: got ref %s uuid %s" tblname key _ref uuid); + let real_ref = if Client.is_valid_ref t key then key else Client.db_get_by_uuid t tblname key in + let real_name_label = + try Some (Client.read_field t tblname name_label real_ref) + with _ -> None in + if name_label' <> real_name_label + then failwith (Printf.sprintf "check_ref_index %s key %s: ref_index name_label = %s; db has %s" tblname key (Opt.default "None" name_label') (Opt.default "None" real_name_label)) + + +open Xapi_stdext_pervasives +open Xapi_stdext_monadic +open Db_cache_types + + let create_test_db () = + let schema = Test_schemas.many_to_many in + let db = + (Database.make schema) |> + (Db_upgrade.generic_database_upgrade) |> + (Db_backend.blow_away_non_persistent_fields schema) + in + db + + let check_many_to_many () = + let db = create_test_db () in + (* make a foo with bars = [] *) + (* make a bar with foos = [] *) + (* add 'bar' to foo.bars *) + let db = db |> + add_row "bar" "bar:1" (Row.add 0L Db_names.ref (String "bar:1") (Row.add 0L "foos" (Set []) Row.empty)) |> + add_row "foo" "foo:1" (Row.add 0L Db_names.ref (String "foo:1") (Row.add 0L "bars" (Set []) Row.empty)) |> + set_field "foo" "foo:1" "bars" (add_to_set "bar:1" (Set [])) + in + (* check that 'bar.foos' includes 'foo' *) + let bar_1 = Table.find "bar:1" (TableSet.find "bar" (Database.tableset db)) in + let bar_foos = Row.find "foos" bar_1 in + if bar_foos <> Set ["foo:1"] + then failwith (Printf.sprintf "check_many_to_many: bar(bar:1).foos expected ('foo:1') got %s" (Schema.Value.marshal bar_foos)); + + (* set foo.bars to [] *) + (* let foo_1 = Table.find "foo:1" (TableSet.find "foo" (Database.tableset db)) in*) + let db = set_field "foo" "foo:1" "bars" (Set []) db in + (* check that 'bar.foos' is empty *) + let bar_1 = Table.find "bar:1" (TableSet.find "bar" (Database.tableset db)) in + let bar_foos = Row.find "foos" bar_1 in + if bar_foos <> Set [] + then failwith (Printf.sprintf "check_many_to_many: bar(bar:1).foos expected () got %s" (Schema.Value.marshal bar_foos)); + (* add 'bar' to foo.bars *) + let db = set_field "foo" "foo:1" "bars" (Set["bar:1"]) db in + (* check that 'bar.foos' includes 'foo' *) + let bar_1 = Table.find "bar:1" (TableSet.find "bar" (Database.tableset db)) in + let bar_foos = Row.find "foos" bar_1 in + if bar_foos <> (Set["foo:1"]) + then failwith (Printf.sprintf "check_many_to_many: bar(bar:1).foos expected ('foo:1') got %s - 2" (Schema.Value.marshal bar_foos)); + (* delete 'bar' *) + let db = remove_row "bar" "bar:1" db in + (* check that 'foo.bars' is empty *) + let foo_1 = Table.find "foo:1" (TableSet.find "foo" (Database.tableset db)) in + let foo_bars = Row.find "bars" foo_1 in + if foo_bars <> (Set []) + then failwith (Printf.sprintf "check_many_to_many: foo(foo:1).foos expected () got %s" (Schema.Value.marshal foo_bars)); + () + + let check_events t = + let dump db g = + let tables = Db_cache_types.Database.tableset db in + Db_cache_types.TableSet.fold_over_recent g + (fun name _ table acc -> + Db_cache_types.Table.fold_over_recent g + (fun r { Db_cache_types.Stat.created; modified; deleted } _ acc -> + let s = + try + let row = Db_cache_types.Table.find r table in + let s = Db_cache_types.Row.fold_over_recent g + (fun k _ v acc -> + Printf.sprintf "%s %s=%s" acc k (Schema.Value.marshal v)) row "" in + s + with _ -> "(deleted)" + in + Printf.printf "%s(%s): (%Ld %Ld %Ld) %s\n" name r created modified deleted s; + () + ) table ()) tables () + in + + let get_created db g = + let tables = Db_cache_types.Database.tableset db in + Db_cache_types.TableSet.fold_over_recent g + (fun name _ table acc -> + Db_cache_types.Table.fold_over_recent g + (fun r { Db_cache_types.Stat.created } _ acc -> + if created>=g then (name,r)::acc else acc) table acc + ) tables [] + in + + let get_updated db g = + let tables = Db_cache_types.Database.tableset db in + Db_cache_types.TableSet.fold_over_recent g + (fun name _ table acc -> + Db_cache_types.Table.fold_over_recent g + (fun r _ _ acc -> + let row = Db_cache_types.Table.find r table in + Db_cache_types.Row.fold_over_recent g + (fun k _ v acc -> + (r,(k,v))::acc) row acc) + table acc) tables [] + in + + let get_deleted db g = + let tables = Db_cache_types.Database.tableset db in + Db_cache_types.TableSet.fold_over_recent g + (fun name _ table acc -> + Db_cache_types.Table.fold_over_deleted g + (fun r { Db_cache_types.Stat.deleted } acc -> + if deleted > g then r::acc else acc) + table acc) tables [] + in + + let get_max db = + let tables = Db_cache_types.Database.tableset db in + Db_cache_types.TableSet.fold_over_recent (-1L) + (fun _ { Db_cache_types.Stat.created; modified; deleted } _ largest -> + max created (max modified (max deleted largest))) tables (-1L) + in + + let db = Db_ref.get_database t in + let g = get_max db in + Printf.printf "check_events: current generation is: %Ld\n" g; + + let vm = "vmref" in + let vm_uuid = "vmuuid" in + let vbd = "vbdref" in + let vbd_uuid = "vbduuid" in + let vbd2 = "vbdref2" in + let vbd_uuid2 = "vbduuid2" in + + Client.create_row t "VM" (make_vm vm vm_uuid) vm; + let db = Db_ref.get_database t in + let g2 = get_max db in + Printf.printf "generation after create_row is: %Ld\n" g2; + dump db g; + let created = get_created db g in + Printf.printf "===TEST=== Checking that the VM creation event is reported: "; + if (List.exists (fun (table,r) -> table="VM" && r=vm) created) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + + let (_: unit) = Client.write_field t "VM" vm name_label "moo" in + let db = Db_ref.get_database t in + let g3 = get_max db in + Printf.printf "generation after write_field is: %Ld\n" g3; + dump db g2; + let updated = get_updated db g2 in + let vm_updated = List.filter (fun (r,_) -> r=vm) updated in + let vm_updated = List.map snd vm_updated in + Printf.printf "===TEST=== Checking that the VM field update is reported: "; + if (List.mem_assoc name_label vm_updated) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + + Client.create_row t "VBD" (make_vbd vm vbd vbd_uuid) vbd; + let db = Db_ref.get_database t in + let g4 = get_max db in + Printf.printf "generation after create VBD is: %Ld\n" g4; + dump db g3; + let updated = get_updated db g3 in + Printf.printf "===TEST=== Checking one-to-many after one-create: "; + let vm_updated = List.filter (fun (r,_) -> r=vm) updated in + let vm_updated = List.map snd vm_updated in + if (List.mem_assoc "VBDs" vm_updated) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + + let (_: unit) = Client.write_field t "VBD" vbd "VM" "moo" in + let db = Db_ref.get_database t in + let g5 = get_max db in + Printf.printf "generation after write_field is: %Ld\n" g5; + dump db g4; + let updated = get_updated db g4 in + Printf.printf "===TEST=== Checking one-to-many after one-update: "; + let vm_updated = List.filter (fun (r,_) -> r=vm) updated in + let vm_updated = List.map snd vm_updated in + if (List.mem_assoc "VBDs" vm_updated) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + + let (_: unit) = Client.write_field t "VBD" vbd "type" "Banana" in + let db = Db_ref.get_database t in + let g6 = get_max db in + Printf.printf "generation after write_field is: %Ld\n" g6; + dump db g5; + let updated = get_updated db g5 in + Printf.printf "===TEST=== Checking one-to-many after one-update of non-reference field: "; + let vm_updated = List.filter (fun (r,_) -> r=vm) updated in + let vm_updated = List.map snd vm_updated in + if not (List.mem_assoc "VBDs" vm_updated) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + + let (_ : unit) = Client.delete_row t "VBD" vbd in + let db = Db_ref.get_database t in + let g7 = get_max db in + Printf.printf "generation after delete VBD is: %Ld\n" g7; + Printf.printf "===TEST=== Checking deleted event: "; + let deleted = get_deleted db g6 in + if (List.mem vbd deleted) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + + Client.create_row t "VBD" (make_vbd vm vbd vbd_uuid) vbd; + let (_ : unit) = Client.delete_row t "VBD" vbd in + let db = Db_ref.get_database t in + let g8 = get_max db in + Printf.printf "generation after create/delete VBD is: %Ld\n" g8; + Printf.printf "===TEST=== Checking the VBD doesn't appear in the deleted list: "; + let deleted = get_deleted db g7 in + if not (List.mem vbd deleted) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + dump db g7; + + Client.create_row t "VBD" (make_vbd vm vbd vbd_uuid) vbd; + let db = Db_ref.get_database t in + let g9 = get_max db in + let (_ : unit) = Client.delete_row t "VBD" vbd in + Client.create_row t "VBD" (make_vbd vm vbd2 vbd_uuid2) vbd2; + let (_ : unit) = Client.delete_row t "VBD" vbd2 in + let db = Db_ref.get_database t in + let g10 = get_max db in + + Printf.printf "===TEST=== Checking for masking of delete events: "; + + + let deleted = get_deleted db g9 in + if (List.mem vbd deleted) + then (Printf.printf "Pass\n") + else (Printf.printf "Fail\n"; failwith "Event problem"); + dump db g9; + ignore(g10); + + + + () + + let main in_process = + (* reference which we create *) + let valid_ref = "ref1" in + let valid_uuid = "uuid1" in + let invalid_ref = "foo" in + let invalid_uuid = "bar" in + + let t = + if in_process + then begin + Db_backend.make () + end else begin + Db_ref.Remote + end + in + + let vbd_ref = "waz" in + let vbd_uuid = "whatever" in + + check_many_to_many (); + + (* Before we begin, clear out any old state: *) + expect_missing_row "VM" valid_ref + (fun () -> + Client.delete_row t "VM" valid_ref; + ); + if in_process then check_ref_index t "VM" valid_ref; + + expect_missing_row "VBD" vbd_ref + (fun () -> + Client.delete_row t "VBD" vbd_ref; + ); + if in_process then check_ref_index t "VBD" vbd_ref; + + Printf.printf "Deleted stale state from previous test\n"; + + Printf.printf "get_table_from_ref \n"; + begin + match Client.get_table_from_ref t invalid_ref with + | None -> Printf.printf "Reference '%s' has no associated table\n" invalid_ref + | Some t -> failwith (Printf.sprintf "Reference '%s' exists in table '%s'" invalid_ref t) + end; + Printf.printf "is_valid_ref \n"; + if Client.is_valid_ref t invalid_ref then failwith "is_valid_ref = true"; + + Printf.printf "read_refs \n"; + let existing_refs = Client.read_refs t "VM" in + Printf.printf "VM refs: [ %s ]\n" (String.concat "; " existing_refs); + Printf.printf "read_refs \n"; + expect_missing_tbl "Vm" + (fun () -> + let (_: string list) = Client.read_refs t "Vm" in + () + ); + Printf.printf "delete_row \n"; + expect_missing_row "VM" invalid_ref + (fun () -> + Client.delete_row t "VM" invalid_ref; + failwith "delete_row of a non-existent row silently succeeded" + ); + Printf.printf "create_row \n"; + expect_missing_field name_label + (fun () -> + let broken_vm = List.filter (fun (k, _) -> k <> name_label) (make_vm valid_ref valid_uuid) in + Client.create_row t "VM" broken_vm valid_ref; + failwith "create_row " + ); + Printf.printf "create_row \n"; + Client.create_row t "VM" (make_vm valid_ref valid_uuid) valid_ref; + if in_process then check_ref_index t "VM" valid_ref; + Printf.printf "is_valid_ref \n"; + if not (Client.is_valid_ref t valid_ref) + then failwith "is_valid_ref = false, after create_row"; + Printf.printf "get_table_from_ref \n"; + begin match Client.get_table_from_ref t valid_ref with + | Some "VM" -> () + | Some t -> failwith "get_table_from_ref : invalid table" + | None -> failwith "get_table_from_ref : None" + end; + Printf.printf "read_refs includes \n"; + if not (List.mem valid_ref (Client.read_refs t "VM")) + then failwith "read_refs did not include "; + + Printf.printf "create_row \n"; + expect_uniqueness_violation "VM" "_ref" valid_ref + (fun () -> + Client.create_row t "VM" (make_vm valid_ref (valid_uuid ^ "unique")) valid_ref; + failwith "create_row " + ); + Printf.printf "create_row \n"; + expect_uniqueness_violation "VM" "uuid" valid_uuid + (fun () -> + Client.create_row t "VM" (make_vm (valid_ref ^ "unique") valid_uuid) (valid_ref ^ "unique"); + failwith "create_row " + ); + Printf.printf "db_get_by_uuid \n"; + let r = Client.db_get_by_uuid t "VM" valid_uuid in + if r <> valid_ref + then failwith (Printf.sprintf "db_get_by_uuid : got %s; expected %s" r valid_ref); + Printf.printf "db_get_by_uuid \n"; + expect_missing_uuid "VM" invalid_uuid + (fun () -> + let (_: string) = Client.db_get_by_uuid t "VM" invalid_uuid in + failwith "db_get_by_uuid " + ); + Printf.printf "get_by_name_label \n"; + if Client.db_get_by_name_label t "VM" invalid_name <> [] + then failwith "db_get_by_name_label "; + + Printf.printf "get_by_name_label \n"; + if Client.db_get_by_name_label t "VM" name <> [ valid_ref ] + then failwith "db_get_by_name_label "; + + Printf.printf "read_field \n"; + if Client.read_field t "VM" name_label valid_ref <> name + then failwith "read_field : invalid name"; + + Printf.printf "read_field \n"; + if Client.read_field t "VM" "protection_policy" valid_ref <> "OpaqueRef:NULL" + then failwith "read_field : invalid protection_policy"; + + Printf.printf "read_field \n"; + expect_missing_row "VM" invalid_ref + (fun () -> + let (_: string) = Client.read_field t "VM" name_label invalid_ref in + failwith "read_field " + ); + Printf.printf "read_field \n"; + expect_missing_field "name_label" + (fun () -> + let (_: string) = Client.read_field t "VM" "name_label" valid_ref in + failwith "read_field " + ); + Printf.printf "read_field \n"; + expect_missing_row "VM" invalid_ref + (fun () -> + let (_: string) = Client.read_field t "VM" "name_label" invalid_ref in + failwith "read_field " + ); + Printf.printf "read_field_where \n"; + let where_name_label = + { Db_cache_types.table = "VM"; return = name_label; where_field="uuid"; where_value = valid_uuid } in + let xs = Client.read_field_where t where_name_label in + if not (List.mem name xs) + then failwith "read_field_where "; + test_invalid_where_record "read_field_where" (Client.read_field_where t); + +(* let xs = Client.read_set_ref t where_name_label in + if not (List.mem name xs) + then failwith "read_set_ref "; + test_invalid_where_record "read_set_ref" (Client.read_set_ref t);*) + + Printf.printf "write_field \n"; + expect_missing_tbl "Vm" + (fun () -> + let (_: unit) = Client.write_field t "Vm" "" "" "" in + failwith "write_field " + ); + Printf.printf "write_field \n"; + expect_missing_row "VM" invalid_ref + (fun () -> + let (_: unit) = Client.write_field t "VM" invalid_ref name_label "" in + failwith "write_field " + ); + Printf.printf "write_field \n"; + expect_missing_column "wibble" + (fun () -> + let (_: unit) = Client.write_field t "VM" valid_ref "wibble" "" in + failwith "write_field " + ); + Printf.printf "write_field \n"; + let (_: unit) = Client.write_field t "VM" valid_ref name_description "description" in + if in_process then check_ref_index t "VM" valid_ref; + Printf.printf "write_field - invalidating ref_index\n"; + let (_: unit) = Client.write_field t "VM" valid_ref name_label "newlabel" in + if in_process then check_ref_index t "VM" valid_ref; + + Printf.printf "read_record \n"; + expect_missing_tbl "Vm" + (fun () -> + let _ = Client.read_record t "Vm" invalid_ref in + failwith "read_record " + ); + Printf.printf "read_record \n"; + expect_missing_row "VM" invalid_ref + (fun () -> + let _ = Client.read_record t "VM" invalid_ref in + failwith "read_record " + ); + Printf.printf "read_record \n"; + let fv_list, fvs_list = Client.read_record t "VM" valid_ref in + if not(List.mem_assoc name_label fv_list) + then failwith "read_record 1"; + if List.assoc "VBDs" fvs_list <> [] + then failwith "read_record 2"; + Printf.printf "read_record foreign key\n"; + Client.create_row t "VBD" (make_vbd valid_ref vbd_ref vbd_uuid) vbd_ref; + let fv_list, fvs_list = Client.read_record t "VM" valid_ref in + if List.assoc "VBDs" fvs_list <> [ vbd_ref ] then begin + Printf.printf "fv_list = [ %s ] fvs_list = [ %s ]\n%!" (String.concat "; " (List.map (fun (k, v) -> k ^":" ^ v) fv_list)) (String.concat "; " (List.map (fun (k, v) -> k ^ ":" ^ (String.concat ", " v)) fvs_list)); + failwith "read_record 3" + end; + Printf.printf "read_record deleted foreign key\n"; + Client.delete_row t "VBD" vbd_ref; + let fv_list, fvs_list = Client.read_record t "VM" valid_ref in + if List.assoc "VBDs" fvs_list <> [] + then failwith "read_record 4"; + Printf.printf "read_record overwritten foreign key\n"; + Client.create_row t "VBD" (make_vbd valid_ref vbd_ref vbd_uuid) vbd_ref; + let fv_list, fvs_list = Client.read_record t "VM" valid_ref in + if List.assoc "VBDs" fvs_list = [] + then failwith "read_record 5"; + Client.write_field t "VBD" vbd_ref "VM" "overwritten"; + let fv_list, fvs_list = Client.read_record t "VM" valid_ref in + if List.assoc "VBDs" fvs_list <> [] + then failwith "read_record 6"; + + expect_missing_tbl "Vm" + (fun () -> + let _ = Client.read_records_where t "Vm" Db_filter_types.True in + () + ); + let xs = Client.read_records_where t "VM" Db_filter_types.True in + if List.length xs <> 1 + then failwith "read_records_where 2"; + let xs = Client.read_records_where t "VM" Db_filter_types.False in + if xs <> [] + then failwith "read_records_where 3"; + + expect_missing_tbl "Vm" + (fun () -> + let _ = Client.find_refs_with_filter t "Vm" Db_filter_types.True in + failwith "find_refs_with_filter "; + ); + let xs = Client.find_refs_with_filter t "VM" Db_filter_types.True in + if List.length xs <> 1 + then failwith "find_refs_with_filter 1"; + let xs = Client.find_refs_with_filter t "VM" Db_filter_types.False in + if xs <> [] + then failwith "find_refs_with_filter 2"; + + expect_missing_tbl "Vm" + (fun () -> + Client.process_structured_field t ("","") "Vm" "wibble" invalid_ref Db_cache_types.AddSet; + failwith "process_structure_field " + ); + expect_missing_field "wibble" + (fun () -> + Client.process_structured_field t ("","") "VM" "wibble" valid_ref Db_cache_types.AddSet; + failwith "process_structure_field " + ); + expect_missing_row "VM" invalid_ref + (fun () -> + Client.process_structured_field t ("","") "VM" name_label invalid_ref Db_cache_types.AddSet; + failwith "process_structure_field " + ); + Client.process_structured_field t ("foo", "") "VM" "tags" valid_ref Db_cache_types.AddSet; + if Client.read_field t "VM" "tags" valid_ref <> "('foo')" + then failwith "process_structure_field expected ('foo')"; + Client.process_structured_field t ("foo", "") "VM" "tags" valid_ref Db_cache_types.AddSet; + if Client.read_field t "VM" "tags" valid_ref <> "('foo')" + then failwith "process_structure_field expected ('foo') 2"; + Client.process_structured_field t ("foo", "bar") "VM" "other_config" valid_ref Db_cache_types.AddMap; + + if Client.read_field t "VM" "other_config" valid_ref <> "(('foo' 'bar'))" + then failwith "process_structure_field expected (('foo' 'bar')) 3"; + + begin + try + Client.process_structured_field t ("foo", "bar") "VM" "other_config" valid_ref Db_cache_types.AddMap; + with Db_exn.Duplicate_key("VM", "other_config", r', "foo") when r' = valid_ref -> () + end; + if Client.read_field t "VM" "other_config" valid_ref <> "(('foo' 'bar'))" + then failwith "process_structure_field expected (('foo' 'bar')) 4"; + + (* Check that non-persistent fields are filled with an empty value *) + + (* Event tests *) + + check_events t; + + (* Performance test *) + if in_process then begin + let time n f = + let start = Unix.gettimeofday () in + for i = 0 to n do + f i + done; + let total = Unix.gettimeofday () -. start in + float_of_int n /. total in + + let n = 5000 in + + let rpc_time = time n (fun _ -> + let (_: bool) = Client.is_valid_ref t valid_ref in ()) in + + Printf.printf "%.2f primitive RPC calls/sec\n" rpc_time; + + (* Delete stuff left-over from the previous run *) + let delete_time = time n + (fun i -> + let rf = Printf.sprintf "%s:%d" vbd_ref i in + try + Client.delete_row t "VBD" rf + with _ -> () + ) in + Printf.printf "Deleted %d VBD records, %.2f calls/sec\n%!" n delete_time; + + expect_missing_row "VBD" vbd_ref + (fun () -> + Client.delete_row t "VBD" vbd_ref; + ); + + (* Create lots of VBDs referening no VM *) + let create_time = time n + (fun i -> + let rf = Printf.sprintf "%s:%d" vbd_ref i in + let uuid = Printf.sprintf "%s:%d" vbd_uuid i in + Client.create_row t "VBD" (make_vbd invalid_ref rf uuid) rf; + ) in + Printf.printf "Created %d VBD records, %.2f calls/sec\n%!" n create_time; + + let m = 300000 in (* multiple of 3 *) + + (* Time a benign VM create_row, delete_row, read_record sequence *) + let benign_time = time m + (fun i -> + if i < (m / 3 * 2) then begin + if i mod 2 = 0 + then Client.create_row t "VBD" (make_vbd valid_ref vbd_ref vbd_uuid) vbd_ref + else Client.delete_row t "VBD" vbd_ref + end else + let _ = Client.read_record t "VM" valid_ref in + () + ) in + Printf.printf "good sequence: %.2f calls/sec\n%!" benign_time; + + let malign_time = time m + (fun i -> + match i mod 3 with + | 0 -> Client.create_row t "VBD" (make_vbd valid_ref vbd_ref vbd_uuid) vbd_ref + | 1 -> Client.delete_row t "VBD" vbd_ref + | 2 -> let _ = Client.read_record t "VM" valid_ref in () + | _ -> () + ) in + Printf.printf "bad sequence: %.2f calls/sec\n%!" malign_time; + end +end + diff --git a/ocaml/database/database_test.mli b/ocaml/database/database_test.mli new file mode 100644 index 00000000000..13a8bae5c11 --- /dev/null +++ b/ocaml/database/database_test.mli @@ -0,0 +1,17 @@ +(* + * Copyright (C) 2010 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. + *) + +module Tests : functor (Client: Db_interface.DB_ACCESS) -> sig + val main: bool -> unit +end diff --git a/ocaml/database/jbuild b/ocaml/database/jbuild index d8ec9439f6f..1148557d110 100644 --- a/ocaml/database/jbuild +++ b/ocaml/database/jbuild @@ -36,6 +36,7 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| database_server_main db_cache_test block_device_io + unit_test_marshall )) (libraries ( rpclib @@ -71,4 +72,41 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| )) ) ) + +(executable + ((name unit_test_marshall) + (public_name unit_test_marshall) + (package xapi) + (modules ( + unit_test_marshall + )) + (libraries ( + xapi-database + )) + ) +) + +(executable + ((name database_server_main) + (public_name database_server) + (package xapi) + (modules ( + database_server_main + )) + (libraries ( + xapi-database + threads + xapi-stdext-threads + http-svr + )) + ) +) + +(alias + ((name runtest) + (deps (database_server_main.exe)) + (action (run ${<} --master db.xml --test)) + ) +) + |} (flags rewriters) coverage_rewriter diff --git a/ocaml/database/schema.ml b/ocaml/database/schema.ml index 8a2bcf9d225..56104e82901 100644 --- a/ocaml/database/schema.ml +++ b/ocaml/database/schema.ml @@ -82,7 +82,11 @@ module Table = struct columns: Column.t list; persistent: bool; } [@@deriving sexp] - let find name t = List.find (fun col -> col.Column.name = name) t.columns + let find name t = + try + List.find (fun col -> col.Column.name = name) t.columns + with Not_found -> + raise (Db_exn.DBCache_NotFound("missing column", t.name, name)) end type relationship = @@ -94,7 +98,12 @@ module Database = struct tables: Table.t list; } [@@deriving sexp] - let find name t = List.find (fun tbl -> tbl.Table.name = name) t.tables + let find name t = + try + List.find (fun tbl -> tbl.Table.name = name) t.tables + with Not_found -> + raise (Db_exn.DBCache_NotFound("missing table", name, "")) + end (** indexed by table name, a list of (this field, foreign table, foreign field) *) @@ -132,11 +141,7 @@ type t = { let database x = x.database let table tblname x = - try - Database.find tblname (database x) - with Not_found as e -> - Printf.printf "Failed to find table: %s\n%!" tblname; - raise e + Database.find tblname (database x) let empty = { major_vsn = 0; diff --git a/ocaml/database/test_schemas.ml b/ocaml/database/test_schemas.ml index 38509aab50a..69b4157ddd1 100644 --- a/ocaml/database/test_schemas.ml +++ b/ocaml/database/test_schemas.ml @@ -31,6 +31,14 @@ let schema = ty = Schema.Type.String; issetref = false; } in + let type' = { + Schema.Column.name = "type"; + persistent = true; + empty = Schema.Value.String ""; + default = None; + ty = Schema.Type.String; + issetref = false; + } in let vbds = { Schema.Column.name = "VBDs"; persistent = false; @@ -74,12 +82,13 @@ let schema = let vm_table = { Schema.Table.name = "VM"; - columns = [ _ref; uuid; name_label; vbds; pp; name_description; tags; other_config ]; + columns = [ _ref; uuid; name_label; vbds; pp; + name_description; tags; other_config ]; persistent = true; } in let vbd_table = { Schema.Table.name = "VBD"; - columns = [ _ref; uuid; vm ]; + columns = [ _ref; uuid; vm; type' ]; persistent = true; } in let database = { From 65e39216fd4f38eaa2d3ddfc938df92fb95c3e7c Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Fri, 16 Feb 2018 16:22:01 +0000 Subject: [PATCH 2/5] Respond to @mseri's review comments Signed-off-by: Jon Ludlam --- ocaml/database/database_server_main.ml | 1 - ocaml/database/database_test.ml | 5 ++--- ocaml/database/test_schemas.ml | 3 +-- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/ocaml/database/database_server_main.ml b/ocaml/database/database_server_main.ml index 3e99284dad2..ead001ae114 100644 --- a/ocaml/database/database_server_main.ml +++ b/ocaml/database/database_server_main.ml @@ -1,6 +1,5 @@ open Xapi_stdext_threads open Xapi_stdext_unix -open Xapi_stdext_threads open Threadext type mode = diff --git a/ocaml/database/database_test.ml b/ocaml/database/database_test.ml index 48c8aa9a1e6..91606483692 100644 --- a/ocaml/database/database_test.ml +++ b/ocaml/database/database_test.ml @@ -11,8 +11,8 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) - open Xapi_stdext_monadic - open Xapi_stdext_unix +open Xapi_stdext_monadic +open Xapi_stdext_unix let name_label = "name__label" let name_description = "name__description" @@ -109,7 +109,6 @@ module Tests = functor(Client: Db_interface.DB_ACCESS) -> struct open Xapi_stdext_pervasives -open Xapi_stdext_monadic open Db_cache_types let create_test_db () = diff --git a/ocaml/database/test_schemas.ml b/ocaml/database/test_schemas.ml index 69b4157ddd1..67b2cc9b511 100644 --- a/ocaml/database/test_schemas.ml +++ b/ocaml/database/test_schemas.ml @@ -82,8 +82,7 @@ let schema = let vm_table = { Schema.Table.name = "VM"; - columns = [ _ref; uuid; name_label; vbds; pp; - name_description; tags; other_config ]; + columns = [ _ref; uuid; name_label; vbds; pp; name_description; tags; other_config ]; persistent = true; } in let vbd_table = { From 717451ccc8f7a354c162d2808159422ed51b0a58 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Fri, 16 Feb 2018 16:23:30 +0000 Subject: [PATCH 3/5] Don't install tests (pointed out by @edwintorok) Signed-off-by: Jon Ludlam --- ocaml/database/jbuild | 2 -- 1 file changed, 2 deletions(-) diff --git a/ocaml/database/jbuild b/ocaml/database/jbuild index 1148557d110..8cab4babdb4 100644 --- a/ocaml/database/jbuild +++ b/ocaml/database/jbuild @@ -75,7 +75,6 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (executable ((name unit_test_marshall) - (public_name unit_test_marshall) (package xapi) (modules ( unit_test_marshall @@ -88,7 +87,6 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (executable ((name database_server_main) - (public_name database_server) (package xapi) (modules ( database_server_main From 69b8400eb198aca41ae7b1af51a2ad516dba31ed Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Fri, 16 Feb 2018 16:25:16 +0000 Subject: [PATCH 4/5] Also run the marshalling unit test Signed-off-by: Jon Ludlam --- ocaml/database/jbuild | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/ocaml/database/jbuild b/ocaml/database/jbuild index 8cab4babdb4..0ae3ff189df 100644 --- a/ocaml/database/jbuild +++ b/ocaml/database/jbuild @@ -100,6 +100,13 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| ) ) +(alias + ((name runtest) + (deps (unit_test_marshall.exe)) + (action (run ${<})) + ) +) + (alias ((name runtest) (deps (database_server_main.exe)) From 0583a91f8ee35ddfd81162194de1bf459684eb49 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Tue, 27 Feb 2018 11:45:42 +0000 Subject: [PATCH 5/5] Remove read_set_ref, as it's never used Signed-off-by: Jon Ludlam --- ocaml/database/database_test.ml | 19 +++++------- ocaml/database/db_cache_impl.ml | 33 --------------------- ocaml/database/db_interface.ml | 4 --- ocaml/database/db_remote_cache_access_v1.ml | 3 -- ocaml/database/db_remote_cache_access_v2.ml | 2 -- ocaml/database/db_rpc_client_v1.ml | 8 ----- ocaml/database/db_rpc_client_v2.ml | 5 ---- ocaml/database/db_rpc_common_v1.ml | 9 ------ 8 files changed, 7 insertions(+), 76 deletions(-) diff --git a/ocaml/database/database_test.ml b/ocaml/database/database_test.ml index 91606483692..0bc6046483f 100644 --- a/ocaml/database/database_test.ml +++ b/ocaml/database/database_test.ml @@ -26,14 +26,14 @@ module Tests = functor(Client: Db_interface.DB_ACCESS) -> struct [ "uuid", uuid; name_description, ""; -(* "protection_policy", "";*) + (* "protection_policy", "";*) "other_config", "()"; "tags", "()"; name_label, name; ] let make_vbd vm r uuid = [ -(* "ref", r; *) + (* "ref", r; *) "uuid", uuid; "VM", vm; "type", "user"; @@ -108,8 +108,8 @@ module Tests = functor(Client: Db_interface.DB_ACCESS) -> struct then failwith (Printf.sprintf "check_ref_index %s key %s: ref_index name_label = %s; db has %s" tblname key (Opt.default "None" name_label') (Opt.default "None" real_name_label)) -open Xapi_stdext_pervasives -open Db_cache_types + open Xapi_stdext_pervasives + open Db_cache_types let create_test_db () = let schema = Test_schemas.many_to_many in @@ -126,9 +126,9 @@ open Db_cache_types (* make a bar with foos = [] *) (* add 'bar' to foo.bars *) let db = db |> - add_row "bar" "bar:1" (Row.add 0L Db_names.ref (String "bar:1") (Row.add 0L "foos" (Set []) Row.empty)) |> - add_row "foo" "foo:1" (Row.add 0L Db_names.ref (String "foo:1") (Row.add 0L "bars" (Set []) Row.empty)) |> - set_field "foo" "foo:1" "bars" (add_to_set "bar:1" (Set [])) + add_row "bar" "bar:1" (Row.add 0L Db_names.ref (String "bar:1") (Row.add 0L "foos" (Set []) Row.empty)) |> + add_row "foo" "foo:1" (Row.add 0L Db_names.ref (String "foo:1") (Row.add 0L "bars" (Set []) Row.empty)) |> + set_field "foo" "foo:1" "bars" (add_to_set "bar:1" (Set [])) in (* check that 'bar.foos' includes 'foo' *) let bar_1 = Table.find "bar:1" (TableSet.find "bar" (Database.tableset db)) in @@ -487,11 +487,6 @@ open Db_cache_types then failwith "read_field_where "; test_invalid_where_record "read_field_where" (Client.read_field_where t); -(* let xs = Client.read_set_ref t where_name_label in - if not (List.mem name xs) - then failwith "read_set_ref "; - test_invalid_where_record "read_set_ref" (Client.read_set_ref t);*) - Printf.printf "write_field \n"; expect_missing_tbl "Vm" (fun () -> diff --git a/ocaml/database/db_cache_impl.ml b/ocaml/database/db_cache_impl.ml index a1e2a7e7128..a0406a7567c 100644 --- a/ocaml/database/db_cache_impl.ml +++ b/ocaml/database/db_cache_impl.ml @@ -87,39 +87,6 @@ let touch_row t tblname objref = update_database t (touch tblname objref); Database.notify (RefreshRow(tblname, objref)) (get_database t) -(* This function *should* only be used by db_actions code looking up Set(Ref _) fields: - if we detect another (illegal) use we log the problem and fall back to a slow scan *) -let read_set_ref t rcd = - let db = get_database t in - (* The where_record should correspond to the 'one' end of a 'one to many' *) - let one_tbl = rcd.table in - let one_fld = rcd.where_field in - let rels = - try - Schema.one_to_many one_tbl (Database.schema db) - with Not_found -> - raise (Db_exn.DBCache_NotFound("missing table", one_tbl, "")) - in - (* This is an 'illegal' use if: *) - let illegal = rcd.return <> Db_names.ref || (List.filter (fun (a, _, _) -> a = one_fld) rels = []) in - if not illegal then begin - let _, many_tbl, many_fld = List.find (fun (a, _, _) -> a = one_fld) rels in - let objref = rcd.where_value in - - Schema.Value.Unsafe_cast.set (read_field_internal t many_tbl many_fld objref db) - end else begin - error "Illegal read_set_ref query { table = %s; where_field = %s; where_value = %s; return = %s }; falling back to linear scan" rcd.table rcd.where_field rcd.where_value rcd.return; - 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 -> - let v = Schema.Value.Unsafe_cast.string (Row.find rcd.where_field row) in - if v = rcd.where_value - then v :: acc else acc) - tbl [] - end - - (* setrefs contain the relationships from tbl to other tables in the form: local-classname, local-fieldname, remote-classname, remote-fieldname. db_read_record reads row from tbl with reference==objref [returning (fieldname, fieldvalue) list]. diff --git a/ocaml/database/db_interface.ml b/ocaml/database/db_interface.ml index f6b8885a8ec..096368c857d 100644 --- a/ocaml/database/db_interface.ml +++ b/ocaml/database/db_interface.ml @@ -63,10 +63,6 @@ module type DB_ACCESS = sig associated with [label] *) val db_get_by_name_label : Db_ref.t -> string -> string -> string list - (** [read_set_ref {tbl,return,where_field,where_value}] is identical - to [read_field_where ...]. *) - val read_set_ref : Db_ref.t -> Db_cache_types.where_record -> string list - (** [create_row tbl kvpairs ref] create a new row in [tbl] with key [ref] and contents [kvpairs] *) val create_row : diff --git a/ocaml/database/db_remote_cache_access_v1.ml b/ocaml/database/db_remote_cache_access_v1.ml index 94f29707dba..8e644a7e39c 100644 --- a/ocaml/database/db_remote_cache_access_v1.ml +++ b/ocaml/database/db_remote_cache_access_v1.ml @@ -74,9 +74,6 @@ module DBCacheRemoteListener = struct | "read_field_where" -> let w = unmarshall_read_field_where_args args in success (marshall_read_field_where_response (DBCache.read_field_where t w)) - | "read_set_ref" -> - let w = unmarshall_read_set_ref_args args in - success (marshall_read_set_ref_response (DBCache.read_field_where t w)) | "create_row" -> let (s1,ssl,s2) = unmarshall_create_row_args args in success (marshall_create_row_response (DBCache.create_row t s1 ssl s2)) diff --git a/ocaml/database/db_remote_cache_access_v2.ml b/ocaml/database/db_remote_cache_access_v2.ml index 40efcdb0e40..f17d06ace81 100644 --- a/ocaml/database/db_remote_cache_access_v2.ml +++ b/ocaml/database/db_remote_cache_access_v2.ml @@ -38,8 +38,6 @@ let process_rpc (req: Rpc.t) = Response.Db_get_by_uuid (DB.db_get_by_uuid t a b) | Request.Db_get_by_name_label (a, b) -> Response.Db_get_by_name_label (DB.db_get_by_name_label t a b) - | Request.Read_set_ref w -> - Response.Read_set_ref (DB.read_set_ref t w) | Request.Create_row (a, b, c) -> Response.Create_row (DB.create_row t a b c) | Request.Delete_row (a, b) -> diff --git a/ocaml/database/db_rpc_client_v1.ml b/ocaml/database/db_rpc_client_v1.ml index 6a28119d1e9..43e8c892bd5 100644 --- a/ocaml/database/db_rpc_client_v1.ml +++ b/ocaml/database/db_rpc_client_v1.ml @@ -103,14 +103,6 @@ module Make = functor(RPC: Db_interface.RPC) -> struct "db_get_by_name_label" (t,l) - let read_set_ref _ x = - do_remote_call - marshall_read_set_ref_args - unmarshall_read_set_ref_response - "read_set_ref" - x - - let create_row _ x y z = do_remote_call marshall_create_row_args diff --git a/ocaml/database/db_rpc_client_v2.ml b/ocaml/database/db_rpc_client_v2.ml index 3dc5dc16e89..0ceecc4cfac 100644 --- a/ocaml/database/db_rpc_client_v2.ml +++ b/ocaml/database/db_rpc_client_v2.ml @@ -69,11 +69,6 @@ module Make = functor(RPC: Db_interface.RPC) -> struct | Response.Db_get_by_name_label y -> y | _ -> raise Remote_db_server_returned_bad_message - let read_set_ref _ x = - match process (Request.Read_set_ref x) with - | Response.Read_set_ref y -> y - | _ -> raise Remote_db_server_returned_bad_message - let create_row _ x y z = match process (Request.Create_row (x, y, z)) with | Response.Create_row y -> y diff --git a/ocaml/database/db_rpc_common_v1.ml b/ocaml/database/db_rpc_common_v1.ml index 2d21b7494fb..8f1ac77d884 100644 --- a/ocaml/database/db_rpc_common_v1.ml +++ b/ocaml/database/db_rpc_common_v1.ml @@ -156,15 +156,6 @@ let marshall_db_get_by_name_label_response sl = let unmarshall_db_get_by_name_label_response xml = unmarshall_stringlist xml -(* read_set_ref *) -let marshall_read_set_ref_args w = marshall_where_rec w -let unmarshall_read_set_ref_args xml = unmarshall_where_rec xml -let marshall_read_set_ref_response sl = - marshall_stringlist sl -let unmarshall_read_set_ref_response xml = - unmarshall_stringlist xml - - (* create_row *) let marshall_create_row_args (s1,ssl,s2) = XMLRPC.To.array