Source file oBus_message.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
type serial = int32
type body = OBus_value.V.sequence
type flags = {
no_reply_expected : bool;
no_auto_start : bool;
}
let no_reply_expected flags = flags.no_reply_expected
let no_auto_start flags = flags.no_auto_start
let default_flags = {
no_reply_expected = false;
no_auto_start = false;
}
let make_flags ?(no_reply_expected=false) ?(no_auto_start=false) () = {
no_reply_expected = no_reply_expected;
no_auto_start = no_auto_start;
}
type typ =
| Method_call of OBus_path.t * OBus_name.interface * OBus_name.member
| Method_return of serial
| Error of serial * OBus_name.error
| Signal of OBus_path.t * OBus_name.interface * OBus_name.member
type t = {
flags : flags;
serial : serial;
typ : typ;
destination : OBus_name.bus;
sender : OBus_name.bus;
body : body;
}
let flags m = m.flags
let serial m = m.serial
let typ m = m.typ
let destination m = m.destination
let sender m = m.sender
let body m = m.body
let make ?(flags=default_flags) ?(serial=0l) ?(sender="") ?(destination="") ~typ body =
{ flags = flags;
serial = serial;
typ = typ;
destination = destination;
sender = sender;
body = body }
let method_call ?flags ?serial ?sender ?destination ~path ?(interface="") ~member body =
make ?flags ?serial ?sender ?destination ~typ:(Method_call(path, interface, member)) body
let method_return ?flags ?serial ?sender ?destination ~reply_serial body =
make ?flags ?serial ?sender ?destination ~typ:(Method_return(reply_serial)) body
let error ?flags ?serial ?sender ?destination ~reply_serial ~error_name body =
make ?flags ?serial ?sender ?destination ~typ:(Error(reply_serial, error_name)) body
let signal ?flags ?serial ?sender ?destination ~path ~interface ~member body =
make ?flags ?serial ?sender ?destination ~typ:(Signal(path, interface, member)) body
exception Invalid_reply of string
let invalid_reply ~method_call ~expected_signature ~method_return =
match method_call, method_return with
| { typ = Method_call(path, interface, member) }, { typ = Method_return _; body } ->
Invalid_reply
(Printf.sprintf
"unexpected signature for the reply to the method %S on interface %S, expected: %S, got: %S"
member
interface
(OBus_value.string_of_signature expected_signature)
(OBus_value.string_of_signature (OBus_value.V.type_of_sequence body)))
| _ ->
invalid_arg "OBus_message.invalid_reply"
open Format
open OBus_value
let print pp message =
fprintf pp
"no_reply_expected = %B@\n\
no_auto_start = %B@\n\
serial = %ld@\n\
message_type = %a@\n\
sender = %S@\n\
destination = %S@\n\
signature = %S@\n\
body_type = %a@\n\
body = %a@\n"
message.flags.no_reply_expected
message.flags.no_auto_start
message.serial
(fun pp -> function
| Method_call(path, interface, member) ->
fprintf pp
"method_call@\n\
path = %S@\n\
interface = %S@\n\
member = %S"
(OBus_path.to_string path) interface member
| Method_return reply_serial ->
fprintf pp
"method_return@\n\
reply_serial = %ld"
reply_serial
| Error(reply_serial, error_name) ->
fprintf pp
"error@\n\
reply_serial = %ld@\n\
error_name = %S"
reply_serial error_name
| Signal(path, interface, member) ->
fprintf pp
"signal@\n\
path = %S@\n\
interface = %S@\n\
member = %S"
(OBus_path.to_string path) interface member)
message.typ
message.sender
message.destination
(string_of_signature (V.type_of_sequence message.body))
T.print_sequence (V.type_of_sequence message.body)
V.print_sequence message.body