forked from xapi-project/xen-api
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
ffc2654
commit 1510033
Showing
9 changed files
with
306 additions
and
28 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,146 @@ | ||
(* | ||
* 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. | ||
*) | ||
|
||
(** client-side for remote database access protocol v2 *) | ||
|
||
open Db_rpc_common_v3 | ||
open Db_exn | ||
|
||
module D = Debug.Make (struct let name = __MODULE__ end) | ||
|
||
module Make = | ||
functor | ||
(RPC : Db_interface.RPC) | ||
-> | ||
struct | ||
type field = Schema.Value.t | ||
|
||
open Db_interface | ||
|
||
type regular_fields = (field_name * field) list | ||
|
||
type associated_fields = (field_name * row_ref list) list | ||
|
||
(** dictionary of regular fields x dictionary of associated set_ref values *) | ||
type db_record = regular_fields * associated_fields | ||
|
||
let initialise = RPC.initialise | ||
|
||
let rpc x = | ||
let reply = RPC.rpc (Wire.to_string x) in | ||
match reply |> Wire.parse_string with | ||
| Ok r -> | ||
r | ||
| Error (pos, str) -> | ||
D.error "%s: failed to parse RPC reply at position %d: %s" __LOC__ pos | ||
str ; | ||
D.debug "The RPC that we failed to parse was: %S" str ; | ||
raise Remote_db_server_returned_bad_message | ||
|
||
let process (x : Request.t) response_of_sexp = | ||
x |> Request.sexp_of_t |> rpc |> response_of_sexp | ||
|
||
let get_table_from_ref _ x = | ||
let (Response.Get_table_from_ref y) = | ||
process (Request.Get_table_from_ref x) | ||
Response.get_table_from_ref_of_sexp | ||
in | ||
y | ||
|
||
let is_valid_ref _ x = | ||
let (Response.Is_valid_ref y) = | ||
process (Request.Is_valid_ref x) Response.is_valid_ref_of_sexp | ||
in | ||
y | ||
|
||
let read_refs _ x = | ||
let (Response.Read_refs y) = | ||
process (Request.Read_refs x) Response.read_refs_of_sexp | ||
in | ||
y | ||
|
||
let read_field_where _ x = | ||
let (Response.Read_field_where y) = | ||
process (Request.Read_field_where x) Response.read_field_where_of_sexp | ||
in | ||
y | ||
|
||
let db_get_by_uuid _ t u = | ||
let (Response.Db_get_by_uuid y) = | ||
process (Request.Db_get_by_uuid (t, u)) Response.db_get_by_uuid_of_sexp | ||
in | ||
y | ||
|
||
let db_get_by_name_label _ t l = | ||
let (Response.Db_get_by_name_label y) = | ||
process | ||
(Request.Db_get_by_name_label (t, l)) | ||
Response.db_get_by_name_label_of_sexp | ||
in | ||
y | ||
|
||
let create_row _ x y z = | ||
let (Response.Create_row y) = | ||
process (Request.Create_row (x, y, z)) Response.create_row_of_sexp | ||
in | ||
y | ||
|
||
let delete_row _ x y = | ||
let (Response.Delete_row y) = | ||
process (Request.Delete_row (x, y)) Response.delete_row_of_sexp | ||
in | ||
y | ||
|
||
let write_field _ a b c d = | ||
let (Response.Write_field y) = | ||
process (Request.Write_field (a, b, c, d)) Response.write_field_of_sexp | ||
in | ||
y | ||
|
||
let read_field _ x y z = | ||
let (Response.Read_field y) = | ||
process (Request.Read_field (x, y, z)) Response.read_field_of_sexp | ||
in | ||
y | ||
|
||
let find_refs_with_filter _ s e = | ||
let (Response.Find_refs_with_filter y) = | ||
process | ||
(Request.Find_refs_with_filter (s, e)) | ||
Response.find_refs_with_filter_of_sexp | ||
in | ||
y | ||
|
||
let read_record _ x y = | ||
let (Response.Read_record (x, y)) = | ||
process (Request.Read_record (x, y)) Response.read_record_of_sexp | ||
in | ||
(x, y) | ||
|
||
let read_records_where _ x e = | ||
let (Response.Read_records_where y) = | ||
process | ||
(Request.Read_records_where (x, e)) | ||
Response.read_records_where_of_sexp | ||
in | ||
y | ||
|
||
let process_structured_field _ a b c d e = | ||
let (Response.Process_structured_field y) = | ||
process | ||
(Request.Process_structured_field (a, b, c, d, e)) | ||
Response.process_structured_field_of_sexp | ||
in | ||
y | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,102 @@ | ||
(* | ||
* 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. | ||
*) | ||
|
||
(** Marshall/unmarshall functions and types for db remote access protocol v3 *) | ||
|
||
open Sexplib0.Sexp_conv | ||
open Db_interface | ||
|
||
module Wire = Csexp.Make(Sexplib0.Sexp) | ||
|
||
module Request = struct | ||
type t = | ||
| Get_table_from_ref of row_ref | ||
| Is_valid_ref of row_ref | ||
| Read_refs of table | ||
| Find_refs_with_filter of table * Db_filter_types.expr | ||
| Read_field_where of Db_cache_types.where_record | ||
| Db_get_by_uuid of table * uuid | ||
| Db_get_by_name_label of table * string | ||
| Create_row of table * (string * Schema.Value.t) list * row_ref | ||
| Delete_row of table * row_ref | ||
| Write_field of table * row_ref * field_name * Schema.Value.t | ||
| Read_field of string * table * row_ref | ||
| Read_record of table * row_ref | ||
| Read_records_where of table * Db_filter_types.expr | ||
| Process_structured_field of | ||
(string * string) | ||
* table | ||
* field_name | ||
* row_ref | ||
* Db_cache_types.structured_op_t | ||
[@@deriving sexp_of] | ||
|
||
(* Make sure the slave only ever uses the idempotent version *) | ||
let sexp_of_t t = | ||
let t' = | ||
match t with | ||
| Process_structured_field (a, b, c, d, Db_cache_types.AddMapLegacy) -> | ||
Process_structured_field (a, b, c, d, Db_cache_types.AddMap) | ||
| x -> | ||
x | ||
in | ||
sexp_of_t t' | ||
end | ||
|
||
module Response = struct | ||
(* TODO:wrap exceptions as variants... *) | ||
type 'a t = ('a, exn) result [@@deriving of_sexp] | ||
|
||
type get_table_from_ref = Get_table_from_ref of table option | ||
[@@deriving of_sexp] | ||
|
||
type is_valid_ref = Is_valid_ref of bool [@@deriving of_sexp] | ||
|
||
type read_refs = Read_refs of row_ref list [@@deriving of_sexp] | ||
|
||
type find_refs_with_filter = Find_refs_with_filter of row_ref list | ||
[@@deriving of_sexp] | ||
|
||
type read_field_where = Read_field_where of Schema.Value.t list | ||
[@@deriving of_sexp] | ||
|
||
type db_get_by_uuid = Db_get_by_uuid of row_ref [@@deriving of_sexp] | ||
|
||
type db_get_by_name_label = Db_get_by_name_label of row_ref list | ||
[@@deriving of_sexp] | ||
|
||
type create_row = Create_row of unit [@@deriving of_sexp] | ||
|
||
type delete_row = Delete_row of unit [@@deriving of_sexp] | ||
|
||
type write_field = Write_field of unit [@@deriving of_sexp] | ||
|
||
type read_field = Read_field of Schema.Value.t [@@deriving of_sexp] | ||
|
||
type read_record = | ||
| Read_record of | ||
(field_name * Schema.Value.t) list * (field_name * row_ref list) list | ||
[@@deriving of_sexp] | ||
|
||
type read_records_where = | ||
| Read_records_where of | ||
( row_ref | ||
* ((field_name * Schema.Value.t) list * (field_name * row_ref list) list) | ||
) | ||
list | ||
[@@deriving of_sexp] | ||
|
||
type process_structured_field = Process_structured_field of unit | ||
[@@deriving of_sexp] | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.