MQTT 3.1 and 5 in OCaml using Eio
Rename to mqtte and tidy codebase
- Rename mqtt-eio to mqtte throughout
- Switch from cstruct to bytesrw for parsing
- Add connection pooling with conpool
- Add TLS support via ca-certs and tls
- Extract write_fixed_header to Parser module (removes duplication)
- Use Option.iter for cleaner option handling in parser
- Simplify Topic.Filter.validate with combined length checks
- Add .ocamlformat, LICENSE.md, README.md
- Add tangled CI workflow
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+2036
-1424
+53
.tangled/workflows/build.yml
+53
.tangled/workflows/build.yml
···
1
+
when:
2
+
- event: ["push", "pull_request"]
3
+
branch: ["main"]
4
+
5
+
engine: nixery
6
+
7
+
dependencies:
8
+
nixpkgs:
9
+
- shell
10
+
- stdenv
11
+
- findutils
12
+
- binutils
13
+
- libunwind
14
+
- ncurses
15
+
- opam
16
+
- git
17
+
- gawk
18
+
- gnupatch
19
+
- gnum4
20
+
- gnumake
21
+
- gnutar
22
+
- gnused
23
+
- gnugrep
24
+
- diffutils
25
+
- gzip
26
+
- bzip2
27
+
- gcc
28
+
- ocaml
29
+
- pkg-config
30
+
31
+
steps:
32
+
- name: opam
33
+
command: |
34
+
opam init --disable-sandboxing -a -y
35
+
- name: repo
36
+
command: |
37
+
opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git
38
+
- name: switch
39
+
command: |
40
+
opam install . --confirm-level=unsafe-yes --deps-only
41
+
- name: build
42
+
command: |
43
+
opam exec -- dune build
44
+
- name: switch-test
45
+
command: |
46
+
opam install . --confirm-level=unsafe-yes --deps-only --with-test
47
+
- name: test
48
+
command: |
49
+
opam exec -- dune runtest --verbose
50
+
- name: doc
51
+
command: |
52
+
opam install -y odoc
53
+
opam exec -- dune build @doc
+15
LICENSE.md
+15
LICENSE.md
···
1
+
ISC License
2
+
3
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>
4
+
5
+
Permission to use, copy, modify, and distribute this software for any
6
+
purpose with or without fee is hereby granted, provided that the above
7
+
copyright notice and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+90
README.md
+90
README.md
···
1
+
# mqtte
2
+
3
+
An MQTT protocol library for OCaml with an Eio-based client.
4
+
5
+
## Features
6
+
7
+
- **MQTT v3.1.1 and v5.0 support** - Full protocol implementations for both versions
8
+
- **Effects-based I/O** - Built on Eio for modern OCaml 5+ concurrency
9
+
- **QoS levels** - Support for all three quality of service levels (0, 1, 2)
10
+
- **Topic wildcards** - Full support for single-level (+) and multi-level (#) wildcards
11
+
- **Connection pooling** - Integration with conpool for efficient connection management
12
+
- **TLS support** - Secure connections via tls-eio
13
+
- **Command-line tools** - Cmdliner integration for easy CLI application building
14
+
15
+
## Installation
16
+
17
+
```bash
18
+
opam install mqtte
19
+
```
20
+
21
+
## Usage
22
+
23
+
### Publisher Example
24
+
25
+
```ocaml
26
+
open Mqtte_eio.Client
27
+
28
+
let () =
29
+
Eio_main.run @@ fun env ->
30
+
Eio.Switch.run @@ fun sw ->
31
+
32
+
let config = default_config ~client_id:"my-publisher" () in
33
+
34
+
let client = connect
35
+
~sw
36
+
~net:(Eio.Stdenv.net env)
37
+
~clock:(Eio.Stdenv.clock env)
38
+
~config
39
+
~host:"127.0.0.1"
40
+
~port:1883
41
+
()
42
+
in
43
+
44
+
publish ~qos:`At_least_once ~topic:"sensors/temperature" "22.5" client;
45
+
disconnect client
46
+
```
47
+
48
+
### Subscriber Example
49
+
50
+
```ocaml
51
+
open Mqtte_eio.Client
52
+
53
+
let () =
54
+
Eio_main.run @@ fun env ->
55
+
Eio.Switch.run @@ fun sw ->
56
+
57
+
let config = default_config ~client_id:"my-subscriber" () in
58
+
59
+
let on_message msg =
60
+
Printf.printf "Received [%s]: %s\n" msg.topic msg.payload
61
+
in
62
+
63
+
let client = connect
64
+
~sw
65
+
~net:(Eio.Stdenv.net env)
66
+
~clock:(Eio.Stdenv.clock env)
67
+
~on_message
68
+
~config
69
+
~host:"127.0.0.1"
70
+
~port:1883
71
+
()
72
+
in
73
+
74
+
subscribe ~qos:`At_least_once ["sensors/#"] client;
75
+
Eio.Time.sleep (Eio.Stdenv.clock env) 60.0;
76
+
disconnect client
77
+
```
78
+
79
+
## Library Structure
80
+
81
+
- **mqtte** - Core protocol types and codecs (no I/O dependencies)
82
+
- **mqtte.eio** - Full client library with Eio-based transport
83
+
84
+
## Documentation
85
+
86
+
API documentation is available at: https://tangled.org/@anil.recoil.org/ocaml-mqtte
87
+
88
+
## License
89
+
90
+
ISC License. See [LICENSE.md](LICENSE.md) for details.
+16
-8
dune-project
+16
-8
dune-project
···
1
1
(lang dune 3.20)
2
-
(name mqtt-eio)
2
+
(name mqtte)
3
3
4
4
(generate_opam_files true)
5
5
6
-
(source (github avsm/mqtt-eio))
7
6
(license ISC)
8
7
(authors "Anil Madhavapeddy")
9
-
(maintainers "anil@recoil.org")
8
+
(homepage "https://tangled.org/@anil.recoil.org/ocaml-mqtte")
9
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
10
+
(bug_reports "https://tangled.org/@anil.recoil.org/ocaml-mqtte/issues")
11
+
(maintenance_intent "(latest)")
10
12
11
13
(package
12
-
(name mqtt-eio)
13
-
(synopsis "MQTT client library for OCaml using Eio")
14
-
(description "An MQTT v3.1.1 and v5.0 client library using Eio for effects-based IO")
14
+
(name mqtte)
15
+
(synopsis "MQTT protocol library for OCaml")
16
+
(description "An MQTT v3.1.1 and v5.0 protocol library with Eio-based client")
15
17
(depends
16
18
(ocaml (>= 5.1))
17
19
(eio (>= 1.0))
18
20
(eio_main (>= 1.0))
19
-
(cstruct (>= 6.0))
21
+
(bytesrw (>= 0.1))
22
+
(bytesrw-eio (>= 0.1))
23
+
conpool
24
+
ca-certs
25
+
(cmdliner (>= 1.2))
26
+
tls
20
27
(logs (>= 0.7))
21
28
(fmt (>= 0.9))
22
-
(alcotest :with-test)))
29
+
(alcotest :with-test)
30
+
(odoc :with-doc)))
+3
-4
examples/dune
+3
-4
examples/dune
···
1
1
(executables
2
2
(names publisher subscriber)
3
-
(public_names mqtt-publisher mqtt-subscriber)
4
-
(package mqtt-eio)
5
-
(libraries mqtt mqtt_eio eio_main logs.fmt fmt.tty))
6
-
3
+
(public_names mqtte-publisher mqtte-subscriber)
4
+
(package mqtte)
5
+
(libraries mqtte mqtte_eio eio_main logs.fmt fmt.tty))
+9
-10
examples/publisher.ml
+9
-10
examples/publisher.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT Publisher Example *)
2
7
3
-
open Mqtt_eio.Client
8
+
open Mqtte_eio.Client
4
9
5
10
let () =
6
11
(* Set up logging *)
···
10
15
11
16
Eio_main.run @@ fun env ->
12
17
Eio.Switch.run @@ fun sw ->
13
-
14
18
let config = default_config ~client_id:"mqtt-publisher" () in
15
19
16
-
let client = connect
17
-
~sw
18
-
~net:(Eio.Stdenv.net env)
19
-
~clock:(Eio.Stdenv.clock env)
20
-
~config
21
-
~host:"127.0.0.1"
22
-
~port:1883
23
-
()
20
+
let client =
21
+
connect ~sw ~net:(Eio.Stdenv.net env) ~clock:(Eio.Stdenv.clock env) ~config
22
+
~host:"127.0.0.1" ~port:1883 ()
24
23
in
25
24
26
25
Logs.info (fun m -> m "Connected to MQTT broker");
+15
-22
examples/subscriber.ml
+15
-22
examples/subscriber.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT Subscriber Example *)
2
7
3
-
open Mqtt_eio.Client
8
+
open Mqtte_eio.Client
4
9
5
10
let () =
6
11
(* Set up logging *)
···
10
15
11
16
Eio_main.run @@ fun env ->
12
17
Eio.Switch.run @@ fun sw ->
13
-
14
18
let config = default_config ~client_id:"mqtt-subscriber" () in
15
19
16
20
let on_message msg =
17
-
Logs.info (fun m -> m "Received [%s] (QoS %d, retain=%b): %s"
18
-
msg.topic
19
-
(match msg.qos with `At_most_once -> 0 | `At_least_once -> 1 | `Exactly_once -> 2)
20
-
msg.retain
21
-
msg.payload)
21
+
Logs.info (fun m ->
22
+
m "Received [%s] (QoS %d, retain=%b): %s" msg.topic
23
+
(Mqtte.Qos.to_int msg.qos) msg.retain msg.payload)
22
24
in
23
25
24
-
let on_disconnect () =
25
-
Logs.warn (fun m -> m "Disconnected from broker")
26
-
in
26
+
let on_disconnect () = Logs.warn (fun m -> m "Disconnected from broker") in
27
27
28
-
let client = connect
29
-
~sw
30
-
~net:(Eio.Stdenv.net env)
31
-
~clock:(Eio.Stdenv.clock env)
32
-
~on_message
33
-
~on_disconnect
34
-
~config
35
-
~host:"127.0.0.1"
36
-
~port:1883
37
-
()
28
+
let client =
29
+
connect ~sw ~net:(Eio.Stdenv.net env) ~clock:(Eio.Stdenv.clock env)
30
+
~on_message ~on_disconnect ~config ~host:"127.0.0.1" ~port:1883 ()
38
31
in
39
32
40
33
Logs.info (fun m -> m "Connected to MQTT broker");
41
34
42
35
(* Subscribe to topics *)
43
-
subscribe ~qos:`At_least_once ["test/#"; "sensor/+/temperature"] client;
36
+
subscribe ~qos:`At_least_once [ "test/#"; "sensor/+/temperature" ] client;
44
37
Logs.info (fun m -> m "Subscribed to test/# and sensor/+/temperature");
45
38
46
39
(* Keep running for 60 seconds *)
47
40
Logs.info (fun m -> m "Listening for messages (60 seconds)...");
48
41
Eio.Time.sleep (Eio.Stdenv.clock env) 60.0;
49
42
50
-
unsubscribe ["test/#"; "sensor/+/temperature"] client;
43
+
unsubscribe [ "test/#"; "sensor/+/temperature" ] client;
51
44
disconnect client;
52
45
Logs.info (fun m -> m "Disconnected")
+2
-2
lib/core/dune
+2
-2
lib/core/dune
-13
lib/core/mqtt.ml
-13
lib/core/mqtt.ml
···
1
-
(** MQTT Protocol Library
2
-
3
-
Types and codecs for MQTT v3.1.1 and v5.0 protocols. *)
4
-
5
-
module Qos = Shared.Qos
6
-
module Protocol_version = Shared.Protocol_version
7
-
module Credentials = Shared.Credentials
8
-
module Will = Shared.Will
9
-
module Packet_id = Shared.Packet_id
10
-
module Topic = Shared.Topic
11
-
12
-
module V3 = V3
13
-
module V5 = V5
+134
-51
lib/core/mqtt.mli
lib/core/mqtte.mli
+134
-51
lib/core/mqtt.mli
lib/core/mqtte.mli
···
1
-
(** MQTT Protocol Library
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
2
5
3
-
Types and codecs for MQTT v3.1.1 and v5.0 protocols.
6
+
(** MQTTE Protocol Library
4
7
5
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html> MQTT v3.1.1 Specification
6
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html> MQTT v5.0 Specification *)
8
+
Types and codecs for MQTTE v3.1.1 and v5.0 protocols.
9
+
10
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html>
11
+
MQTTE v3.1.1 Specification
12
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html>
13
+
MQTTE v5.0 Specification *)
7
14
8
15
(** {1 Quality of Service}
9
16
10
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718099> Section 4.3 *)
17
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718099>
18
+
Section 4.3 *)
11
19
12
20
module Qos : sig
13
21
type t = [ `At_most_once | `At_least_once | `Exactly_once ]
···
33
41
34
42
(** {1 Authentication}
35
43
36
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718031> Section 3.1.2.8-9 *)
44
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718031>
45
+
Section 3.1.2.8-9 *)
37
46
38
47
module Credentials : sig
39
48
type t = [ `Username of string | `Username_password of string * string ]
···
44
53
45
54
(** {1 Last Will and Testament}
46
55
47
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718031> Section 3.1.2.5 *)
56
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718031>
57
+
Section 3.1.2.5 *)
48
58
49
59
module Will : sig
50
60
type t
···
60
70
61
71
(** {1 Packet Identifier}
62
72
63
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718025> Section 2.3.1 *)
73
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718025>
74
+
Section 2.3.1 *)
64
75
65
76
module Packet_id : sig
66
77
type t = int
···
71
82
72
83
(** {1 Topics}
73
84
74
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718106> Section 4.7 *)
85
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718106>
86
+
Section 4.7 *)
75
87
76
88
module Topic : sig
77
89
(** Topic names for publishing (no wildcards). *)
···
92
104
end
93
105
end
94
106
95
-
(** {1 MQTT v3.1.1}
107
+
(** {1 MQTTE v3.1.1}
96
108
97
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html> OASIS Standard *)
109
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html>
110
+
OASIS Standard *)
98
111
99
112
module V3 : sig
100
113
(** {2 Return Codes}
101
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718035> Section 3.2.2.3 *)
114
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718035>
115
+
Section 3.2.2.3 *)
102
116
103
117
module Return_code : sig
104
-
type t = [
105
-
| `Accepted
118
+
type t =
119
+
[ `Accepted
106
120
| `Unacceptable_protocol_version
107
121
| `Identifier_rejected
108
122
| `Server_unavailable
109
123
| `Bad_username_or_password
110
-
| `Not_authorized
111
-
]
124
+
| `Not_authorized ]
112
125
113
126
val pp : Format.formatter -> t -> unit
114
127
val to_int : t -> int
···
117
130
end
118
131
119
132
(** {2 SUBACK Codes}
120
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718071> Section 3.9.3 *)
133
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718071>
134
+
Section 3.9.3 *)
121
135
122
136
module Suback_code : sig
123
137
type t = [ `Granted_qos_0 | `Granted_qos_1 | `Granted_qos_2 | `Failure ]
···
136
150
end
137
151
138
152
(** {2 Packets}
139
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718027> Section 2.2 *)
153
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718027>
154
+
Section 2.2 *)
140
155
141
156
module Packet : sig
142
157
type t =
···
174
189
end
175
190
end
176
191
177
-
(** {1 MQTT v5.0}
192
+
(** {1 MQTTE v5.0}
178
193
179
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html> OASIS Standard *)
194
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html>
195
+
OASIS Standard *)
180
196
181
197
module V5 : sig
182
198
(** {2 Reason Codes}
183
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901031> Section 2.4 *)
199
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901031>
200
+
Section 2.4 *)
184
201
185
202
module Reason_code : sig
186
-
type t = [
187
-
| `Success | `Normal_disconnection | `Granted_qos_0 | `Granted_qos_1
188
-
| `Granted_qos_2 | `Disconnect_with_will | `No_matching_subscribers
189
-
| `No_subscription_existed | `Continue_authentication | `Re_authenticate
190
-
| `Unspecified_error | `Malformed_packet | `Protocol_error
191
-
| `Implementation_specific_error | `Unsupported_protocol_version
192
-
| `Client_identifier_not_valid | `Bad_user_name_or_password
193
-
| `Not_authorized | `Server_unavailable | `Server_busy | `Banned
194
-
| `Server_shutting_down | `Bad_authentication_method | `Keep_alive_timeout
195
-
| `Session_taken_over | `Topic_filter_invalid | `Topic_name_invalid
196
-
| `Packet_identifier_in_use | `Packet_identifier_not_found
197
-
| `Receive_maximum_exceeded | `Topic_alias_invalid | `Packet_too_large
198
-
| `Message_rate_too_high | `Quota_exceeded | `Administrative_action
199
-
| `Payload_format_invalid | `Retain_not_supported | `Qos_not_supported
200
-
| `Use_another_server | `Server_moved | `Shared_subscriptions_not_supported
201
-
| `Connection_rate_exceeded | `Maximum_connect_time
202
-
| `Subscription_identifiers_not_supported | `Wildcard_subscriptions_not_supported
203
-
]
203
+
type t =
204
+
[ `Success
205
+
| `Normal_disconnection
206
+
| `Granted_qos_0
207
+
| `Granted_qos_1
208
+
| `Granted_qos_2
209
+
| `Disconnect_with_will
210
+
| `No_matching_subscribers
211
+
| `No_subscription_existed
212
+
| `Continue_authentication
213
+
| `Re_authenticate
214
+
| `Unspecified_error
215
+
| `Malformed_packet
216
+
| `Protocol_error
217
+
| `Implementation_specific_error
218
+
| `Unsupported_protocol_version
219
+
| `Client_identifier_not_valid
220
+
| `Bad_user_name_or_password
221
+
| `Not_authorized
222
+
| `Server_unavailable
223
+
| `Server_busy
224
+
| `Banned
225
+
| `Server_shutting_down
226
+
| `Bad_authentication_method
227
+
| `Keep_alive_timeout
228
+
| `Session_taken_over
229
+
| `Topic_filter_invalid
230
+
| `Topic_name_invalid
231
+
| `Packet_identifier_in_use
232
+
| `Packet_identifier_not_found
233
+
| `Receive_maximum_exceeded
234
+
| `Topic_alias_invalid
235
+
| `Packet_too_large
236
+
| `Message_rate_too_high
237
+
| `Quota_exceeded
238
+
| `Administrative_action
239
+
| `Payload_format_invalid
240
+
| `Retain_not_supported
241
+
| `Qos_not_supported
242
+
| `Use_another_server
243
+
| `Server_moved
244
+
| `Shared_subscriptions_not_supported
245
+
| `Connection_rate_exceeded
246
+
| `Maximum_connect_time
247
+
| `Subscription_identifiers_not_supported
248
+
| `Wildcard_subscriptions_not_supported ]
204
249
205
250
val pp : Format.formatter -> t -> unit
206
251
val to_int : t -> int
···
209
254
end
210
255
211
256
(** {2 Properties}
212
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901027> Section 2.2.2 *)
257
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901027>
258
+
Section 2.2.2 *)
213
259
214
260
module Property : sig
215
261
type t =
···
245
291
end
246
292
247
293
(** {2 Subscription Options}
248
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901169> Section 3.8.3.1 *)
294
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901169>
295
+
Section 3.8.3.1 *)
249
296
250
297
module Subscription_options : sig
251
298
type t = {
···
282
329
end
283
330
284
331
(** {2 Packets}
285
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901019> Section 2.1 *)
332
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901019>
333
+
Section 2.1 *)
286
334
287
335
module Packet : sig
288
336
type t =
···
308
356
payload : string;
309
357
properties : Property.t list;
310
358
}
311
-
| Puback of { packet_id : Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
312
-
| Pubrec of { packet_id : Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
313
-
| Pubrel of { packet_id : Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
314
-
| Pubcomp of { packet_id : Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
315
-
| Subscribe of { packet_id : Packet_id.t; properties : Property.t list; topics : Subscription.t list }
316
-
| Suback of { packet_id : Packet_id.t; properties : Property.t list; reason_codes : Reason_code.t list }
317
-
| Unsubscribe of { packet_id : Packet_id.t; properties : Property.t list; topics : Topic.Filter.t list }
318
-
| Unsuback of { packet_id : Packet_id.t; properties : Property.t list; reason_codes : Reason_code.t list }
359
+
| Puback of {
360
+
packet_id : Packet_id.t;
361
+
reason_code : Reason_code.t;
362
+
properties : Property.t list;
363
+
}
364
+
| Pubrec of {
365
+
packet_id : Packet_id.t;
366
+
reason_code : Reason_code.t;
367
+
properties : Property.t list;
368
+
}
369
+
| Pubrel of {
370
+
packet_id : Packet_id.t;
371
+
reason_code : Reason_code.t;
372
+
properties : Property.t list;
373
+
}
374
+
| Pubcomp of {
375
+
packet_id : Packet_id.t;
376
+
reason_code : Reason_code.t;
377
+
properties : Property.t list;
378
+
}
379
+
| Subscribe of {
380
+
packet_id : Packet_id.t;
381
+
properties : Property.t list;
382
+
topics : Subscription.t list;
383
+
}
384
+
| Suback of {
385
+
packet_id : Packet_id.t;
386
+
properties : Property.t list;
387
+
reason_codes : Reason_code.t list;
388
+
}
389
+
| Unsubscribe of {
390
+
packet_id : Packet_id.t;
391
+
properties : Property.t list;
392
+
topics : Topic.Filter.t list;
393
+
}
394
+
| Unsuback of {
395
+
packet_id : Packet_id.t;
396
+
properties : Property.t list;
397
+
reason_codes : Reason_code.t list;
398
+
}
319
399
| Pingreq
320
400
| Pingresp
321
-
| Disconnect of { reason_code : Reason_code.t; properties : Property.t list }
401
+
| Disconnect of {
402
+
reason_code : Reason_code.t;
403
+
properties : Property.t list;
404
+
}
322
405
| Auth of { reason_code : Reason_code.t; properties : Property.t list }
323
406
324
407
val pp : Format.formatter -> t -> unit
+17
lib/core/mqtte.ml
+17
lib/core/mqtte.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** MQTT Protocol Library
7
+
8
+
Types and codecs for MQTT v3.1.1 and v5.0 protocols. *)
9
+
10
+
module Qos = Shared.Qos
11
+
module Protocol_version = Shared.Protocol_version
12
+
module Credentials = Shared.Credentials
13
+
module Will = Shared.Will
14
+
module Packet_id = Shared.Packet_id
15
+
module Topic = Shared.Topic
16
+
module V3 = V3
17
+
module V5 = V5
+36
-33
lib/core/parser.ml
+36
-33
lib/core/parser.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT Binary Parsers and Writers using Bytesrw
2
7
3
8
Native bytesrw-based reading and writing for MQTT protocol binary formats.
···
7
12
8
13
(** {1 Stream Error} *)
9
14
10
-
type error =
11
-
| Unexpected_eod
12
-
| Malformed_varint
13
-
| Parse_error of string
14
-
15
+
type error = Unexpected_eod | Malformed_varint | Parse_error of string
15
16
type Bytes.Stream.error += Mqtt of error
16
17
17
18
let error_message = function
···
21
22
| _ -> "Unknown MQTT error"
22
23
23
24
let mqtt_error =
24
-
Bytes.Stream.make_format_error
25
-
~format:"mqtt"
25
+
Bytes.Stream.make_format_error ~format:"mqtt"
26
26
~case:(fun e -> Mqtt e)
27
27
~message:error_message
28
28
···
30
30
31
31
(** {1 Reading Primitives}
32
32
33
-
All read functions take a [Bytes.Reader.t] and return the parsed value.
34
-
They raise [Bytes.Stream.Error] on failure. *)
33
+
All read functions take a [Bytes.Reader.t] and return the parsed value. They
34
+
raise [Bytes.Stream.Error] on failure. *)
35
35
36
36
let uint8 reader =
37
37
let slice = Bytes.Reader.read reader in
···
40
40
let first = Bytes.Slice.first slice in
41
41
let v = Bytes.get_uint8 b first in
42
42
(* Push back remaining bytes if slice has more than 1 byte *)
43
-
(match Bytes.Slice.drop 1 slice with
44
-
| Some rest -> Bytes.Reader.push_back reader rest
45
-
| None -> ());
43
+
Option.iter (Bytes.Reader.push_back reader) (Bytes.Slice.drop 1 slice);
46
44
v
47
45
48
46
let take n reader =
···
57
55
if len <= !remaining then begin
58
56
Bytes.Slice.add_to_buffer buf slice;
59
57
remaining := !remaining - len
60
-
end else begin
58
+
end
59
+
else begin
61
60
(* Take only what we need, push back the rest *)
62
61
let needed, rest = Bytes.Slice.break !remaining slice in
63
-
(match needed with Some s -> Bytes.Slice.add_to_buffer buf s | None -> ());
64
-
(match rest with Some s -> Bytes.Reader.push_back reader s | None -> ());
62
+
Option.iter (Bytes.Slice.add_to_buffer buf) needed;
63
+
Option.iter (Bytes.Reader.push_back reader) rest;
65
64
remaining := 0
66
65
end
67
66
done;
···
80
79
let b1 = Char.code (String.get s 1) in
81
80
let b2 = Char.code (String.get s 2) in
82
81
let b3 = Char.code (String.get s 3) in
83
-
Int32.(logor (shift_left (of_int b0) 24)
84
-
(logor (shift_left (of_int b1) 16)
85
-
(logor (shift_left (of_int b2) 8)
86
-
(of_int b3))))
82
+
Int32.(
83
+
logor
84
+
(shift_left (of_int b0) 24)
85
+
(logor
86
+
(shift_left (of_int b1) 16)
87
+
(logor (shift_left (of_int b2) 8) (of_int b3))))
87
88
88
89
let mqtt_string reader =
89
90
let len = uint16_be reader in
···
94
95
let variable_length reader =
95
96
let rec loop acc mult =
96
97
let byte = uint8 reader in
97
-
let acc = acc + (byte land 0x7F) * mult in
98
+
let acc = acc + (byte land 0x7F * mult) in
98
99
if byte land 0x80 = 0 then acc
99
-
else if mult > 128 * 128 * 128 then
100
-
fail reader Malformed_varint
100
+
else if mult > 128 * 128 * 128 then fail reader Malformed_varint
101
101
else loop acc (mult * 128)
102
102
in
103
103
loop 0 1
···
106
106
let buf = Buffer.create 256 in
107
107
let rec loop () =
108
108
let slice = Bytes.Reader.read reader in
109
-
if Bytes.Slice.is_eod slice then
110
-
Buffer.contents buf
109
+
if Bytes.Slice.is_eod slice then Buffer.contents buf
111
110
else begin
112
111
Bytes.Slice.add_to_buffer buf slice;
113
112
loop ()
···
156
155
let rec encode n =
157
156
let byte = n land 0x7F in
158
157
let n' = n lsr 7 in
159
-
if n' = 0 then
160
-
write_uint8 writer byte
158
+
if n' = 0 then write_uint8 writer byte
161
159
else begin
162
160
write_uint8 writer (byte lor 0x80);
163
161
encode n'
···
177
175
in
178
176
first :: loop []
179
177
180
-
let many f reader =
181
-
if is_eod reader then []
182
-
else many1 f reader
178
+
let many f reader = if is_eod reader then [] else many1 f reader
183
179
184
180
let count n f reader =
185
181
let rec loop acc n =
186
-
if n <= 0 then List.rev acc
187
-
else loop (f reader :: acc) (n - 1)
182
+
if n <= 0 then List.rev acc else loop (f reader :: acc) (n - 1)
188
183
in
189
184
loop [] n
190
185
186
+
(** {1 Fixed Header} *)
187
+
188
+
let write_fixed_header writer packet_type flags remaining_length =
189
+
let type_byte =
190
+
(Shared.Packet_type.to_int packet_type lsl 4) lor (flags land 0x0F)
191
+
in
192
+
write_uint8 writer type_byte;
193
+
write_variable_length writer remaining_length
194
+
191
195
(** {1 Utility Functions} *)
192
196
193
-
let of_string s =
194
-
Bytes.Reader.of_string s
197
+
let of_string s = Bytes.Reader.of_string s
195
198
196
199
let to_string writer_fn =
197
200
let buf = Buffer.create 128 in
+41
-22
lib/core/parser.mli
+41
-22
lib/core/parser.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT Binary Parsers and Writers
2
7
3
8
Low-level binary parsing and writing primitives for MQTT protocol encoding.
···
11
16
- Length-prefixed UTF-8 strings (2-byte length prefix)
12
17
- Variable-length integers for remaining length and property IDs
13
18
14
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718023> MQTT v3.1.1 Section 2 - MQTT Control Packet format
15
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901019> MQTT v5.0 Section 2 - MQTT Control Packet format *)
19
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718023>
20
+
MQTT v3.1.1 Section 2 - MQTT Control Packet format
21
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901019>
22
+
MQTT v5.0 Section 2 - MQTT Control Packet format *)
16
23
17
24
(** {1 Error Types} *)
18
25
19
26
type error =
20
-
| Unexpected_eod (** Unexpected end of data while parsing. *)
21
-
| Malformed_varint (** Variable-length integer exceeds maximum size. *)
22
-
| Parse_error of string (** Generic parse error with description. *)
27
+
| Unexpected_eod (** Unexpected end of data while parsing. *)
28
+
| Malformed_varint (** Variable-length integer exceeds maximum size. *)
29
+
| Parse_error of string (** Generic parse error with description. *)
23
30
24
-
type Bytesrw.Bytes.Stream.error += Mqtt of error
25
-
(** MQTT-specific stream errors. *)
31
+
type Bytesrw.Bytes.Stream.error +=
32
+
| Mqtt of error (** MQTT-specific stream errors. *)
26
33
27
34
val error_message : Bytesrw.Bytes.Stream.error -> string
28
35
(** [error_message err] returns a human-readable error message. *)
···
32
39
33
40
(** {1 Reading Primitives}
34
41
35
-
All read functions take a [Bytes.Reader.t] and return the parsed value.
36
-
They raise [Bytes.Stream.Error] on failure. *)
42
+
All read functions take a [Bytes.Reader.t] and return the parsed value. They
43
+
raise [Bytes.Stream.Error] on failure. *)
37
44
38
45
val uint8 : Bytesrw.Bytes.Reader.t -> int
39
46
(** Read a single unsigned byte. *)
···
50
57
val mqtt_string : Bytesrw.Bytes.Reader.t -> string
51
58
(** Read an MQTT UTF-8 string (2-byte length prefix + data).
52
59
53
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718016> MQTT v3.1.1 Section 1.5.3 - UTF-8 encoded strings *)
60
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718016>
61
+
MQTT v3.1.1 Section 1.5.3 - UTF-8 encoded strings *)
54
62
55
63
val mqtt_binary : Bytesrw.Bytes.Reader.t -> string
56
64
(** Read MQTT binary data (2-byte length prefix + data). Same encoding as
···
59
67
val variable_length : Bytesrw.Bytes.Reader.t -> int
60
68
(** Read a variable-length integer (1-4 bytes, 7 bits per byte).
61
69
62
-
Used for remaining length in fixed header and various v5.0 fields.
63
-
Maximum value is 268,435,455 (0x0FFFFFFF).
70
+
Used for remaining length in fixed header and various v5.0 fields. Maximum
71
+
value is 268,435,455 (0x0FFFFFFF).
64
72
65
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718023> MQTT v3.1.1 Section 2.2.3 - Remaining Length *)
73
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718023>
74
+
MQTT v3.1.1 Section 2.2.3 - Remaining Length *)
66
75
67
76
val take_rest : Bytesrw.Bytes.Reader.t -> string
68
77
(** Read all remaining data from the reader. *)
···
92
101
Raises [Invalid_argument] if string length exceeds 65535. *)
93
102
94
103
val write_mqtt_binary : Bytesrw.Bytes.Writer.t -> string -> unit
95
-
(** Write MQTT binary data (2-byte length prefix + data).
96
-
Same encoding as [write_mqtt_string]. *)
104
+
(** Write MQTT binary data (2-byte length prefix + data). Same encoding as
105
+
[write_mqtt_string]. *)
97
106
98
107
val write_variable_length : Bytesrw.Bytes.Writer.t -> int -> unit
99
108
(** Write a variable-length integer (1-4 bytes).
···
103
112
(** {1 Combinators} *)
104
113
105
114
val many : (Bytesrw.Bytes.Reader.t -> 'a) -> Bytesrw.Bytes.Reader.t -> 'a list
106
-
(** [many f reader] applies [f] repeatedly until end of data, returning
107
-
a list of results. Returns empty list if already at end of data. *)
115
+
(** [many f reader] applies [f] repeatedly until end of data, returning a list
116
+
of results. Returns empty list if already at end of data. *)
108
117
109
118
val many1 : (Bytesrw.Bytes.Reader.t -> 'a) -> Bytesrw.Bytes.Reader.t -> 'a list
110
-
(** [many1 f reader] applies [f] at least once, then repeatedly until end
111
-
of data. Raises if reader is already at end of data. *)
119
+
(** [many1 f reader] applies [f] at least once, then repeatedly until end of
120
+
data. Raises if reader is already at end of data. *)
112
121
113
-
val count : int -> (Bytesrw.Bytes.Reader.t -> 'a) -> Bytesrw.Bytes.Reader.t -> 'a list
122
+
val count :
123
+
int -> (Bytesrw.Bytes.Reader.t -> 'a) -> Bytesrw.Bytes.Reader.t -> 'a list
114
124
(** [count n f reader] applies [f] exactly [n] times. *)
115
125
126
+
(** {1 Fixed Header} *)
127
+
128
+
val write_fixed_header :
129
+
Bytesrw.Bytes.Writer.t -> Shared.Packet_type.t -> int -> int -> unit
130
+
(** [write_fixed_header writer packet_type flags remaining_length] writes the
131
+
MQTT fixed header. The first byte contains the packet type (4 bits) and
132
+
flags (4 bits), followed by the remaining length as a variable-length
133
+
integer. *)
134
+
116
135
(** {1 Utility Functions} *)
117
136
118
137
val of_string : string -> Bytesrw.Bytes.Reader.t
119
138
(** [of_string s] creates a reader from a string. *)
120
139
121
140
val to_string : (Bytesrw.Bytes.Writer.t -> unit) -> string
122
-
(** [to_string f] runs [f] with a fresh writer and returns the result
123
-
as a string. *)
141
+
(** [to_string f] runs [f] with a fresh writer and returns the result as a
142
+
string. *)
+134
-124
lib/core/v3.ml
+134
-124
lib/core/v3.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT v3.1.1 Protocol *)
2
7
3
8
open Bytesrw
4
9
5
10
module Return_code = struct
6
-
type t = [
7
-
| `Accepted
11
+
type t =
12
+
[ `Accepted
8
13
| `Unacceptable_protocol_version
9
14
| `Identifier_rejected
10
15
| `Server_unavailable
11
16
| `Bad_username_or_password
12
-
| `Not_authorized
13
-
]
17
+
| `Not_authorized ]
14
18
15
19
let to_int = function
16
20
| `Accepted -> 0
···
68
72
type t = { filter : Shared.Topic.Filter.t; qos : Shared.Qos.t }
69
73
70
74
let pp ppf t =
71
-
Format.fprintf ppf "{filter=%a; qos=%a}"
72
-
Shared.Topic.Filter.pp t.filter Shared.Qos.pp t.qos
75
+
Format.fprintf ppf "{filter=%a; qos=%a}" Shared.Topic.Filter.pp t.filter
76
+
Shared.Qos.pp t.qos
73
77
end
74
78
75
79
module Packet = struct
···
96
100
| Pubrec of Shared.Packet_id.t
97
101
| Pubrel of Shared.Packet_id.t
98
102
| Pubcomp of Shared.Packet_id.t
99
-
| Subscribe of { packet_id : Shared.Packet_id.t; topics : Subscription.t list }
100
-
| Suback of { packet_id : Shared.Packet_id.t; return_codes : Suback_code.t list }
101
-
| Unsubscribe of { packet_id : Shared.Packet_id.t; topics : Shared.Topic.Filter.t list }
103
+
| Subscribe of {
104
+
packet_id : Shared.Packet_id.t;
105
+
topics : Subscription.t list;
106
+
}
107
+
| Suback of {
108
+
packet_id : Shared.Packet_id.t;
109
+
return_codes : Suback_code.t list;
110
+
}
111
+
| Unsubscribe of {
112
+
packet_id : Shared.Packet_id.t;
113
+
topics : Shared.Topic.Filter.t list;
114
+
}
102
115
| Unsuback of Shared.Packet_id.t
103
116
| Pingreq
104
117
| Pingresp
···
106
119
107
120
let pp ppf = function
108
121
| Connect c ->
109
-
Format.fprintf ppf "Connect{client_id=%s; clean_session=%b; keep_alive=%d}"
110
-
c.client_id c.clean_session c.keep_alive
122
+
Format.fprintf ppf
123
+
"Connect{client_id=%s; clean_session=%b; keep_alive=%d}" c.client_id
124
+
c.clean_session c.keep_alive
111
125
| Connack c ->
112
-
Format.fprintf ppf "Connack{session_present=%b; return_code=%a}"
113
-
c.session_present Return_code.pp c.return_code
126
+
Format.fprintf ppf "Connack{session_present=%b; return_code=%a}"
127
+
c.session_present Return_code.pp c.return_code
114
128
| Publish p ->
115
-
Format.fprintf ppf "Publish{topic=%s; qos=%a; dup=%b; retain=%b; payload=<%d bytes>}"
116
-
p.topic Shared.Qos.pp p.qos p.dup p.retain (String.length p.payload)
129
+
Format.fprintf ppf
130
+
"Publish{topic=%s; qos=%a; dup=%b; retain=%b; payload=<%d bytes>}"
131
+
p.topic Shared.Qos.pp p.qos p.dup p.retain (String.length p.payload)
117
132
| Puback id -> Format.fprintf ppf "Puback(%d)" id
118
133
| Pubrec id -> Format.fprintf ppf "Pubrec(%d)" id
119
134
| Pubrel id -> Format.fprintf ppf "Pubrel(%d)" id
120
135
| Pubcomp id -> Format.fprintf ppf "Pubcomp(%d)" id
121
136
| Subscribe s ->
122
-
Format.fprintf ppf "Subscribe{packet_id=%d; topics=[%a]}"
123
-
s.packet_id
124
-
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") Subscription.pp)
125
-
s.topics
137
+
Format.fprintf ppf "Subscribe{packet_id=%d; topics=[%a]}" s.packet_id
138
+
(Format.pp_print_list
139
+
~pp_sep:(fun ppf () -> Format.fprintf ppf "; ")
140
+
Subscription.pp)
141
+
s.topics
126
142
| Suback s ->
127
-
Format.fprintf ppf "Suback{packet_id=%d; return_codes=[%a]}"
128
-
s.packet_id
129
-
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") Suback_code.pp)
130
-
s.return_codes
143
+
Format.fprintf ppf "Suback{packet_id=%d; return_codes=[%a]}" s.packet_id
144
+
(Format.pp_print_list
145
+
~pp_sep:(fun ppf () -> Format.fprintf ppf "; ")
146
+
Suback_code.pp)
147
+
s.return_codes
131
148
| Unsubscribe u ->
132
-
Format.fprintf ppf "Unsubscribe{packet_id=%d; topics=[%a]}"
133
-
u.packet_id
134
-
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") Shared.Topic.Filter.pp)
135
-
u.topics
149
+
Format.fprintf ppf "Unsubscribe{packet_id=%d; topics=[%a]}" u.packet_id
150
+
(Format.pp_print_list
151
+
~pp_sep:(fun ppf () -> Format.fprintf ppf "; ")
152
+
Shared.Topic.Filter.pp)
153
+
u.topics
136
154
| Unsuback id -> Format.fprintf ppf "Unsuback(%d)" id
137
155
| Pingreq -> Format.fprintf ppf "Pingreq"
138
156
| Pingresp -> Format.fprintf ppf "Pingresp"
···
140
158
141
159
(** {1 Encoding} *)
142
160
143
-
let write_fixed_header writer packet_type flags remaining_length =
144
-
let type_byte = (Shared.Packet_type.to_int packet_type lsl 4) lor (flags land 0x0F) in
145
-
P.write_uint8 writer type_byte;
146
-
P.write_variable_length writer remaining_length
147
-
148
-
let write_connect writer ~clean_session ~keep_alive ~client_id ~credentials ~will =
149
-
let payload = P.to_string (fun w ->
150
-
P.write_mqtt_string w "MQTT";
151
-
P.write_uint8 w 4;
152
-
let flags = ref 0 in
153
-
if clean_session then flags := !flags lor 0x02;
154
-
Option.iter (fun w' ->
155
-
flags := !flags lor 0x04;
156
-
flags := !flags lor (Shared.Qos.to_int (Shared.Will.qos w') lsl 3);
157
-
if Shared.Will.retain w' then flags := !flags lor 0x20
158
-
) will;
159
-
(match credentials with
160
-
| Some (`Username _) -> flags := !flags lor 0x80
161
-
| Some (`Username_password _) -> flags := !flags lor 0xC0
162
-
| None -> ());
163
-
P.write_uint8 w !flags;
164
-
P.write_uint16_be w keep_alive;
165
-
P.write_mqtt_string w client_id;
166
-
Option.iter (fun w' ->
167
-
P.write_mqtt_string w (Shared.Will.topic w');
168
-
P.write_mqtt_string w (Shared.Will.payload w')
169
-
) will;
170
-
(match credentials with
171
-
| Some (`Username u) ->
172
-
P.write_mqtt_string w u
173
-
| Some (`Username_password (username, password)) ->
174
-
P.write_mqtt_string w username;
175
-
P.write_mqtt_string w password
176
-
| None -> ())
177
-
) in
178
-
write_fixed_header writer `CONNECT 0 (String.length payload);
161
+
let write_connect writer ~clean_session ~keep_alive ~client_id ~credentials
162
+
~will =
163
+
let payload =
164
+
P.to_string (fun w ->
165
+
P.write_mqtt_string w "MQTT";
166
+
P.write_uint8 w 4;
167
+
let flags = ref 0 in
168
+
if clean_session then flags := !flags lor 0x02;
169
+
Option.iter
170
+
(fun w' ->
171
+
flags := !flags lor 0x04;
172
+
flags := !flags lor (Shared.Qos.to_int (Shared.Will.qos w') lsl 3);
173
+
if Shared.Will.retain w' then flags := !flags lor 0x20)
174
+
will;
175
+
(match credentials with
176
+
| Some (`Username _) -> flags := !flags lor 0x80
177
+
| Some (`Username_password _) -> flags := !flags lor 0xC0
178
+
| None -> ());
179
+
P.write_uint8 w !flags;
180
+
P.write_uint16_be w keep_alive;
181
+
P.write_mqtt_string w client_id;
182
+
Option.iter
183
+
(fun w' ->
184
+
P.write_mqtt_string w (Shared.Will.topic w');
185
+
P.write_mqtt_string w (Shared.Will.payload w'))
186
+
will;
187
+
match credentials with
188
+
| Some (`Username u) -> P.write_mqtt_string w u
189
+
| Some (`Username_password (username, password)) ->
190
+
P.write_mqtt_string w username;
191
+
P.write_mqtt_string w password
192
+
| None -> ())
193
+
in
194
+
P.write_fixed_header writer `CONNECT 0 (String.length payload);
179
195
P.write_string writer payload
180
196
181
197
let write_connack writer ~session_present ~return_code =
182
-
write_fixed_header writer `CONNACK 0 2;
198
+
P.write_fixed_header writer `CONNACK 0 2;
183
199
P.write_uint8 writer (if session_present then 0x01 else 0x00);
184
200
P.write_uint8 writer (Return_code.to_int return_code)
185
201
186
202
let write_publish writer ~dup ~qos ~retain ~topic ~packet_id ~payload:msg =
187
-
let body = P.to_string (fun w ->
188
-
P.write_mqtt_string w topic;
189
-
(match packet_id with
190
-
| Some id when qos <> `At_most_once ->
191
-
P.write_uint16_be w id
192
-
| _ -> ());
193
-
P.write_string w msg
194
-
) in
203
+
let body =
204
+
P.to_string (fun w ->
205
+
P.write_mqtt_string w topic;
206
+
(match packet_id with
207
+
| Some id when qos <> `At_most_once -> P.write_uint16_be w id
208
+
| _ -> ());
209
+
P.write_string w msg)
210
+
in
195
211
let flags =
196
-
(if dup then 0x08 else 0) lor
197
-
(Shared.Qos.to_int qos lsl 1) lor
198
-
(if retain then 0x01 else 0)
212
+
(if dup then 0x08 else 0)
213
+
lor (Shared.Qos.to_int qos lsl 1)
214
+
lor if retain then 0x01 else 0
199
215
in
200
-
write_fixed_header writer `PUBLISH flags (String.length body);
216
+
P.write_fixed_header writer `PUBLISH flags (String.length body);
201
217
P.write_string writer body
202
218
203
-
let write_pubx writer packet_type ?(flags=0) id =
204
-
write_fixed_header writer packet_type flags 2;
219
+
let write_pubx writer packet_type ?(flags = 0) id =
220
+
P.write_fixed_header writer packet_type flags 2;
205
221
P.write_uint16_be writer id
206
222
207
223
let write_puback writer id = write_pubx writer `PUBACK id
···
210
226
let write_pubcomp writer id = write_pubx writer `PUBCOMP id
211
227
212
228
let write_subscribe writer ~packet_id ~topics =
213
-
let payload = P.to_string (fun w ->
214
-
P.write_uint16_be w packet_id;
215
-
List.iter (fun (t : Subscription.t) ->
216
-
P.write_mqtt_string w t.filter;
217
-
P.write_uint8 w (Shared.Qos.to_int t.qos)
218
-
) topics
219
-
) in
220
-
write_fixed_header writer `SUBSCRIBE 0x02 (String.length payload);
229
+
let payload =
230
+
P.to_string (fun w ->
231
+
P.write_uint16_be w packet_id;
232
+
List.iter
233
+
(fun (t : Subscription.t) ->
234
+
P.write_mqtt_string w t.filter;
235
+
P.write_uint8 w (Shared.Qos.to_int t.qos))
236
+
topics)
237
+
in
238
+
P.write_fixed_header writer `SUBSCRIBE 0x02 (String.length payload);
221
239
P.write_string writer payload
222
240
223
241
let write_suback writer ~packet_id ~return_codes =
224
-
let payload = P.to_string (fun w ->
225
-
P.write_uint16_be w packet_id;
226
-
List.iter (fun rc ->
227
-
P.write_uint8 w (Suback_code.to_int rc)
228
-
) return_codes
229
-
) in
230
-
write_fixed_header writer `SUBACK 0 (String.length payload);
242
+
let payload =
243
+
P.to_string (fun w ->
244
+
P.write_uint16_be w packet_id;
245
+
List.iter
246
+
(fun rc -> P.write_uint8 w (Suback_code.to_int rc))
247
+
return_codes)
248
+
in
249
+
P.write_fixed_header writer `SUBACK 0 (String.length payload);
231
250
P.write_string writer payload
232
251
233
252
let write_unsubscribe writer ~packet_id ~topics =
234
-
let payload = P.to_string (fun w ->
235
-
P.write_uint16_be w packet_id;
236
-
List.iter (fun topic ->
237
-
P.write_mqtt_string w topic
238
-
) topics
239
-
) in
240
-
write_fixed_header writer `UNSUBSCRIBE 0x02 (String.length payload);
253
+
let payload =
254
+
P.to_string (fun w ->
255
+
P.write_uint16_be w packet_id;
256
+
List.iter (fun topic -> P.write_mqtt_string w topic) topics)
257
+
in
258
+
P.write_fixed_header writer `UNSUBSCRIBE 0x02 (String.length payload);
241
259
P.write_string writer payload
242
260
243
261
let write_unsuback writer id =
244
-
write_fixed_header writer `UNSUBACK 0 2;
262
+
P.write_fixed_header writer `UNSUBACK 0 2;
245
263
P.write_uint16_be writer id
246
264
247
-
let write_pingreq writer =
248
-
write_fixed_header writer `PINGREQ 0 0
249
-
250
-
let write_pingresp writer =
251
-
write_fixed_header writer `PINGRESP 0 0
252
-
253
-
let write_disconnect writer =
254
-
write_fixed_header writer `DISCONNECT 0 0
265
+
let write_pingreq writer = P.write_fixed_header writer `PINGREQ 0 0
266
+
let write_pingresp writer = P.write_fixed_header writer `PINGRESP 0 0
267
+
let write_disconnect writer = P.write_fixed_header writer `DISCONNECT 0 0
255
268
256
269
let write writer = function
257
270
| Connect { clean_session; keep_alive; client_id; credentials; will } ->
258
-
write_connect writer ~clean_session ~keep_alive ~client_id ~credentials ~will
271
+
write_connect writer ~clean_session ~keep_alive ~client_id ~credentials
272
+
~will
259
273
| Connack { session_present; return_code } ->
260
-
write_connack writer ~session_present ~return_code
274
+
write_connack writer ~session_present ~return_code
261
275
| Publish { dup; qos; retain; topic; packet_id; payload } ->
262
-
write_publish writer ~dup ~qos ~retain ~topic ~packet_id ~payload
276
+
write_publish writer ~dup ~qos ~retain ~topic ~packet_id ~payload
263
277
| Puback id -> write_puback writer id
264
278
| Pubrec id -> write_pubrec writer id
265
279
| Pubrel id -> write_pubrel writer id
266
280
| Pubcomp id -> write_pubcomp writer id
267
281
| Subscribe { packet_id; topics } ->
268
-
write_subscribe writer ~packet_id ~topics
282
+
write_subscribe writer ~packet_id ~topics
269
283
| Suback { packet_id; return_codes } ->
270
-
write_suback writer ~packet_id ~return_codes
284
+
write_suback writer ~packet_id ~return_codes
271
285
| Unsubscribe { packet_id; topics } ->
272
-
write_unsubscribe writer ~packet_id ~topics
286
+
write_unsubscribe writer ~packet_id ~topics
273
287
| Unsuback id -> write_unsuback writer id
274
288
| Pingreq -> write_pingreq writer
275
289
| Pingresp -> write_pingresp writer
···
295
309
if will_flag then
296
310
let topic = P.mqtt_string reader in
297
311
let payload = P.mqtt_string reader in
298
-
Some (Shared.Will.create ~topic ~payload ~qos:will_qos ~retain:will_retain)
312
+
Some
313
+
(Shared.Will.create ~topic ~payload ~qos:will_qos ~retain:will_retain)
299
314
else None
300
315
in
301
316
let credentials =
···
321
336
let retain = flags land 0x01 <> 0 in
322
337
let topic = P.mqtt_string reader in
323
338
let packet_id =
324
-
if qos <> `At_most_once then
325
-
Some (P.uint16_be reader)
326
-
else None
339
+
if qos <> `At_most_once then Some (P.uint16_be reader) else None
327
340
in
328
341
let payload = P.take_rest reader in
329
342
Publish { dup; qos; retain; topic; packet_id; payload }
···
347
360
let read_suback ~remaining_length reader =
348
361
let packet_id = P.uint16_be reader in
349
362
let num_codes = remaining_length - 2 in
350
-
let read_code reader =
351
-
Suback_code.of_int (P.uint8 reader)
352
-
in
363
+
let read_code reader = Suback_code.of_int (P.uint8 reader) in
353
364
let return_codes = P.count num_codes read_code reader in
354
365
Suback { packet_id; return_codes }
355
366
···
358
369
let topics = P.many1 P.mqtt_string reader in
359
370
Unsubscribe { packet_id; topics }
360
371
361
-
let read_unsuback reader =
362
-
Unsuback (P.uint16_be reader)
372
+
let read_unsuback reader = Unsuback (P.uint16_be reader)
363
373
364
374
let read reader =
365
375
let first_byte = P.uint8 reader in
+28
-11
lib/core/v3.mli
+28
-11
lib/core/v3.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT v3.1.1 Protocol Implementation
2
7
3
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html> OASIS Standard *)
8
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html>
9
+
OASIS Standard *)
4
10
5
11
(** {1 Return Codes}
6
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718035> Section 3.2.2.3 *)
12
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718035>
13
+
Section 3.2.2.3 *)
7
14
8
15
module Return_code : sig
9
-
type t = [
10
-
| `Accepted
16
+
type t =
17
+
[ `Accepted
11
18
| `Unacceptable_protocol_version
12
19
| `Identifier_rejected
13
20
| `Server_unavailable
14
21
| `Bad_username_or_password
15
-
| `Not_authorized
16
-
]
22
+
| `Not_authorized ]
17
23
18
24
val pp : Format.formatter -> t -> unit
19
25
val to_int : t -> int
···
22
28
end
23
29
24
30
(** {1 SUBACK Codes}
25
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718071> Section 3.9.3 *)
31
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718071>
32
+
Section 3.9.3 *)
26
33
27
34
module Suback_code : sig
28
35
type t = [ `Granted_qos_0 | `Granted_qos_1 | `Granted_qos_2 | `Failure ]
···
41
48
end
42
49
43
50
(** {1 Packets}
44
-
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718027> Section 2.2 *)
51
+
@see <http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html#_Toc398718027>
52
+
Section 2.2 *)
45
53
46
54
module Packet : sig
47
55
type t =
···
65
73
| Pubrec of Shared.Packet_id.t
66
74
| Pubrel of Shared.Packet_id.t
67
75
| Pubcomp of Shared.Packet_id.t
68
-
| Subscribe of { packet_id : Shared.Packet_id.t; topics : Subscription.t list }
69
-
| Suback of { packet_id : Shared.Packet_id.t; return_codes : Suback_code.t list }
70
-
| Unsubscribe of { packet_id : Shared.Packet_id.t; topics : Shared.Topic.Filter.t list }
76
+
| Subscribe of {
77
+
packet_id : Shared.Packet_id.t;
78
+
topics : Subscription.t list;
79
+
}
80
+
| Suback of {
81
+
packet_id : Shared.Packet_id.t;
82
+
return_codes : Suback_code.t list;
83
+
}
84
+
| Unsubscribe of {
85
+
packet_id : Shared.Packet_id.t;
86
+
topics : Shared.Topic.Filter.t list;
87
+
}
71
88
| Unsuback of Shared.Packet_id.t
72
89
| Pingreq
73
90
| Pingresp
+430
-346
lib/core/v5.ml
+430
-346
lib/core/v5.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT v5.0 Protocol *)
2
7
3
8
open Bytesrw
4
9
5
-
(** {1 Reason Codes} *)
6
-
7
-
type reason_code = [
8
-
| `Success
9
-
| `Normal_disconnection
10
-
| `Granted_qos_0
11
-
| `Granted_qos_1
12
-
| `Granted_qos_2
13
-
| `Disconnect_with_will
14
-
| `No_matching_subscribers
15
-
| `No_subscription_existed
16
-
| `Continue_authentication
17
-
| `Re_authenticate
18
-
| `Unspecified_error
19
-
| `Malformed_packet
20
-
| `Protocol_error
21
-
| `Implementation_specific_error
22
-
| `Unsupported_protocol_version
23
-
| `Client_identifier_not_valid
24
-
| `Bad_user_name_or_password
25
-
| `Not_authorized
26
-
| `Server_unavailable
27
-
| `Server_busy
28
-
| `Banned
29
-
| `Server_shutting_down
30
-
| `Bad_authentication_method
31
-
| `Keep_alive_timeout
32
-
| `Session_taken_over
33
-
| `Topic_filter_invalid
34
-
| `Topic_name_invalid
35
-
| `Packet_identifier_in_use
36
-
| `Packet_identifier_not_found
37
-
| `Receive_maximum_exceeded
38
-
| `Topic_alias_invalid
39
-
| `Packet_too_large
40
-
| `Message_rate_too_high
41
-
| `Quota_exceeded
42
-
| `Administrative_action
43
-
| `Payload_format_invalid
44
-
| `Retain_not_supported
45
-
| `Qos_not_supported
46
-
| `Use_another_server
47
-
| `Server_moved
48
-
| `Shared_subscriptions_not_supported
49
-
| `Connection_rate_exceeded
50
-
| `Maximum_connect_time
51
-
| `Subscription_identifiers_not_supported
52
-
| `Wildcard_subscriptions_not_supported
53
-
]
54
-
55
10
module Reason_code = struct
56
-
type t = reason_code
11
+
type t =
12
+
[ `Success
13
+
| `Normal_disconnection
14
+
| `Granted_qos_0
15
+
| `Granted_qos_1
16
+
| `Granted_qos_2
17
+
| `Disconnect_with_will
18
+
| `No_matching_subscribers
19
+
| `No_subscription_existed
20
+
| `Continue_authentication
21
+
| `Re_authenticate
22
+
| `Unspecified_error
23
+
| `Malformed_packet
24
+
| `Protocol_error
25
+
| `Implementation_specific_error
26
+
| `Unsupported_protocol_version
27
+
| `Client_identifier_not_valid
28
+
| `Bad_user_name_or_password
29
+
| `Not_authorized
30
+
| `Server_unavailable
31
+
| `Server_busy
32
+
| `Banned
33
+
| `Server_shutting_down
34
+
| `Bad_authentication_method
35
+
| `Keep_alive_timeout
36
+
| `Session_taken_over
37
+
| `Topic_filter_invalid
38
+
| `Topic_name_invalid
39
+
| `Packet_identifier_in_use
40
+
| `Packet_identifier_not_found
41
+
| `Receive_maximum_exceeded
42
+
| `Topic_alias_invalid
43
+
| `Packet_too_large
44
+
| `Message_rate_too_high
45
+
| `Quota_exceeded
46
+
| `Administrative_action
47
+
| `Payload_format_invalid
48
+
| `Retain_not_supported
49
+
| `Qos_not_supported
50
+
| `Use_another_server
51
+
| `Server_moved
52
+
| `Shared_subscriptions_not_supported
53
+
| `Connection_rate_exceeded
54
+
| `Maximum_connect_time
55
+
| `Subscription_identifiers_not_supported
56
+
| `Wildcard_subscriptions_not_supported ]
57
57
58
58
let to_int = function
59
59
| `Success -> 0x00
···
189
189
| `Qos_not_supported -> "QoS not supported"
190
190
| `Use_another_server -> "Use another server"
191
191
| `Server_moved -> "Server moved"
192
-
| `Shared_subscriptions_not_supported -> "Shared Subscriptions not supported"
192
+
| `Shared_subscriptions_not_supported ->
193
+
"Shared Subscriptions not supported"
193
194
| `Connection_rate_exceeded -> "Connection rate exceeded"
194
195
| `Maximum_connect_time -> "Maximum connect time"
195
-
| `Subscription_identifiers_not_supported -> "Subscription Identifiers not supported"
196
-
| `Wildcard_subscriptions_not_supported -> "Wildcard Subscriptions not supported"
196
+
| `Subscription_identifiers_not_supported ->
197
+
"Subscription Identifiers not supported"
198
+
| `Wildcard_subscriptions_not_supported ->
199
+
"Wildcard Subscriptions not supported"
197
200
198
201
let pp ppf t = Format.fprintf ppf "%s" (to_string t)
199
202
end
···
296
299
let write_property writer prop =
297
300
match prop with
298
301
| Payload_format_indicator v ->
299
-
P.write_variable_length writer (id_to_int `Payload_format_indicator);
300
-
P.write_uint8 writer v
302
+
P.write_variable_length writer (id_to_int `Payload_format_indicator);
303
+
P.write_uint8 writer v
301
304
| Message_expiry_interval v ->
302
-
P.write_variable_length writer (id_to_int `Message_expiry_interval);
303
-
P.write_uint32_be writer v
305
+
P.write_variable_length writer (id_to_int `Message_expiry_interval);
306
+
P.write_uint32_be writer v
304
307
| Content_type v ->
305
-
P.write_variable_length writer (id_to_int `Content_type);
306
-
P.write_mqtt_string writer v
308
+
P.write_variable_length writer (id_to_int `Content_type);
309
+
P.write_mqtt_string writer v
307
310
| Response_topic v ->
308
-
P.write_variable_length writer (id_to_int `Response_topic);
309
-
P.write_mqtt_string writer v
311
+
P.write_variable_length writer (id_to_int `Response_topic);
312
+
P.write_mqtt_string writer v
310
313
| Correlation_data v ->
311
-
P.write_variable_length writer (id_to_int `Correlation_data);
312
-
P.write_mqtt_string writer v
314
+
P.write_variable_length writer (id_to_int `Correlation_data);
315
+
P.write_mqtt_string writer v
313
316
| Subscription_identifier v ->
314
-
P.write_variable_length writer (id_to_int `Subscription_identifier);
315
-
P.write_variable_length writer v
317
+
P.write_variable_length writer (id_to_int `Subscription_identifier);
318
+
P.write_variable_length writer v
316
319
| Session_expiry_interval v ->
317
-
P.write_variable_length writer (id_to_int `Session_expiry_interval);
318
-
P.write_uint32_be writer v
320
+
P.write_variable_length writer (id_to_int `Session_expiry_interval);
321
+
P.write_uint32_be writer v
319
322
| Assigned_client_identifier v ->
320
-
P.write_variable_length writer (id_to_int `Assigned_client_identifier);
321
-
P.write_mqtt_string writer v
323
+
P.write_variable_length writer (id_to_int `Assigned_client_identifier);
324
+
P.write_mqtt_string writer v
322
325
| Server_keep_alive v ->
323
-
P.write_variable_length writer (id_to_int `Server_keep_alive);
324
-
P.write_uint16_be writer v
326
+
P.write_variable_length writer (id_to_int `Server_keep_alive);
327
+
P.write_uint16_be writer v
325
328
| Authentication_method v ->
326
-
P.write_variable_length writer (id_to_int `Authentication_method);
327
-
P.write_mqtt_string writer v
329
+
P.write_variable_length writer (id_to_int `Authentication_method);
330
+
P.write_mqtt_string writer v
328
331
| Authentication_data v ->
329
-
P.write_variable_length writer (id_to_int `Authentication_data);
330
-
P.write_mqtt_string writer v
332
+
P.write_variable_length writer (id_to_int `Authentication_data);
333
+
P.write_mqtt_string writer v
331
334
| Request_problem_information v ->
332
-
P.write_variable_length writer (id_to_int `Request_problem_information);
333
-
P.write_uint8 writer v
335
+
P.write_variable_length writer (id_to_int `Request_problem_information);
336
+
P.write_uint8 writer v
334
337
| Will_delay_interval v ->
335
-
P.write_variable_length writer (id_to_int `Will_delay_interval);
336
-
P.write_uint32_be writer v
338
+
P.write_variable_length writer (id_to_int `Will_delay_interval);
339
+
P.write_uint32_be writer v
337
340
| Request_response_information v ->
338
-
P.write_variable_length writer (id_to_int `Request_response_information);
339
-
P.write_uint8 writer v
341
+
P.write_variable_length writer (id_to_int `Request_response_information);
342
+
P.write_uint8 writer v
340
343
| Response_information v ->
341
-
P.write_variable_length writer (id_to_int `Response_information);
342
-
P.write_mqtt_string writer v
344
+
P.write_variable_length writer (id_to_int `Response_information);
345
+
P.write_mqtt_string writer v
343
346
| Server_reference v ->
344
-
P.write_variable_length writer (id_to_int `Server_reference);
345
-
P.write_mqtt_string writer v
347
+
P.write_variable_length writer (id_to_int `Server_reference);
348
+
P.write_mqtt_string writer v
346
349
| Reason_string v ->
347
-
P.write_variable_length writer (id_to_int `Reason_string);
348
-
P.write_mqtt_string writer v
350
+
P.write_variable_length writer (id_to_int `Reason_string);
351
+
P.write_mqtt_string writer v
349
352
| Receive_maximum v ->
350
-
P.write_variable_length writer (id_to_int `Receive_maximum);
351
-
P.write_uint16_be writer v
353
+
P.write_variable_length writer (id_to_int `Receive_maximum);
354
+
P.write_uint16_be writer v
352
355
| Topic_alias_maximum v ->
353
-
P.write_variable_length writer (id_to_int `Topic_alias_maximum);
354
-
P.write_uint16_be writer v
356
+
P.write_variable_length writer (id_to_int `Topic_alias_maximum);
357
+
P.write_uint16_be writer v
355
358
| Topic_alias v ->
356
-
P.write_variable_length writer (id_to_int `Topic_alias);
357
-
P.write_uint16_be writer v
359
+
P.write_variable_length writer (id_to_int `Topic_alias);
360
+
P.write_uint16_be writer v
358
361
| Maximum_qos v ->
359
-
P.write_variable_length writer (id_to_int `Maximum_qos);
360
-
P.write_uint8 writer (Shared.Qos.to_int v)
362
+
P.write_variable_length writer (id_to_int `Maximum_qos);
363
+
P.write_uint8 writer (Shared.Qos.to_int v)
361
364
| Retain_available v ->
362
-
P.write_variable_length writer (id_to_int `Retain_available);
363
-
P.write_uint8 writer (if v then 1 else 0)
365
+
P.write_variable_length writer (id_to_int `Retain_available);
366
+
P.write_uint8 writer (if v then 1 else 0)
364
367
| User_property (k, v) ->
365
-
P.write_variable_length writer (id_to_int `User_property);
366
-
P.write_mqtt_string writer k;
367
-
P.write_mqtt_string writer v
368
+
P.write_variable_length writer (id_to_int `User_property);
369
+
P.write_mqtt_string writer k;
370
+
P.write_mqtt_string writer v
368
371
| Maximum_packet_size v ->
369
-
P.write_variable_length writer (id_to_int `Maximum_packet_size);
370
-
P.write_uint32_be writer v
372
+
P.write_variable_length writer (id_to_int `Maximum_packet_size);
373
+
P.write_uint32_be writer v
371
374
| Wildcard_subscription_available v ->
372
-
P.write_variable_length writer (id_to_int `Wildcard_subscription_available);
373
-
P.write_uint8 writer (if v then 1 else 0)
375
+
P.write_variable_length writer
376
+
(id_to_int `Wildcard_subscription_available);
377
+
P.write_uint8 writer (if v then 1 else 0)
374
378
| Subscription_identifier_available v ->
375
-
P.write_variable_length writer (id_to_int `Subscription_identifier_available);
376
-
P.write_uint8 writer (if v then 1 else 0)
379
+
P.write_variable_length writer
380
+
(id_to_int `Subscription_identifier_available);
381
+
P.write_uint8 writer (if v then 1 else 0)
377
382
| Shared_subscription_available v ->
378
-
P.write_variable_length writer (id_to_int `Shared_subscription_available);
379
-
P.write_uint8 writer (if v then 1 else 0)
383
+
P.write_variable_length writer
384
+
(id_to_int `Shared_subscription_available);
385
+
P.write_uint8 writer (if v then 1 else 0)
380
386
381
387
let write_properties writer props =
382
-
let props_data = P.to_string (fun w ->
383
-
List.iter (write_property w) props
384
-
) in
388
+
let props_data =
389
+
P.to_string (fun w -> List.iter (write_property w) props)
390
+
in
385
391
P.write_variable_length writer (String.length props_data);
386
392
P.write_string writer props_data
387
393
···
395
401
| `Content_type -> Content_type (P.mqtt_string reader)
396
402
| `Response_topic -> Response_topic (P.mqtt_string reader)
397
403
| `Correlation_data -> Correlation_data (P.mqtt_string reader)
398
-
| `Subscription_identifier -> Subscription_identifier (P.variable_length reader)
404
+
| `Subscription_identifier ->
405
+
Subscription_identifier (P.variable_length reader)
399
406
| `Session_expiry_interval -> Session_expiry_interval (P.uint32_be reader)
400
-
| `Assigned_client_identifier -> Assigned_client_identifier (P.mqtt_string reader)
407
+
| `Assigned_client_identifier ->
408
+
Assigned_client_identifier (P.mqtt_string reader)
401
409
| `Server_keep_alive -> Server_keep_alive (P.uint16_be reader)
402
410
| `Authentication_method -> Authentication_method (P.mqtt_string reader)
403
411
| `Authentication_data -> Authentication_data (P.mqtt_string reader)
404
-
| `Request_problem_information -> Request_problem_information (P.uint8 reader)
412
+
| `Request_problem_information ->
413
+
Request_problem_information (P.uint8 reader)
405
414
| `Will_delay_interval -> Will_delay_interval (P.uint32_be reader)
406
-
| `Request_response_information -> Request_response_information (P.uint8 reader)
415
+
| `Request_response_information ->
416
+
Request_response_information (P.uint8 reader)
407
417
| `Response_information -> Response_information (P.mqtt_string reader)
408
418
| `Server_reference -> Server_reference (P.mqtt_string reader)
409
419
| `Reason_string -> Reason_string (P.mqtt_string reader)
···
413
423
| `Maximum_qos -> Maximum_qos (Shared.Qos.of_int (P.uint8 reader))
414
424
| `Retain_available -> Retain_available (P.uint8 reader <> 0)
415
425
| `User_property ->
416
-
let k = P.mqtt_string reader in
417
-
let v = P.mqtt_string reader in
418
-
User_property (k, v)
426
+
let k = P.mqtt_string reader in
427
+
let v = P.mqtt_string reader in
428
+
User_property (k, v)
419
429
| `Maximum_packet_size -> Maximum_packet_size (P.uint32_be reader)
420
-
| `Wildcard_subscription_available -> Wildcard_subscription_available (P.uint8 reader <> 0)
421
-
| `Subscription_identifier_available -> Subscription_identifier_available (P.uint8 reader <> 0)
422
-
| `Shared_subscription_available -> Shared_subscription_available (P.uint8 reader <> 0)
430
+
| `Wildcard_subscription_available ->
431
+
Wildcard_subscription_available (P.uint8 reader <> 0)
432
+
| `Subscription_identifier_available ->
433
+
Subscription_identifier_available (P.uint8 reader <> 0)
434
+
| `Shared_subscription_available ->
435
+
Shared_subscription_available (P.uint8 reader <> 0)
423
436
424
437
let read_properties reader =
425
438
let props_len = P.variable_length reader in
···
430
443
P.many read_property props_reader
431
444
432
445
let pp ppf = function
433
-
| Payload_format_indicator v -> Format.fprintf ppf "Payload_format_indicator(%d)" v
434
-
| Message_expiry_interval v -> Format.fprintf ppf "Message_expiry_interval(%ld)" v
446
+
| Payload_format_indicator v ->
447
+
Format.fprintf ppf "Payload_format_indicator(%d)" v
448
+
| Message_expiry_interval v ->
449
+
Format.fprintf ppf "Message_expiry_interval(%ld)" v
435
450
| Content_type v -> Format.fprintf ppf "Content_type(%s)" v
436
451
| Response_topic v -> Format.fprintf ppf "Response_topic(%s)" v
437
-
| Correlation_data v -> Format.fprintf ppf "Correlation_data(<%d bytes>)" (String.length v)
438
-
| Subscription_identifier v -> Format.fprintf ppf "Subscription_identifier(%d)" v
439
-
| Session_expiry_interval v -> Format.fprintf ppf "Session_expiry_interval(%ld)" v
440
-
| Assigned_client_identifier v -> Format.fprintf ppf "Assigned_client_identifier(%s)" v
452
+
| Correlation_data v ->
453
+
Format.fprintf ppf "Correlation_data(<%d bytes>)" (String.length v)
454
+
| Subscription_identifier v ->
455
+
Format.fprintf ppf "Subscription_identifier(%d)" v
456
+
| Session_expiry_interval v ->
457
+
Format.fprintf ppf "Session_expiry_interval(%ld)" v
458
+
| Assigned_client_identifier v ->
459
+
Format.fprintf ppf "Assigned_client_identifier(%s)" v
441
460
| Server_keep_alive v -> Format.fprintf ppf "Server_keep_alive(%d)" v
442
-
| Authentication_method v -> Format.fprintf ppf "Authentication_method(%s)" v
443
-
| Authentication_data _ -> Format.fprintf ppf "Authentication_data(<hidden>)"
444
-
| Request_problem_information v -> Format.fprintf ppf "Request_problem_information(%d)" v
461
+
| Authentication_method v ->
462
+
Format.fprintf ppf "Authentication_method(%s)" v
463
+
| Authentication_data _ ->
464
+
Format.fprintf ppf "Authentication_data(<hidden>)"
465
+
| Request_problem_information v ->
466
+
Format.fprintf ppf "Request_problem_information(%d)" v
445
467
| Will_delay_interval v -> Format.fprintf ppf "Will_delay_interval(%ld)" v
446
-
| Request_response_information v -> Format.fprintf ppf "Request_response_information(%d)" v
468
+
| Request_response_information v ->
469
+
Format.fprintf ppf "Request_response_information(%d)" v
447
470
| Response_information v -> Format.fprintf ppf "Response_information(%s)" v
448
471
| Server_reference v -> Format.fprintf ppf "Server_reference(%s)" v
449
472
| Reason_string v -> Format.fprintf ppf "Reason_string(%s)" v
···
454
477
| Retain_available v -> Format.fprintf ppf "Retain_available(%b)" v
455
478
| User_property (k, v) -> Format.fprintf ppf "User_property(%s, %s)" k v
456
479
| Maximum_packet_size v -> Format.fprintf ppf "Maximum_packet_size(%ld)" v
457
-
| Wildcard_subscription_available v -> Format.fprintf ppf "Wildcard_subscription_available(%b)" v
458
-
| Subscription_identifier_available v -> Format.fprintf ppf "Subscription_identifier_available(%b)" v
459
-
| Shared_subscription_available v -> Format.fprintf ppf "Shared_subscription_available(%b)" v
480
+
| Wildcard_subscription_available v ->
481
+
Format.fprintf ppf "Wildcard_subscription_available(%b)" v
482
+
| Subscription_identifier_available v ->
483
+
Format.fprintf ppf "Subscription_identifier_available(%b)" v
484
+
| Shared_subscription_available v ->
485
+
Format.fprintf ppf "Shared_subscription_available(%b)" v
460
486
end
461
487
462
488
(** {1 Subscription Options} *)
···
470
496
}
471
497
472
498
let pp ppf t =
473
-
Format.fprintf ppf "{qos=%a; no_local=%b; retain_as_published=%b; retain_handling=%d}"
499
+
Format.fprintf ppf
500
+
"{qos=%a; no_local=%b; retain_as_published=%b; retain_handling=%d}"
474
501
Shared.Qos.pp t.qos t.no_local t.retain_as_published t.retain_handling
475
502
476
-
let default qos = {
477
-
qos;
478
-
no_local = false;
479
-
retain_as_published = false;
480
-
retain_handling = 0;
481
-
}
503
+
let default qos =
504
+
{ qos; no_local = false; retain_as_published = false; retain_handling = 0 }
482
505
end
483
506
484
507
module Subscription = struct
485
508
type t = { filter : Shared.Topic.Filter.t; options : Subscription_options.t }
486
509
487
510
let pp ppf t =
488
-
Format.fprintf ppf "{filter=%a; options=%a}"
489
-
Shared.Topic.Filter.pp t.filter Subscription_options.pp t.options
511
+
Format.fprintf ppf "{filter=%a; options=%a}" Shared.Topic.Filter.pp t.filter
512
+
Subscription_options.pp t.options
490
513
end
491
514
492
515
module Will_properties = struct
···
531
554
payload : string;
532
555
properties : Property.t list;
533
556
}
534
-
| Puback of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
535
-
| Pubrec of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
536
-
| Pubrel of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
537
-
| Pubcomp of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
538
-
| Subscribe of { packet_id : Shared.Packet_id.t; properties : Property.t list; topics : Subscription.t list }
539
-
| Suback of { packet_id : Shared.Packet_id.t; properties : Property.t list; reason_codes : Reason_code.t list }
540
-
| Unsubscribe of { packet_id : Shared.Packet_id.t; properties : Property.t list; topics : Shared.Topic.Filter.t list }
541
-
| Unsuback of { packet_id : Shared.Packet_id.t; properties : Property.t list; reason_codes : Reason_code.t list }
557
+
| Puback of {
558
+
packet_id : Shared.Packet_id.t;
559
+
reason_code : Reason_code.t;
560
+
properties : Property.t list;
561
+
}
562
+
| Pubrec of {
563
+
packet_id : Shared.Packet_id.t;
564
+
reason_code : Reason_code.t;
565
+
properties : Property.t list;
566
+
}
567
+
| Pubrel of {
568
+
packet_id : Shared.Packet_id.t;
569
+
reason_code : Reason_code.t;
570
+
properties : Property.t list;
571
+
}
572
+
| Pubcomp of {
573
+
packet_id : Shared.Packet_id.t;
574
+
reason_code : Reason_code.t;
575
+
properties : Property.t list;
576
+
}
577
+
| Subscribe of {
578
+
packet_id : Shared.Packet_id.t;
579
+
properties : Property.t list;
580
+
topics : Subscription.t list;
581
+
}
582
+
| Suback of {
583
+
packet_id : Shared.Packet_id.t;
584
+
properties : Property.t list;
585
+
reason_codes : Reason_code.t list;
586
+
}
587
+
| Unsubscribe of {
588
+
packet_id : Shared.Packet_id.t;
589
+
properties : Property.t list;
590
+
topics : Shared.Topic.Filter.t list;
591
+
}
592
+
| Unsuback of {
593
+
packet_id : Shared.Packet_id.t;
594
+
properties : Property.t list;
595
+
reason_codes : Reason_code.t list;
596
+
}
542
597
| Pingreq
543
598
| Pingresp
544
-
| Disconnect of { reason_code : Reason_code.t; properties : Property.t list }
599
+
| Disconnect of {
600
+
reason_code : Reason_code.t;
601
+
properties : Property.t list;
602
+
}
545
603
| Auth of { reason_code : Reason_code.t; properties : Property.t list }
546
604
547
605
let pp ppf = function
548
606
| Connect c ->
549
-
Format.fprintf ppf "Connect{client_id=%s; clean_start=%b; keep_alive=%d}"
550
-
c.client_id c.clean_start c.keep_alive
607
+
Format.fprintf ppf
608
+
"Connect{client_id=%s; clean_start=%b; keep_alive=%d}" c.client_id
609
+
c.clean_start c.keep_alive
551
610
| Connack c ->
552
-
Format.fprintf ppf "Connack{session_present=%b; reason_code=%a}"
553
-
c.session_present Reason_code.pp c.reason_code
611
+
Format.fprintf ppf "Connack{session_present=%b; reason_code=%a}"
612
+
c.session_present Reason_code.pp c.reason_code
554
613
| Publish p ->
555
-
Format.fprintf ppf "Publish{topic=%s; qos=%a; dup=%b; retain=%b; payload=<%d bytes>}"
556
-
p.topic Shared.Qos.pp p.qos p.dup p.retain (String.length p.payload)
557
-
| Puback p -> Format.fprintf ppf "Puback{packet_id=%d; reason_code=%a}" p.packet_id Reason_code.pp p.reason_code
558
-
| Pubrec p -> Format.fprintf ppf "Pubrec{packet_id=%d; reason_code=%a}" p.packet_id Reason_code.pp p.reason_code
559
-
| Pubrel p -> Format.fprintf ppf "Pubrel{packet_id=%d; reason_code=%a}" p.packet_id Reason_code.pp p.reason_code
560
-
| Pubcomp p -> Format.fprintf ppf "Pubcomp{packet_id=%d; reason_code=%a}" p.packet_id Reason_code.pp p.reason_code
614
+
Format.fprintf ppf
615
+
"Publish{topic=%s; qos=%a; dup=%b; retain=%b; payload=<%d bytes>}"
616
+
p.topic Shared.Qos.pp p.qos p.dup p.retain (String.length p.payload)
617
+
| Puback p ->
618
+
Format.fprintf ppf "Puback{packet_id=%d; reason_code=%a}" p.packet_id
619
+
Reason_code.pp p.reason_code
620
+
| Pubrec p ->
621
+
Format.fprintf ppf "Pubrec{packet_id=%d; reason_code=%a}" p.packet_id
622
+
Reason_code.pp p.reason_code
623
+
| Pubrel p ->
624
+
Format.fprintf ppf "Pubrel{packet_id=%d; reason_code=%a}" p.packet_id
625
+
Reason_code.pp p.reason_code
626
+
| Pubcomp p ->
627
+
Format.fprintf ppf "Pubcomp{packet_id=%d; reason_code=%a}" p.packet_id
628
+
Reason_code.pp p.reason_code
561
629
| Subscribe s ->
562
-
Format.fprintf ppf "Subscribe{packet_id=%d; topics=[%a]}"
563
-
s.packet_id
564
-
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") Subscription.pp)
565
-
s.topics
630
+
Format.fprintf ppf "Subscribe{packet_id=%d; topics=[%a]}" s.packet_id
631
+
(Format.pp_print_list
632
+
~pp_sep:(fun ppf () -> Format.fprintf ppf "; ")
633
+
Subscription.pp)
634
+
s.topics
566
635
| Suback s ->
567
-
Format.fprintf ppf "Suback{packet_id=%d; reason_codes=[%a]}"
568
-
s.packet_id
569
-
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") Reason_code.pp)
570
-
s.reason_codes
636
+
Format.fprintf ppf "Suback{packet_id=%d; reason_codes=[%a]}" s.packet_id
637
+
(Format.pp_print_list
638
+
~pp_sep:(fun ppf () -> Format.fprintf ppf "; ")
639
+
Reason_code.pp)
640
+
s.reason_codes
571
641
| Unsubscribe u ->
572
-
Format.fprintf ppf "Unsubscribe{packet_id=%d; topics=[%a]}"
573
-
u.packet_id
574
-
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") Shared.Topic.Filter.pp)
575
-
u.topics
642
+
Format.fprintf ppf "Unsubscribe{packet_id=%d; topics=[%a]}" u.packet_id
643
+
(Format.pp_print_list
644
+
~pp_sep:(fun ppf () -> Format.fprintf ppf "; ")
645
+
Shared.Topic.Filter.pp)
646
+
u.topics
576
647
| Unsuback u ->
577
-
Format.fprintf ppf "Unsuback{packet_id=%d; reason_codes=[%a]}"
578
-
u.packet_id
579
-
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") Reason_code.pp)
580
-
u.reason_codes
648
+
Format.fprintf ppf "Unsuback{packet_id=%d; reason_codes=[%a]}"
649
+
u.packet_id
650
+
(Format.pp_print_list
651
+
~pp_sep:(fun ppf () -> Format.fprintf ppf "; ")
652
+
Reason_code.pp)
653
+
u.reason_codes
581
654
| Pingreq -> Format.fprintf ppf "Pingreq"
582
655
| Pingresp -> Format.fprintf ppf "Pingresp"
583
-
| Disconnect d -> Format.fprintf ppf "Disconnect{reason_code=%a}" Reason_code.pp d.reason_code
584
-
| Auth a -> Format.fprintf ppf "Auth{reason_code=%a}" Reason_code.pp a.reason_code
656
+
| Disconnect d ->
657
+
Format.fprintf ppf "Disconnect{reason_code=%a}" Reason_code.pp
658
+
d.reason_code
659
+
| Auth a ->
660
+
Format.fprintf ppf "Auth{reason_code=%a}" Reason_code.pp a.reason_code
585
661
586
662
(** {1 Encoding} *)
587
663
588
-
let write_fixed_header writer packet_type flags remaining_length =
589
-
let type_byte = (Shared.Packet_type.to_int packet_type lsl 4) lor (flags land 0x0F) in
590
-
P.write_uint8 writer type_byte;
591
-
P.write_variable_length writer remaining_length
592
-
593
-
let write_connect writer ~clean_start ~keep_alive ~client_id ~credentials ~will ~properties =
594
-
let payload = P.to_string (fun w ->
595
-
P.write_mqtt_string w "MQTT";
596
-
P.write_uint8 w 5;
597
-
let flags = ref 0 in
598
-
if clean_start then flags := !flags lor 0x02;
599
-
(match will with
600
-
| Some (will : Will_properties.t) ->
601
-
flags := !flags lor 0x04;
602
-
flags := !flags lor (Shared.Qos.to_int will.will_qos lsl 3);
603
-
if will.will_retain then flags := !flags lor 0x20
604
-
| None -> ());
605
-
(match credentials with
606
-
| Some (`Username _) -> flags := !flags lor 0x80
607
-
| Some (`Username_password _) -> flags := !flags lor 0xC0
608
-
| None -> ());
609
-
P.write_uint8 w !flags;
610
-
P.write_uint16_be w keep_alive;
611
-
Property.write_properties w properties;
612
-
P.write_mqtt_string w client_id;
613
-
(match will with
614
-
| Some (will : Will_properties.t) ->
615
-
Property.write_properties w will.will_properties;
616
-
P.write_mqtt_string w will.will_topic;
617
-
P.write_mqtt_string w will.will_payload
618
-
| None -> ());
619
-
(match credentials with
620
-
| Some (`Username u) ->
621
-
P.write_mqtt_string w u
622
-
| Some (`Username_password (username, password)) ->
623
-
P.write_mqtt_string w username;
624
-
P.write_mqtt_string w password
625
-
| None -> ())
626
-
) in
627
-
write_fixed_header writer `CONNECT 0 (String.length payload);
664
+
let write_connect writer ~clean_start ~keep_alive ~client_id ~credentials
665
+
~will ~properties =
666
+
let payload =
667
+
P.to_string (fun w ->
668
+
P.write_mqtt_string w "MQTT";
669
+
P.write_uint8 w 5;
670
+
let flags = ref 0 in
671
+
if clean_start then flags := !flags lor 0x02;
672
+
(match will with
673
+
| Some (will : Will_properties.t) ->
674
+
flags := !flags lor 0x04;
675
+
flags := !flags lor (Shared.Qos.to_int will.will_qos lsl 3);
676
+
if will.will_retain then flags := !flags lor 0x20
677
+
| None -> ());
678
+
(match credentials with
679
+
| Some (`Username _) -> flags := !flags lor 0x80
680
+
| Some (`Username_password _) -> flags := !flags lor 0xC0
681
+
| None -> ());
682
+
P.write_uint8 w !flags;
683
+
P.write_uint16_be w keep_alive;
684
+
Property.write_properties w properties;
685
+
P.write_mqtt_string w client_id;
686
+
(match will with
687
+
| Some (will : Will_properties.t) ->
688
+
Property.write_properties w will.will_properties;
689
+
P.write_mqtt_string w will.will_topic;
690
+
P.write_mqtt_string w will.will_payload
691
+
| None -> ());
692
+
match credentials with
693
+
| Some (`Username u) -> P.write_mqtt_string w u
694
+
| Some (`Username_password (username, password)) ->
695
+
P.write_mqtt_string w username;
696
+
P.write_mqtt_string w password
697
+
| None -> ())
698
+
in
699
+
P.write_fixed_header writer `CONNECT 0 (String.length payload);
628
700
P.write_string writer payload
629
701
630
702
let write_connack writer ~session_present ~reason_code ~properties =
631
-
let payload = P.to_string (fun w ->
632
-
P.write_uint8 w (if session_present then 0x01 else 0x00);
633
-
P.write_uint8 w (Reason_code.to_int reason_code);
634
-
Property.write_properties w properties
635
-
) in
636
-
write_fixed_header writer `CONNACK 0 (String.length payload);
703
+
let payload =
704
+
P.to_string (fun w ->
705
+
P.write_uint8 w (if session_present then 0x01 else 0x00);
706
+
P.write_uint8 w (Reason_code.to_int reason_code);
707
+
Property.write_properties w properties)
708
+
in
709
+
P.write_fixed_header writer `CONNACK 0 (String.length payload);
637
710
P.write_string writer payload
638
711
639
-
let write_publish writer ~dup ~qos ~retain ~topic ~packet_id ~payload:msg ~properties =
640
-
let body = P.to_string (fun w ->
641
-
P.write_mqtt_string w topic;
642
-
(match packet_id with
643
-
| Some id when qos <> `At_most_once ->
644
-
P.write_uint16_be w id
645
-
| _ -> ());
646
-
Property.write_properties w properties;
647
-
P.write_string w msg
648
-
) in
712
+
let write_publish writer ~dup ~qos ~retain ~topic ~packet_id ~payload:msg
713
+
~properties =
714
+
let body =
715
+
P.to_string (fun w ->
716
+
P.write_mqtt_string w topic;
717
+
(match packet_id with
718
+
| Some id when qos <> `At_most_once -> P.write_uint16_be w id
719
+
| _ -> ());
720
+
Property.write_properties w properties;
721
+
P.write_string w msg)
722
+
in
649
723
let flags =
650
-
(if dup then 0x08 else 0) lor
651
-
(Shared.Qos.to_int qos lsl 1) lor
652
-
(if retain then 0x01 else 0)
724
+
(if dup then 0x08 else 0)
725
+
lor (Shared.Qos.to_int qos lsl 1)
726
+
lor if retain then 0x01 else 0
653
727
in
654
-
write_fixed_header writer `PUBLISH flags (String.length body);
728
+
P.write_fixed_header writer `PUBLISH flags (String.length body);
655
729
P.write_string writer body
656
730
657
731
let write_pubx_payload ~packet_id ~reason_code ~properties =
658
732
P.to_string (fun w ->
659
-
P.write_uint16_be w packet_id;
660
-
if reason_code <> `Success || properties <> [] then begin
661
-
P.write_uint8 w (Reason_code.to_int reason_code);
662
-
if properties <> [] then
663
-
Property.write_properties w properties
664
-
end
665
-
)
733
+
P.write_uint16_be w packet_id;
734
+
if reason_code <> `Success || properties <> [] then begin
735
+
P.write_uint8 w (Reason_code.to_int reason_code);
736
+
if properties <> [] then Property.write_properties w properties
737
+
end)
666
738
667
739
let write_puback writer ~packet_id ~reason_code ~properties =
668
740
let payload = write_pubx_payload ~packet_id ~reason_code ~properties in
669
-
write_fixed_header writer `PUBACK 0 (String.length payload);
741
+
P.write_fixed_header writer `PUBACK 0 (String.length payload);
670
742
P.write_string writer payload
671
743
672
744
let write_pubrec writer ~packet_id ~reason_code ~properties =
673
745
let payload = write_pubx_payload ~packet_id ~reason_code ~properties in
674
-
write_fixed_header writer `PUBREC 0 (String.length payload);
746
+
P.write_fixed_header writer `PUBREC 0 (String.length payload);
675
747
P.write_string writer payload
676
748
677
749
let write_pubrel writer ~packet_id ~reason_code ~properties =
678
750
let payload = write_pubx_payload ~packet_id ~reason_code ~properties in
679
-
write_fixed_header writer `PUBREL 0x02 (String.length payload);
751
+
P.write_fixed_header writer `PUBREL 0x02 (String.length payload);
680
752
P.write_string writer payload
681
753
682
754
let write_pubcomp writer ~packet_id ~reason_code ~properties =
683
755
let payload = write_pubx_payload ~packet_id ~reason_code ~properties in
684
-
write_fixed_header writer `PUBCOMP 0 (String.length payload);
756
+
P.write_fixed_header writer `PUBCOMP 0 (String.length payload);
685
757
P.write_string writer payload
686
758
687
759
let write_subscribe writer ~packet_id ~properties ~topics =
688
-
let payload = P.to_string (fun w ->
689
-
P.write_uint16_be w packet_id;
690
-
Property.write_properties w properties;
691
-
List.iter (fun (t : Subscription.t) ->
692
-
P.write_mqtt_string w t.filter;
693
-
let opts =
694
-
(Shared.Qos.to_int t.options.qos) lor
695
-
(if t.options.no_local then 0x04 else 0) lor
696
-
(if t.options.retain_as_published then 0x08 else 0) lor
697
-
(t.options.retain_handling lsl 4)
698
-
in
699
-
P.write_uint8 w opts
700
-
) topics
701
-
) in
702
-
write_fixed_header writer `SUBSCRIBE 0x02 (String.length payload);
760
+
let payload =
761
+
P.to_string (fun w ->
762
+
P.write_uint16_be w packet_id;
763
+
Property.write_properties w properties;
764
+
List.iter
765
+
(fun (t : Subscription.t) ->
766
+
P.write_mqtt_string w t.filter;
767
+
let opts =
768
+
Shared.Qos.to_int t.options.qos
769
+
lor (if t.options.no_local then 0x04 else 0)
770
+
lor (if t.options.retain_as_published then 0x08 else 0)
771
+
lor (t.options.retain_handling lsl 4)
772
+
in
773
+
P.write_uint8 w opts)
774
+
topics)
775
+
in
776
+
P.write_fixed_header writer `SUBSCRIBE 0x02 (String.length payload);
703
777
P.write_string writer payload
704
778
705
779
let write_suback writer ~packet_id ~properties ~reason_codes =
706
-
let payload = P.to_string (fun w ->
707
-
P.write_uint16_be w packet_id;
708
-
Property.write_properties w properties;
709
-
List.iter (fun rc ->
710
-
P.write_uint8 w (Reason_code.to_int rc)
711
-
) reason_codes
712
-
) in
713
-
write_fixed_header writer `SUBACK 0 (String.length payload);
780
+
let payload =
781
+
P.to_string (fun w ->
782
+
P.write_uint16_be w packet_id;
783
+
Property.write_properties w properties;
784
+
List.iter
785
+
(fun rc -> P.write_uint8 w (Reason_code.to_int rc))
786
+
reason_codes)
787
+
in
788
+
P.write_fixed_header writer `SUBACK 0 (String.length payload);
714
789
P.write_string writer payload
715
790
716
791
let write_unsubscribe writer ~packet_id ~properties ~topics =
717
-
let payload = P.to_string (fun w ->
718
-
P.write_uint16_be w packet_id;
719
-
Property.write_properties w properties;
720
-
List.iter (fun topic ->
721
-
P.write_mqtt_string w topic
722
-
) topics
723
-
) in
724
-
write_fixed_header writer `UNSUBSCRIBE 0x02 (String.length payload);
792
+
let payload =
793
+
P.to_string (fun w ->
794
+
P.write_uint16_be w packet_id;
795
+
Property.write_properties w properties;
796
+
List.iter (fun topic -> P.write_mqtt_string w topic) topics)
797
+
in
798
+
P.write_fixed_header writer `UNSUBSCRIBE 0x02 (String.length payload);
725
799
P.write_string writer payload
726
800
727
801
let write_unsuback writer ~packet_id ~properties ~reason_codes =
728
-
let payload = P.to_string (fun w ->
729
-
P.write_uint16_be w packet_id;
730
-
Property.write_properties w properties;
731
-
List.iter (fun rc ->
732
-
P.write_uint8 w (Reason_code.to_int rc)
733
-
) reason_codes
734
-
) in
735
-
write_fixed_header writer `UNSUBACK 0 (String.length payload);
802
+
let payload =
803
+
P.to_string (fun w ->
804
+
P.write_uint16_be w packet_id;
805
+
Property.write_properties w properties;
806
+
List.iter
807
+
(fun rc -> P.write_uint8 w (Reason_code.to_int rc))
808
+
reason_codes)
809
+
in
810
+
P.write_fixed_header writer `UNSUBACK 0 (String.length payload);
736
811
P.write_string writer payload
737
812
738
-
let write_pingreq writer =
739
-
write_fixed_header writer `PINGREQ 0 0
740
-
741
-
let write_pingresp writer =
742
-
write_fixed_header writer `PINGRESP 0 0
813
+
let write_pingreq writer = P.write_fixed_header writer `PINGREQ 0 0
814
+
let write_pingresp writer = P.write_fixed_header writer `PINGRESP 0 0
743
815
744
816
let write_disconnect writer ~reason_code ~properties =
745
-
let payload = P.to_string (fun w ->
746
-
if reason_code <> `Normal_disconnection || properties <> [] then begin
747
-
P.write_uint8 w (Reason_code.to_int reason_code);
748
-
if properties <> [] then
749
-
Property.write_properties w properties
750
-
end
751
-
) in
752
-
write_fixed_header writer `DISCONNECT 0 (String.length payload);
817
+
let payload =
818
+
P.to_string (fun w ->
819
+
if reason_code <> `Normal_disconnection || properties <> [] then begin
820
+
P.write_uint8 w (Reason_code.to_int reason_code);
821
+
if properties <> [] then Property.write_properties w properties
822
+
end)
823
+
in
824
+
P.write_fixed_header writer `DISCONNECT 0 (String.length payload);
753
825
P.write_string writer payload
754
826
755
827
let write_auth writer ~reason_code ~properties =
756
-
let payload = P.to_string (fun w ->
757
-
P.write_uint8 w (Reason_code.to_int reason_code);
758
-
Property.write_properties w properties
759
-
) in
760
-
write_fixed_header writer `AUTH 0 (String.length payload);
828
+
let payload =
829
+
P.to_string (fun w ->
830
+
P.write_uint8 w (Reason_code.to_int reason_code);
831
+
Property.write_properties w properties)
832
+
in
833
+
P.write_fixed_header writer `AUTH 0 (String.length payload);
761
834
P.write_string writer payload
762
835
763
836
let write writer = function
764
-
| Connect { clean_start; keep_alive; client_id; credentials; will; properties } ->
765
-
write_connect writer ~clean_start ~keep_alive ~client_id ~credentials ~will ~properties
837
+
| Connect
838
+
{ clean_start; keep_alive; client_id; credentials; will; properties } ->
839
+
write_connect writer ~clean_start ~keep_alive ~client_id ~credentials
840
+
~will ~properties
766
841
| Connack { session_present; reason_code; properties } ->
767
-
write_connack writer ~session_present ~reason_code ~properties
842
+
write_connack writer ~session_present ~reason_code ~properties
768
843
| Publish { dup; qos; retain; topic; packet_id; payload; properties } ->
769
-
write_publish writer ~dup ~qos ~retain ~topic ~packet_id ~payload ~properties
844
+
write_publish writer ~dup ~qos ~retain ~topic ~packet_id ~payload
845
+
~properties
770
846
| Puback { packet_id; reason_code; properties } ->
771
-
write_puback writer ~packet_id ~reason_code ~properties
847
+
write_puback writer ~packet_id ~reason_code ~properties
772
848
| Pubrec { packet_id; reason_code; properties } ->
773
-
write_pubrec writer ~packet_id ~reason_code ~properties
849
+
write_pubrec writer ~packet_id ~reason_code ~properties
774
850
| Pubrel { packet_id; reason_code; properties } ->
775
-
write_pubrel writer ~packet_id ~reason_code ~properties
851
+
write_pubrel writer ~packet_id ~reason_code ~properties
776
852
| Pubcomp { packet_id; reason_code; properties } ->
777
-
write_pubcomp writer ~packet_id ~reason_code ~properties
853
+
write_pubcomp writer ~packet_id ~reason_code ~properties
778
854
| Subscribe { packet_id; properties; topics } ->
779
-
write_subscribe writer ~packet_id ~properties ~topics
855
+
write_subscribe writer ~packet_id ~properties ~topics
780
856
| Suback { packet_id; properties; reason_codes } ->
781
-
write_suback writer ~packet_id ~properties ~reason_codes
857
+
write_suback writer ~packet_id ~properties ~reason_codes
782
858
| Unsubscribe { packet_id; properties; topics } ->
783
-
write_unsubscribe writer ~packet_id ~properties ~topics
859
+
write_unsubscribe writer ~packet_id ~properties ~topics
784
860
| Unsuback { packet_id; properties; reason_codes } ->
785
-
write_unsuback writer ~packet_id ~properties ~reason_codes
861
+
write_unsuback writer ~packet_id ~properties ~reason_codes
786
862
| Pingreq -> write_pingreq writer
787
863
| Pingresp -> write_pingresp writer
788
864
| Disconnect { reason_code; properties } ->
789
-
write_disconnect writer ~reason_code ~properties
865
+
write_disconnect writer ~reason_code ~properties
790
866
| Auth { reason_code; properties } ->
791
-
write_auth writer ~reason_code ~properties
867
+
write_auth writer ~reason_code ~properties
792
868
793
869
(** {1 Decoding} *)
794
870
···
812
888
let will_properties = Property.read_properties reader in
813
889
let will_topic = P.mqtt_string reader in
814
890
let will_payload = P.mqtt_string reader in
815
-
Some Will_properties.{ will_properties; will_topic; will_payload; will_qos; will_retain }
891
+
Some
892
+
Will_properties.
893
+
{ will_properties; will_topic; will_payload; will_qos; will_retain }
816
894
else None
817
895
in
818
896
let credentials =
···
824
902
else Some (`Username username)
825
903
else None
826
904
in
827
-
Connect { clean_start; keep_alive; client_id; credentials; will; properties }
905
+
Connect
906
+
{ clean_start; keep_alive; client_id; credentials; will; properties }
828
907
829
908
let read_connack ~remaining_length reader =
830
909
let flags = P.uint8 reader in
···
832
911
let reason_code_byte = P.uint8 reader in
833
912
let reason_code = Reason_code.of_int reason_code_byte in
834
913
let properties =
835
-
if remaining_length > 2 then Property.read_properties reader
836
-
else []
914
+
if remaining_length > 2 then Property.read_properties reader else []
837
915
in
838
916
Connack { session_present; reason_code; properties }
839
917
···
843
921
let retain = flags land 0x01 <> 0 in
844
922
let topic = P.mqtt_string reader in
845
923
let packet_id =
846
-
if qos <> `At_most_once then
847
-
Some (P.uint16_be reader)
848
-
else None
924
+
if qos <> `At_most_once then Some (P.uint16_be reader) else None
849
925
in
850
926
let properties = Property.read_properties reader in
851
927
let payload = P.take_rest reader in
···
853
929
854
930
let read_pubx_common ~remaining_length reader =
855
931
let packet_id = P.uint16_be reader in
856
-
if remaining_length = 2 then
857
-
(packet_id, `Success, [])
932
+
if remaining_length = 2 then (packet_id, `Success, [])
858
933
else
859
934
let reason_code_byte = P.uint8 reader in
860
935
let reason_code = Reason_code.of_int reason_code_byte in
861
936
let properties =
862
-
if remaining_length > 3 then Property.read_properties reader
863
-
else []
937
+
if remaining_length > 3 then Property.read_properties reader else []
864
938
in
865
939
(packet_id, reason_code, properties)
866
940
867
941
let read_puback ~remaining_length reader =
868
-
let packet_id, reason_code, properties = read_pubx_common ~remaining_length reader in
942
+
let packet_id, reason_code, properties =
943
+
read_pubx_common ~remaining_length reader
944
+
in
869
945
Puback { packet_id; reason_code; properties }
870
946
871
947
let read_pubrec ~remaining_length reader =
872
-
let packet_id, reason_code, properties = read_pubx_common ~remaining_length reader in
948
+
let packet_id, reason_code, properties =
949
+
read_pubx_common ~remaining_length reader
950
+
in
873
951
Pubrec { packet_id; reason_code; properties }
874
952
875
953
let read_pubrel ~remaining_length reader =
876
-
let packet_id, reason_code, properties = read_pubx_common ~remaining_length reader in
954
+
let packet_id, reason_code, properties =
955
+
read_pubx_common ~remaining_length reader
956
+
in
877
957
Pubrel { packet_id; reason_code; properties }
878
958
879
959
let read_pubcomp ~remaining_length reader =
880
-
let packet_id, reason_code, properties = read_pubx_common ~remaining_length reader in
960
+
let packet_id, reason_code, properties =
961
+
read_pubx_common ~remaining_length reader
962
+
in
881
963
Pubcomp { packet_id; reason_code; properties }
882
964
883
965
let read_subscribe reader =
···
886
968
let read_topic reader =
887
969
let filter = P.mqtt_string reader in
888
970
let opts_byte = P.uint8 reader in
889
-
let options = Subscription_options.{
890
-
qos = Shared.Qos.of_int (opts_byte land 0x03);
891
-
no_local = opts_byte land 0x04 <> 0;
892
-
retain_as_published = opts_byte land 0x08 <> 0;
893
-
retain_handling = (opts_byte land 0x30) lsr 4;
894
-
} in
971
+
let options =
972
+
Subscription_options.
973
+
{
974
+
qos = Shared.Qos.of_int (opts_byte land 0x03);
975
+
no_local = opts_byte land 0x04 <> 0;
976
+
retain_as_published = opts_byte land 0x08 <> 0;
977
+
retain_handling = (opts_byte land 0x30) lsr 4;
978
+
}
979
+
in
895
980
Subscription.{ filter; options }
896
981
in
897
982
let topics = P.many1 read_topic reader in
···
924
1009
let reason_code_byte = P.uint8 reader in
925
1010
let reason_code = Reason_code.of_int reason_code_byte in
926
1011
let properties =
927
-
if remaining_length > 1 then Property.read_properties reader
928
-
else []
1012
+
if remaining_length > 1 then Property.read_properties reader else []
929
1013
in
930
1014
Disconnect { reason_code; properties }
931
1015
+105
-32
lib/core/v5.mli
+105
-32
lib/core/v5.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT v5.0 Protocol Implementation
2
7
3
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html> OASIS Standard *)
8
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html>
9
+
OASIS Standard *)
4
10
5
11
(** {1 Reason Codes}
6
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901031> Section 2.4 *)
12
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901031>
13
+
Section 2.4 *)
7
14
8
15
module Reason_code : sig
9
-
type t = [
10
-
| `Success | `Normal_disconnection | `Granted_qos_0 | `Granted_qos_1
11
-
| `Granted_qos_2 | `Disconnect_with_will | `No_matching_subscribers
12
-
| `No_subscription_existed | `Continue_authentication | `Re_authenticate
13
-
| `Unspecified_error | `Malformed_packet | `Protocol_error
14
-
| `Implementation_specific_error | `Unsupported_protocol_version
15
-
| `Client_identifier_not_valid | `Bad_user_name_or_password
16
-
| `Not_authorized | `Server_unavailable | `Server_busy | `Banned
17
-
| `Server_shutting_down | `Bad_authentication_method | `Keep_alive_timeout
18
-
| `Session_taken_over | `Topic_filter_invalid | `Topic_name_invalid
19
-
| `Packet_identifier_in_use | `Packet_identifier_not_found
20
-
| `Receive_maximum_exceeded | `Topic_alias_invalid | `Packet_too_large
21
-
| `Message_rate_too_high | `Quota_exceeded | `Administrative_action
22
-
| `Payload_format_invalid | `Retain_not_supported | `Qos_not_supported
23
-
| `Use_another_server | `Server_moved | `Shared_subscriptions_not_supported
24
-
| `Connection_rate_exceeded | `Maximum_connect_time
25
-
| `Subscription_identifiers_not_supported | `Wildcard_subscriptions_not_supported
26
-
]
16
+
type t =
17
+
[ `Success
18
+
| `Normal_disconnection
19
+
| `Granted_qos_0
20
+
| `Granted_qos_1
21
+
| `Granted_qos_2
22
+
| `Disconnect_with_will
23
+
| `No_matching_subscribers
24
+
| `No_subscription_existed
25
+
| `Continue_authentication
26
+
| `Re_authenticate
27
+
| `Unspecified_error
28
+
| `Malformed_packet
29
+
| `Protocol_error
30
+
| `Implementation_specific_error
31
+
| `Unsupported_protocol_version
32
+
| `Client_identifier_not_valid
33
+
| `Bad_user_name_or_password
34
+
| `Not_authorized
35
+
| `Server_unavailable
36
+
| `Server_busy
37
+
| `Banned
38
+
| `Server_shutting_down
39
+
| `Bad_authentication_method
40
+
| `Keep_alive_timeout
41
+
| `Session_taken_over
42
+
| `Topic_filter_invalid
43
+
| `Topic_name_invalid
44
+
| `Packet_identifier_in_use
45
+
| `Packet_identifier_not_found
46
+
| `Receive_maximum_exceeded
47
+
| `Topic_alias_invalid
48
+
| `Packet_too_large
49
+
| `Message_rate_too_high
50
+
| `Quota_exceeded
51
+
| `Administrative_action
52
+
| `Payload_format_invalid
53
+
| `Retain_not_supported
54
+
| `Qos_not_supported
55
+
| `Use_another_server
56
+
| `Server_moved
57
+
| `Shared_subscriptions_not_supported
58
+
| `Connection_rate_exceeded
59
+
| `Maximum_connect_time
60
+
| `Subscription_identifiers_not_supported
61
+
| `Wildcard_subscriptions_not_supported ]
27
62
28
63
val pp : Format.formatter -> t -> unit
29
64
val to_int : t -> int
···
32
67
end
33
68
34
69
(** {1 Properties}
35
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901027> Section 2.2.2 *)
70
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901027>
71
+
Section 2.2.2 *)
36
72
37
73
module Property : sig
38
74
type t =
···
68
104
end
69
105
70
106
(** {1 Subscription Options}
71
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901169> Section 3.8.3.1 *)
107
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901169>
108
+
Section 3.8.3.1 *)
72
109
73
110
module Subscription_options : sig
74
111
type t = {
···
105
142
end
106
143
107
144
(** {1 Packets}
108
-
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901019> Section 2.1 *)
145
+
@see <https://docs.oasis-open.org/mqtt/mqtt/v5.0/os/mqtt-v5.0-os.html#_Toc3901019>
146
+
Section 2.1 *)
109
147
110
148
module Packet : sig
111
149
type t =
···
131
169
payload : string;
132
170
properties : Property.t list;
133
171
}
134
-
| Puback of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
135
-
| Pubrec of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
136
-
| Pubrel of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
137
-
| Pubcomp of { packet_id : Shared.Packet_id.t; reason_code : Reason_code.t; properties : Property.t list }
138
-
| Subscribe of { packet_id : Shared.Packet_id.t; properties : Property.t list; topics : Subscription.t list }
139
-
| Suback of { packet_id : Shared.Packet_id.t; properties : Property.t list; reason_codes : Reason_code.t list }
140
-
| Unsubscribe of { packet_id : Shared.Packet_id.t; properties : Property.t list; topics : Shared.Topic.Filter.t list }
141
-
| Unsuback of { packet_id : Shared.Packet_id.t; properties : Property.t list; reason_codes : Reason_code.t list }
172
+
| Puback of {
173
+
packet_id : Shared.Packet_id.t;
174
+
reason_code : Reason_code.t;
175
+
properties : Property.t list;
176
+
}
177
+
| Pubrec of {
178
+
packet_id : Shared.Packet_id.t;
179
+
reason_code : Reason_code.t;
180
+
properties : Property.t list;
181
+
}
182
+
| Pubrel of {
183
+
packet_id : Shared.Packet_id.t;
184
+
reason_code : Reason_code.t;
185
+
properties : Property.t list;
186
+
}
187
+
| Pubcomp of {
188
+
packet_id : Shared.Packet_id.t;
189
+
reason_code : Reason_code.t;
190
+
properties : Property.t list;
191
+
}
192
+
| Subscribe of {
193
+
packet_id : Shared.Packet_id.t;
194
+
properties : Property.t list;
195
+
topics : Subscription.t list;
196
+
}
197
+
| Suback of {
198
+
packet_id : Shared.Packet_id.t;
199
+
properties : Property.t list;
200
+
reason_codes : Reason_code.t list;
201
+
}
202
+
| Unsubscribe of {
203
+
packet_id : Shared.Packet_id.t;
204
+
properties : Property.t list;
205
+
topics : Shared.Topic.Filter.t list;
206
+
}
207
+
| Unsuback of {
208
+
packet_id : Shared.Packet_id.t;
209
+
properties : Property.t list;
210
+
reason_codes : Reason_code.t list;
211
+
}
142
212
| Pingreq
143
213
| Pingresp
144
-
| Disconnect of { reason_code : Reason_code.t; properties : Property.t list }
214
+
| Disconnect of {
215
+
reason_code : Reason_code.t;
216
+
properties : Property.t list;
217
+
}
145
218
| Auth of { reason_code : Reason_code.t; properties : Property.t list }
146
219
147
220
val pp : Format.formatter -> t -> unit
+308
-275
lib/eio/client.ml
+308
-275
lib/eio/client.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** High-level MQTT Client API *)
2
7
3
8
let src = Logs.Src.create "mqtt.client" ~doc:"MQTT Client"
9
+
4
10
module Log = (val Logs.src_log src : Logs.LOG)
5
11
6
12
(** Error types for MQTT client operations *)
···
12
18
type Eio.Exn.err += E of err
13
19
14
20
let pp_err fmt = function
15
-
| Connection_refused reason -> Format.fprintf fmt "Connection refused: %s" reason
21
+
| Connection_refused reason ->
22
+
Format.fprintf fmt "Connection refused: %s" reason
16
23
| Protocol_error msg -> Format.fprintf fmt "Protocol error: %s" msg
17
24
| Not_connected -> Format.fprintf fmt "Not connected"
18
25
19
-
let () = Eio.Exn.register_pp (fun fmt -> function
20
-
| E e -> pp_err fmt e; true
21
-
| _ -> false)
26
+
let () =
27
+
Eio.Exn.register_pp (fun fmt -> function
28
+
| E e ->
29
+
pp_err fmt e;
30
+
true
31
+
| _ -> false)
22
32
23
33
let err e = Eio.Exn.create (E e)
24
34
25
35
type config = {
26
36
client_id : string;
27
-
version : Mqtt.Protocol_version.t;
37
+
version : Mqtte.Protocol_version.t;
28
38
clean_session : bool;
29
39
keep_alive : int;
30
-
credentials : Mqtt.Credentials.t option;
31
-
will : Mqtt.Will.t option;
40
+
credentials : Mqtte.Credentials.t option;
41
+
will : Mqtte.Will.t option;
32
42
}
33
43
34
-
let default_config ?(client_id = "") () = {
35
-
client_id = if client_id = "" then
36
-
Printf.sprintf "mqtt-eio-%d" (Random.int 100000)
37
-
else
38
-
client_id;
39
-
version = `V3_1_1;
40
-
clean_session = true;
41
-
keep_alive = 60;
42
-
credentials = None;
43
-
will = None;
44
-
}
44
+
let default_config ?(client_id = "") () =
45
+
{
46
+
client_id =
47
+
(if client_id = "" then Printf.sprintf "mqtt-eio-%d" (Random.int 100000)
48
+
else client_id);
49
+
version = `V3_1_1;
50
+
clean_session = true;
51
+
keep_alive = 60;
52
+
credentials = None;
53
+
will = None;
54
+
}
45
55
46
56
type message = {
47
-
topic : Mqtt.Topic.Name.t;
57
+
topic : Mqtte.Topic.Name.t;
48
58
payload : string;
49
-
qos : Mqtt.Qos.t;
59
+
qos : Mqtte.Qos.t;
50
60
retain : bool;
51
61
}
52
62
···
56
66
| Message of message
57
67
| Error of exn
58
68
59
-
type pending_ack = {
60
-
resolver : unit Eio.Promise.u;
61
-
mutable completed : bool;
62
-
}
69
+
type pending_ack = { resolver : unit Eio.Promise.u; mutable completed : bool }
63
70
64
71
type t = {
65
72
config : config;
···
67
74
close_flow : unit -> unit;
68
75
session : Protocol.session;
69
76
outbox : Transport.packet Eio.Stream.t;
70
-
pending_acks : (Mqtt.Packet_id.t, pending_ack) Hashtbl.t;
71
-
pending_subacks : (Mqtt.Packet_id.t, unit Eio.Promise.u) Hashtbl.t;
77
+
pending_acks : (Mqtte.Packet_id.t, pending_ack) Hashtbl.t;
78
+
pending_subacks : (Mqtte.Packet_id.t, unit Eio.Promise.u) Hashtbl.t;
72
79
mutable on_message : message -> unit;
73
80
mutable on_disconnect : unit -> unit;
74
81
mutable connected : bool;
···
77
84
}
78
85
79
86
let session t = t.session
80
-
81
87
let is_connected t = t.connected
82
-
83
-
let send_packet t packet =
84
-
Eio.Stream.add t.outbox packet
88
+
let send_packet t packet = Eio.Stream.add t.outbox packet
85
89
86
90
let complete_pending_ack t id =
87
-
Option.iter (fun pending ->
88
-
pending.completed <- true;
89
-
Eio.Promise.resolve pending.resolver ();
90
-
Hashtbl.remove t.pending_acks id;
91
-
Protocol.Packet_id.release t.session.packet_ids id
92
-
) (Hashtbl.find_opt t.pending_acks id)
91
+
Option.iter
92
+
(fun pending ->
93
+
pending.completed <- true;
94
+
Eio.Promise.resolve pending.resolver ();
95
+
Hashtbl.remove t.pending_acks id;
96
+
Protocol.Packet_id.release t.session.packet_ids id)
97
+
(Hashtbl.find_opt t.pending_acks id)
93
98
94
99
let make_publish ~version ~dup ~qos ~retain ~topic ~packet_id ~payload =
95
100
match version with
96
101
| `V3_1_1 ->
97
-
Transport.V3 (Mqtt.V3.Packet.Publish { dup; qos; retain; topic; packet_id; payload })
102
+
Transport.V3
103
+
(Mqtte.V3.Packet.Publish { dup; qos; retain; topic; packet_id; payload })
98
104
| `V5_0 ->
99
-
Transport.V5 (Mqtt.V5.Packet.Publish { dup; qos; retain; topic; packet_id; properties = []; payload })
105
+
Transport.V5
106
+
(Mqtte.V5.Packet.Publish
107
+
{ dup; qos; retain; topic; packet_id; properties = []; payload })
100
108
101
109
let handle_incoming_packet t packet =
102
110
match packet with
103
111
| Transport.V3 pkt -> begin
104
112
match pkt with
105
-
| Mqtt.V3.Packet.Publish p ->
106
-
let msg = {
107
-
topic = p.topic;
108
-
payload = p.payload;
109
-
qos = p.qos;
110
-
retain = p.retain;
111
-
} in
112
-
(match p.qos, p.packet_id with
113
-
| `At_least_once, Some id ->
114
-
send_packet t (Transport.V3 (Mqtt.V3.Packet.Puback id))
115
-
| `Exactly_once, Some id ->
116
-
send_packet t (Transport.V3 (Mqtt.V3.Packet.Pubrec id));
117
-
let state = Protocol.Qos2_receiver.create id in
118
-
Protocol.Inflight.add t.session.qos2_recv_inflight id state
119
-
| _ -> ());
120
-
t.on_message msg
121
-
122
-
| Mqtt.V3.Packet.Puback id ->
123
-
Log.debug (fun m -> m "Received PUBACK for %d" id);
124
-
complete_pending_ack t id
125
-
126
-
| Mqtt.V3.Packet.Pubrec id ->
127
-
Log.debug (fun m -> m "Received PUBREC for %d" id);
128
-
send_packet t (Transport.V3 (Mqtt.V3.Packet.Pubrel id))
129
-
130
-
| Mqtt.V3.Packet.Pubrel id ->
131
-
Log.debug (fun m -> m "Received PUBREL for %d" id);
132
-
send_packet t (Transport.V3 (Mqtt.V3.Packet.Pubcomp id));
133
-
Protocol.Inflight.remove t.session.qos2_recv_inflight id |> ignore
134
-
135
-
| Mqtt.V3.Packet.Pubcomp id ->
136
-
Log.debug (fun m -> m "Received PUBCOMP for %d" id);
137
-
complete_pending_ack t id
138
-
139
-
| Mqtt.V3.Packet.Suback s ->
140
-
Log.debug (fun m -> m "Received SUBACK for %d" s.packet_id);
141
-
Option.iter (fun resolver ->
142
-
Eio.Promise.resolve resolver ();
143
-
Hashtbl.remove t.pending_subacks s.packet_id;
144
-
Protocol.Packet_id.release t.session.packet_ids s.packet_id
145
-
) (Hashtbl.find_opt t.pending_subacks s.packet_id)
146
-
147
-
| Mqtt.V3.Packet.Unsuback id ->
148
-
Log.debug (fun m -> m "Received UNSUBACK for %d" id);
149
-
Protocol.Packet_id.release t.session.packet_ids id
150
-
151
-
| Mqtt.V3.Packet.Pingresp ->
152
-
Log.debug (fun m -> m "Received PINGRESP")
153
-
154
-
| Mqtt.V3.Packet.Disconnect ->
155
-
Log.info (fun m -> m "Received DISCONNECT from server");
156
-
t.connected <- false;
157
-
t.should_stop <- true
158
-
159
-
| _ ->
160
-
Log.warn (fun m -> m "Unexpected packet type")
113
+
| Mqtte.V3.Packet.Publish p ->
114
+
let msg =
115
+
{
116
+
topic = p.topic;
117
+
payload = p.payload;
118
+
qos = p.qos;
119
+
retain = p.retain;
120
+
}
121
+
in
122
+
(match (p.qos, p.packet_id) with
123
+
| `At_least_once, Some id ->
124
+
send_packet t (Transport.V3 (Mqtte.V3.Packet.Puback id))
125
+
| `Exactly_once, Some id ->
126
+
send_packet t (Transport.V3 (Mqtte.V3.Packet.Pubrec id));
127
+
let state = Protocol.Qos2_receiver.create id in
128
+
Protocol.Inflight.add t.session.qos2_recv_inflight id state
129
+
| _ -> ());
130
+
t.on_message msg
131
+
| Mqtte.V3.Packet.Puback id ->
132
+
Log.debug (fun m -> m "Received PUBACK for %d" id);
133
+
complete_pending_ack t id
134
+
| Mqtte.V3.Packet.Pubrec id ->
135
+
Log.debug (fun m -> m "Received PUBREC for %d" id);
136
+
send_packet t (Transport.V3 (Mqtte.V3.Packet.Pubrel id))
137
+
| Mqtte.V3.Packet.Pubrel id ->
138
+
Log.debug (fun m -> m "Received PUBREL for %d" id);
139
+
send_packet t (Transport.V3 (Mqtte.V3.Packet.Pubcomp id));
140
+
Protocol.Inflight.remove t.session.qos2_recv_inflight id |> ignore
141
+
| Mqtte.V3.Packet.Pubcomp id ->
142
+
Log.debug (fun m -> m "Received PUBCOMP for %d" id);
143
+
complete_pending_ack t id
144
+
| Mqtte.V3.Packet.Suback s ->
145
+
Log.debug (fun m -> m "Received SUBACK for %d" s.packet_id);
146
+
Option.iter
147
+
(fun resolver ->
148
+
Eio.Promise.resolve resolver ();
149
+
Hashtbl.remove t.pending_subacks s.packet_id;
150
+
Protocol.Packet_id.release t.session.packet_ids s.packet_id)
151
+
(Hashtbl.find_opt t.pending_subacks s.packet_id)
152
+
| Mqtte.V3.Packet.Unsuback id ->
153
+
Log.debug (fun m -> m "Received UNSUBACK for %d" id);
154
+
Protocol.Packet_id.release t.session.packet_ids id
155
+
| Mqtte.V3.Packet.Pingresp -> Log.debug (fun m -> m "Received PINGRESP")
156
+
| Mqtte.V3.Packet.Disconnect ->
157
+
Log.info (fun m -> m "Received DISCONNECT from server");
158
+
t.connected <- false;
159
+
t.should_stop <- true
160
+
| _ -> Log.warn (fun m -> m "Unexpected packet type")
161
161
end
162
-
163
162
| Transport.V5 pkt -> begin
164
163
match pkt with
165
-
| Mqtt.V5.Packet.Publish p ->
166
-
let msg = {
167
-
topic = p.topic;
168
-
payload = p.payload;
169
-
qos = p.qos;
170
-
retain = p.retain;
171
-
} in
172
-
(match p.qos, p.packet_id with
173
-
| `At_least_once, Some id ->
174
-
send_packet t (Transport.V5 (Mqtt.V5.Packet.Puback {
175
-
packet_id = id;
176
-
reason_code = `Success;
177
-
properties = [];
178
-
}))
179
-
| `Exactly_once, Some id ->
180
-
send_packet t (Transport.V5 (Mqtt.V5.Packet.Pubrec {
181
-
packet_id = id;
182
-
reason_code = `Success;
183
-
properties = [];
184
-
}));
185
-
let state = Protocol.Qos2_receiver.create id in
186
-
Protocol.Inflight.add t.session.qos2_recv_inflight id state
187
-
| _ -> ());
188
-
t.on_message msg
189
-
190
-
| Mqtt.V5.Packet.Puback p ->
191
-
Log.debug (fun m -> m "Received PUBACK for %d" p.packet_id);
192
-
complete_pending_ack t p.packet_id
193
-
194
-
| Mqtt.V5.Packet.Pubrec p ->
195
-
Log.debug (fun m -> m "Received PUBREC for %d" p.packet_id);
196
-
send_packet t (Transport.V5 (Mqtt.V5.Packet.Pubrel {
197
-
packet_id = p.packet_id;
198
-
reason_code = `Success;
199
-
properties = [];
200
-
}))
201
-
202
-
| Mqtt.V5.Packet.Pubrel p ->
203
-
Log.debug (fun m -> m "Received PUBREL for %d" p.packet_id);
204
-
send_packet t (Transport.V5 (Mqtt.V5.Packet.Pubcomp {
205
-
packet_id = p.packet_id;
206
-
reason_code = `Success;
207
-
properties = [];
208
-
}));
209
-
Protocol.Inflight.remove t.session.qos2_recv_inflight p.packet_id |> ignore
210
-
211
-
| Mqtt.V5.Packet.Pubcomp p ->
212
-
Log.debug (fun m -> m "Received PUBCOMP for %d" p.packet_id);
213
-
complete_pending_ack t p.packet_id
214
-
215
-
| Mqtt.V5.Packet.Suback s ->
216
-
Log.debug (fun m -> m "Received SUBACK for %d" s.packet_id);
217
-
Option.iter (fun resolver ->
218
-
Eio.Promise.resolve resolver ();
219
-
Hashtbl.remove t.pending_subacks s.packet_id;
220
-
Protocol.Packet_id.release t.session.packet_ids s.packet_id
221
-
) (Hashtbl.find_opt t.pending_subacks s.packet_id)
222
-
223
-
| Mqtt.V5.Packet.Unsuback u ->
224
-
Log.debug (fun m -> m "Received UNSUBACK for %d" u.packet_id);
225
-
Protocol.Packet_id.release t.session.packet_ids u.packet_id
226
-
227
-
| Mqtt.V5.Packet.Pingresp ->
228
-
Log.debug (fun m -> m "Received PINGRESP")
229
-
230
-
| Mqtt.V5.Packet.Disconnect d ->
231
-
Log.info (fun m -> m "Received DISCONNECT: %s"
232
-
(Mqtt.V5.Reason_code.to_string d.reason_code));
233
-
t.connected <- false;
234
-
t.should_stop <- true
235
-
236
-
| _ ->
237
-
Log.warn (fun m -> m "Unexpected packet type")
164
+
| Mqtte.V5.Packet.Publish p ->
165
+
let msg =
166
+
{
167
+
topic = p.topic;
168
+
payload = p.payload;
169
+
qos = p.qos;
170
+
retain = p.retain;
171
+
}
172
+
in
173
+
(match (p.qos, p.packet_id) with
174
+
| `At_least_once, Some id ->
175
+
send_packet t
176
+
(Transport.V5
177
+
(Mqtte.V5.Packet.Puback
178
+
{
179
+
packet_id = id;
180
+
reason_code = `Success;
181
+
properties = [];
182
+
}))
183
+
| `Exactly_once, Some id ->
184
+
send_packet t
185
+
(Transport.V5
186
+
(Mqtte.V5.Packet.Pubrec
187
+
{
188
+
packet_id = id;
189
+
reason_code = `Success;
190
+
properties = [];
191
+
}));
192
+
let state = Protocol.Qos2_receiver.create id in
193
+
Protocol.Inflight.add t.session.qos2_recv_inflight id state
194
+
| _ -> ());
195
+
t.on_message msg
196
+
| Mqtte.V5.Packet.Puback p ->
197
+
Log.debug (fun m -> m "Received PUBACK for %d" p.packet_id);
198
+
complete_pending_ack t p.packet_id
199
+
| Mqtte.V5.Packet.Pubrec p ->
200
+
Log.debug (fun m -> m "Received PUBREC for %d" p.packet_id);
201
+
send_packet t
202
+
(Transport.V5
203
+
(Mqtte.V5.Packet.Pubrel
204
+
{
205
+
packet_id = p.packet_id;
206
+
reason_code = `Success;
207
+
properties = [];
208
+
}))
209
+
| Mqtte.V5.Packet.Pubrel p ->
210
+
Log.debug (fun m -> m "Received PUBREL for %d" p.packet_id);
211
+
send_packet t
212
+
(Transport.V5
213
+
(Mqtte.V5.Packet.Pubcomp
214
+
{
215
+
packet_id = p.packet_id;
216
+
reason_code = `Success;
217
+
properties = [];
218
+
}));
219
+
Protocol.Inflight.remove t.session.qos2_recv_inflight p.packet_id
220
+
|> ignore
221
+
| Mqtte.V5.Packet.Pubcomp p ->
222
+
Log.debug (fun m -> m "Received PUBCOMP for %d" p.packet_id);
223
+
complete_pending_ack t p.packet_id
224
+
| Mqtte.V5.Packet.Suback s ->
225
+
Log.debug (fun m -> m "Received SUBACK for %d" s.packet_id);
226
+
Option.iter
227
+
(fun resolver ->
228
+
Eio.Promise.resolve resolver ();
229
+
Hashtbl.remove t.pending_subacks s.packet_id;
230
+
Protocol.Packet_id.release t.session.packet_ids s.packet_id)
231
+
(Hashtbl.find_opt t.pending_subacks s.packet_id)
232
+
| Mqtte.V5.Packet.Unsuback u ->
233
+
Log.debug (fun m -> m "Received UNSUBACK for %d" u.packet_id);
234
+
Protocol.Packet_id.release t.session.packet_ids u.packet_id
235
+
| Mqtte.V5.Packet.Pingresp -> Log.debug (fun m -> m "Received PINGRESP")
236
+
| Mqtte.V5.Packet.Disconnect d ->
237
+
Log.info (fun m ->
238
+
m "Received DISCONNECT: %s"
239
+
(Mqtte.V5.Reason_code.to_string d.reason_code));
240
+
t.connected <- false;
241
+
t.should_stop <- true
242
+
| _ -> Log.warn (fun m -> m "Unexpected packet type")
238
243
end
239
244
240
245
let reader_fiber t reader =
···
246
251
done
247
252
with
248
253
| End_of_file ->
249
-
Log.info (fun m -> m "Connection closed by server");
250
-
t.connected <- false
254
+
Log.info (fun m -> m "Connection closed by server");
255
+
t.connected <- false
251
256
| exn ->
252
-
Log.err (fun m -> m "Reader error: %a" Fmt.exn exn);
253
-
t.connected <- false
257
+
Log.err (fun m -> m "Reader error: %a" Fmt.exn exn);
258
+
t.connected <- false
254
259
255
260
let writer_fiber t =
256
261
Log.debug (fun m -> m "Starting writer fiber");
···
261
266
Transport.Writer.write_packet writer packet;
262
267
Transport.Writer.flush writer
263
268
done
264
-
with exn ->
265
-
Log.err (fun m -> m "Writer error: %a" Fmt.exn exn)
269
+
with exn -> Log.err (fun m -> m "Writer error: %a" Fmt.exn exn)
266
270
267
271
let pinger_fiber t =
268
272
if t.config.keep_alive > 0 then begin
269
-
Log.debug (fun m -> m "Starting pinger fiber (interval: %ds)" t.config.keep_alive);
273
+
Log.debug (fun m ->
274
+
m "Starting pinger fiber (interval: %ds)" t.config.keep_alive);
270
275
let interval = 0.75 *. float_of_int t.config.keep_alive in
271
276
try
272
-
while not t.should_stop && t.connected do
277
+
while (not t.should_stop) && t.connected do
273
278
t.sleep interval;
274
279
if t.connected && not t.should_stop then begin
275
280
Log.debug (fun m -> m "Sending PINGREQ");
276
-
let ping = match t.config.version with
277
-
| `V3_1_1 -> Transport.V3 Mqtt.V3.Packet.Pingreq
278
-
| `V5_0 -> Transport.V5 Mqtt.V5.Packet.Pingreq
281
+
let ping =
282
+
match t.config.version with
283
+
| `V3_1_1 -> Transport.V3 Mqtte.V3.Packet.Pingreq
284
+
| `V5_0 -> Transport.V5 Mqtte.V5.Packet.Pingreq
279
285
in
280
286
send_packet t ping
281
287
end
···
291
297
let session = Protocol.create_session ~clean_session:config.clean_session in
292
298
let outbox = Eio.Stream.create 100 in
293
299
294
-
let t = {
295
-
config;
296
-
flow;
297
-
close_flow;
298
-
session;
299
-
outbox;
300
-
pending_acks = Hashtbl.create 16;
301
-
pending_subacks = Hashtbl.create 16;
302
-
on_message;
303
-
on_disconnect;
304
-
connected = false;
305
-
should_stop = false;
306
-
sleep = Eio.Time.sleep clock;
307
-
} in
300
+
let t =
301
+
{
302
+
config;
303
+
flow;
304
+
close_flow;
305
+
session;
306
+
outbox;
307
+
pending_acks = Hashtbl.create 16;
308
+
pending_subacks = Hashtbl.create 16;
309
+
on_message;
310
+
on_disconnect;
311
+
connected = false;
312
+
should_stop = false;
313
+
sleep = Eio.Time.sleep clock;
314
+
}
315
+
in
308
316
309
-
let connect_packet = match config.version with
317
+
let connect_packet =
318
+
match config.version with
310
319
| `V3_1_1 ->
311
-
Transport.V3 (Mqtt.V3.Packet.Connect {
312
-
client_id = config.client_id;
313
-
clean_session = config.clean_session;
314
-
keep_alive = config.keep_alive;
315
-
credentials = config.credentials;
316
-
will = config.will;
317
-
})
320
+
Transport.V3
321
+
(Mqtte.V3.Packet.Connect
322
+
{
323
+
client_id = config.client_id;
324
+
clean_session = config.clean_session;
325
+
keep_alive = config.keep_alive;
326
+
credentials = config.credentials;
327
+
will = config.will;
328
+
})
318
329
| `V5_0 ->
319
-
Transport.V5 (Mqtt.V5.Packet.Connect {
320
-
client_id = config.client_id;
321
-
clean_start = config.clean_session;
322
-
keep_alive = config.keep_alive;
323
-
properties = [];
324
-
credentials = config.credentials;
325
-
will = Option.map (fun w -> Mqtt.V5.Will_properties.{
326
-
will_properties = [];
327
-
will_topic = Mqtt.Will.topic w;
328
-
will_payload = Mqtt.Will.payload w;
329
-
will_qos = Mqtt.Will.qos w;
330
-
will_retain = Mqtt.Will.retain w;
331
-
}) config.will;
332
-
})
330
+
Transport.V5
331
+
(Mqtte.V5.Packet.Connect
332
+
{
333
+
client_id = config.client_id;
334
+
clean_start = config.clean_session;
335
+
keep_alive = config.keep_alive;
336
+
properties = [];
337
+
credentials = config.credentials;
338
+
will =
339
+
Option.map
340
+
(fun w ->
341
+
Mqtte.V5.Will_properties.
342
+
{
343
+
will_properties = [];
344
+
will_topic = Mqtte.Will.topic w;
345
+
will_payload = Mqtte.Will.payload w;
346
+
will_qos = Mqtte.Will.qos w;
347
+
will_retain = Mqtte.Will.retain w;
348
+
})
349
+
config.will;
350
+
})
333
351
in
334
352
335
353
(* Send CONNECT packet *)
···
341
359
let reader = Transport.Reader.create flow config.version in
342
360
let connack = Transport.Reader.read_packet reader in
343
361
344
-
let session_present = match connack with
345
-
| Transport.V3 (Mqtt.V3.Packet.Connack c) ->
346
-
if c.return_code <> `Accepted then
347
-
raise (err (Connection_refused (Mqtt.V3.Return_code.to_string c.return_code)));
348
-
c.session_present
349
-
| Transport.V5 (Mqtt.V5.Packet.Connack c) ->
350
-
if c.reason_code <> `Success then
351
-
raise (err (Connection_refused (Mqtt.V5.Reason_code.to_string c.reason_code)));
352
-
c.session_present
353
-
| _ ->
354
-
raise (err (Protocol_error "Expected CONNACK packet"))
362
+
let session_present =
363
+
match connack with
364
+
| Transport.V3 (Mqtte.V3.Packet.Connack c) ->
365
+
if c.return_code <> `Accepted then
366
+
raise
367
+
(err
368
+
(Connection_refused
369
+
(Mqtte.V3.Return_code.to_string c.return_code)));
370
+
c.session_present
371
+
| Transport.V5 (Mqtte.V5.Packet.Connack c) ->
372
+
if c.reason_code <> `Success then
373
+
raise
374
+
(err
375
+
(Connection_refused
376
+
(Mqtte.V5.Reason_code.to_string c.reason_code)));
377
+
c.session_present
378
+
| _ -> raise (err (Protocol_error "Expected CONNACK packet"))
355
379
in
356
380
357
381
Log.info (fun m -> m "Connected (session_present=%b)" session_present);
···
368
392
let connection = Transport.Connection.connect ~sw ~net ~host ~port in
369
393
let flow = Transport.Connection.flow connection in
370
394
let close_flow () = Transport.Connection.close connection in
371
-
connect_with_flow ~sw ~clock ?on_message ?on_disconnect ~config ~close_flow flow
395
+
connect_with_flow ~sw ~clock ?on_message ?on_disconnect ~config ~close_flow
396
+
flow
372
397
373
-
let connect_with_pool ~sw ~clock ?on_message ?on_disconnect ~config ~pool ~endpoint () =
398
+
let connect_with_pool ~sw ~clock ?on_message ?on_disconnect ~config ~pool
399
+
~endpoint () =
374
400
let host = Conpool.Endpoint.host endpoint in
375
401
let port = Conpool.Endpoint.port endpoint in
376
-
Log.info (fun m -> m "Connecting to %s:%d as %s (via pool)" host port config.client_id);
402
+
Log.info (fun m ->
403
+
m "Connecting to %s:%d as %s (via pool)" host port config.client_id);
377
404
let conn = Conpool.connection ~sw pool endpoint in
378
405
let flow = (conn :> Eio.Flow.two_way_ty Eio.Resource.t) in
379
406
let close_flow () = Eio.Resource.close conn in
380
-
connect_with_flow ~sw ~clock ?on_message ?on_disconnect ~config ~close_flow flow
407
+
connect_with_flow ~sw ~clock ?on_message ?on_disconnect ~config ~close_flow
408
+
flow
381
409
382
410
let disconnect ?reason_code t =
383
411
if t.connected then begin
384
412
Log.info (fun m -> m "Disconnecting");
385
413
t.should_stop <- true;
386
-
let disconnect_packet = match t.config.version with
387
-
| `V3_1_1 ->
388
-
Transport.V3 Mqtt.V3.Packet.Disconnect
414
+
let disconnect_packet =
415
+
match t.config.version with
416
+
| `V3_1_1 -> Transport.V3 Mqtte.V3.Packet.Disconnect
389
417
| `V5_0 ->
390
-
let reason_code = Option.value reason_code
391
-
~default:`Normal_disconnection in
392
-
Transport.V5 (Mqtt.V5.Packet.Disconnect {
393
-
reason_code;
394
-
properties = [];
395
-
})
418
+
let reason_code =
419
+
Option.value reason_code ~default:`Normal_disconnection
420
+
in
421
+
Transport.V5
422
+
(Mqtte.V5.Packet.Disconnect { reason_code; properties = [] })
396
423
in
397
424
send_packet t disconnect_packet;
398
425
t.sleep 0.1;
···
407
434
let version = t.config.version in
408
435
match qos with
409
436
| `At_most_once ->
410
-
send_packet t (make_publish ~version ~dup:false ~qos ~retain ~topic ~packet_id:None ~payload)
437
+
send_packet t
438
+
(make_publish ~version ~dup:false ~qos ~retain ~topic ~packet_id:None
439
+
~payload)
411
440
| `At_least_once | `Exactly_once ->
412
-
let id = Protocol.Packet_id.next t.session.packet_ids in
413
-
let promise, resolver = Eio.Promise.create () in
414
-
Hashtbl.add t.pending_acks id { resolver; completed = false };
415
-
send_packet t (make_publish ~version ~dup:false ~qos ~retain ~topic ~packet_id:(Some id) ~payload);
416
-
Eio.Promise.await promise
441
+
let id = Protocol.Packet_id.next t.session.packet_ids in
442
+
let promise, resolver = Eio.Promise.create () in
443
+
Hashtbl.add t.pending_acks id { resolver; completed = false };
444
+
send_packet t
445
+
(make_publish ~version ~dup:false ~qos ~retain ~topic
446
+
~packet_id:(Some id) ~payload);
447
+
Eio.Promise.await promise
417
448
418
449
let publish_async ?(qos = `At_most_once) ?(retain = false) ~topic payload t =
419
450
if not t.connected then raise (err Not_connected);
···
421
452
let version = t.config.version in
422
453
match qos with
423
454
| `At_most_once ->
424
-
send_packet t (make_publish ~version ~dup:false ~qos ~retain ~topic ~packet_id:None ~payload);
425
-
Eio.Promise.resolve resolver ();
426
-
promise
455
+
send_packet t
456
+
(make_publish ~version ~dup:false ~qos ~retain ~topic ~packet_id:None
457
+
~payload);
458
+
Eio.Promise.resolve resolver ();
459
+
promise
427
460
| `At_least_once | `Exactly_once ->
428
-
let id = Protocol.Packet_id.next t.session.packet_ids in
429
-
Hashtbl.add t.pending_acks id { resolver; completed = false };
430
-
send_packet t (make_publish ~version ~dup:false ~qos ~retain ~topic ~packet_id:(Some id) ~payload);
431
-
promise
461
+
let id = Protocol.Packet_id.next t.session.packet_ids in
462
+
Hashtbl.add t.pending_acks id { resolver; completed = false };
463
+
send_packet t
464
+
(make_publish ~version ~dup:false ~qos ~retain ~topic
465
+
~packet_id:(Some id) ~payload);
466
+
promise
432
467
433
468
let subscribe ?(qos = `At_most_once) topics t =
434
469
if not t.connected then raise (err Not_connected);
···
438
473
let promise, resolver = Eio.Promise.create () in
439
474
Hashtbl.add t.pending_subacks id resolver;
440
475
441
-
let packet = match t.config.version with
476
+
let packet =
477
+
match t.config.version with
442
478
| `V3_1_1 ->
443
-
let topics = List.map (fun filter ->
444
-
Mqtt.V3.Subscription.{ filter; qos }
445
-
) topics in
446
-
Transport.V3 (Mqtt.V3.Packet.Subscribe { packet_id = id; topics })
479
+
let topics =
480
+
List.map (fun filter -> Mqtte.V3.Subscription.{ filter; qos }) topics
481
+
in
482
+
Transport.V3 (Mqtte.V3.Packet.Subscribe { packet_id = id; topics })
447
483
| `V5_0 ->
448
-
let topics = List.map (fun filter ->
449
-
Mqtt.V5.Subscription.{
450
-
filter;
451
-
options = Mqtt.V5.Subscription_options.default qos;
452
-
}
453
-
) topics in
454
-
Transport.V5 (Mqtt.V5.Packet.Subscribe {
455
-
packet_id = id;
456
-
properties = [];
457
-
topics;
458
-
})
484
+
let topics =
485
+
List.map
486
+
(fun filter ->
487
+
Mqtte.V5.Subscription.
488
+
{ filter; options = Mqtte.V5.Subscription_options.default qos })
489
+
topics
490
+
in
491
+
Transport.V5
492
+
(Mqtte.V5.Packet.Subscribe { packet_id = id; properties = []; topics })
459
493
in
460
494
send_packet t packet;
461
495
Eio.Promise.await promise
···
466
500
467
501
let id = Protocol.Packet_id.next t.session.packet_ids in
468
502
469
-
let packet = match t.config.version with
503
+
let packet =
504
+
match t.config.version with
470
505
| `V3_1_1 ->
471
-
Transport.V3 (Mqtt.V3.Packet.Unsubscribe { packet_id = id; topics })
506
+
Transport.V3 (Mqtte.V3.Packet.Unsubscribe { packet_id = id; topics })
472
507
| `V5_0 ->
473
-
Transport.V5 (Mqtt.V5.Packet.Unsubscribe {
474
-
packet_id = id;
475
-
properties = [];
476
-
topics;
477
-
})
508
+
Transport.V5
509
+
(Mqtte.V5.Packet.Unsubscribe
510
+
{ packet_id = id; properties = []; topics })
478
511
in
479
512
send_packet t packet
+65
-55
lib/eio/cmd.ml
+65
-55
lib/eio/cmd.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Cmdliner terms for MQTT configuration
2
7
3
-
This module provides Cmdliner terms and argument definitions for
4
-
configuring MQTT connections from the command line.
5
-
*)
8
+
This module provides Cmdliner terms and argument definitions for configuring
9
+
MQTT connections from the command line. *)
6
10
7
11
open Cmdliner
8
12
···
11
15
let host =
12
16
let doc = "MQTT broker hostname or IP address." in
13
17
let env = Cmd.Env.info "MQTT_HOST" ~doc in
14
-
Arg.(value & opt string "127.0.0.1" &
15
-
info ["h"; "host"] ~docv:"HOST" ~doc ~env)
18
+
Arg.(
19
+
value & opt string "127.0.0.1" & info [ "h"; "host" ] ~docv:"HOST" ~doc ~env)
16
20
17
21
let port =
18
22
let doc = "MQTT broker port." in
19
23
let env = Cmd.Env.info "MQTT_PORT" ~doc in
20
-
Arg.(value & opt int 1883 &
21
-
info ["p"; "port"] ~docv:"PORT" ~doc ~env)
24
+
Arg.(value & opt int 1883 & info [ "p"; "port" ] ~docv:"PORT" ~doc ~env)
22
25
23
26
let tls =
24
-
let doc = "Use TLS for the connection. Port defaults to 8883 if not specified." in
27
+
let doc =
28
+
"Use TLS for the connection. Port defaults to 8883 if not specified."
29
+
in
25
30
let env = Cmd.Env.info "MQTT_TLS" ~doc in
26
-
Arg.(value & flag &
27
-
info ["tls"] ~doc ~env)
31
+
Arg.(value & flag & info [ "tls" ] ~doc ~env)
28
32
29
33
let insecure =
30
-
let doc = "Skip TLS certificate verification (allows expired/self-signed certificates)." in
31
-
Arg.(value & flag &
32
-
info ["insecure"] ~doc)
34
+
let doc =
35
+
"Skip TLS certificate verification (allows expired/self-signed \
36
+
certificates)."
37
+
in
38
+
Arg.(value & flag & info [ "insecure" ] ~doc)
33
39
34
40
(** {1 Client Options} *)
35
41
36
42
let client_id =
37
-
let doc = "MQTT client identifier. If not specified, a random ID is generated." in
43
+
let doc =
44
+
"MQTT client identifier. If not specified, a random ID is generated."
45
+
in
38
46
let env = Cmd.Env.info "MQTT_CLIENT_ID" ~doc in
39
-
Arg.(value & opt (some string) None &
40
-
info ["client-id"] ~docv:"ID" ~doc ~env)
47
+
Arg.(
48
+
value & opt (some string) None & info [ "client-id" ] ~docv:"ID" ~doc ~env)
41
49
42
50
let clean_session =
43
-
let doc = "Start with a clean session (discard any previous session state)." in
44
-
Arg.(value & flag &
45
-
info ["clean-session"] ~doc)
51
+
let doc =
52
+
"Start with a clean session (discard any previous session state)."
53
+
in
54
+
Arg.(value & flag & info [ "clean-session" ] ~doc)
46
55
47
56
let keep_alive =
48
57
let doc = "Keep-alive interval in seconds. Use 0 to disable." in
49
-
Arg.(value & opt int 60 &
50
-
info ["keep-alive"] ~docv:"SECONDS" ~doc)
58
+
Arg.(value & opt int 60 & info [ "keep-alive" ] ~docv:"SECONDS" ~doc)
51
59
52
60
(** {1 Protocol Options} *)
53
61
54
62
let protocol_version =
55
63
let doc = "MQTT protocol version to use." in
56
-
let versions = ["3.1.1", `V3_1_1; "5", `V5_0; "5.0", `V5_0] in
57
-
Arg.(value & opt (enum versions) `V3_1_1 &
58
-
info ["mqtt-version"] ~docv:"VERSION" ~doc)
64
+
let versions = [ ("3.1.1", `V3_1_1); ("5", `V5_0); ("5.0", `V5_0) ] in
65
+
Arg.(
66
+
value
67
+
& opt (enum versions) `V3_1_1
68
+
& info [ "mqtt-version" ] ~docv:"VERSION" ~doc)
59
69
60
70
(** {1 Authentication Options} *)
61
71
62
72
let username =
63
73
let doc = "MQTT username for authentication." in
64
74
let env = Cmd.Env.info "MQTT_USER" ~doc in
65
-
Arg.(value & opt (some string) None &
66
-
info ["u"; "username"] ~docv:"USER" ~doc ~env)
75
+
Arg.(
76
+
value
77
+
& opt (some string) None
78
+
& info [ "u"; "username" ] ~docv:"USER" ~doc ~env)
67
79
68
80
let password =
69
81
let doc = "MQTT password for authentication." in
70
82
let env = Cmd.Env.info "MQTT_PASSWORD" ~doc in
71
-
Arg.(value & opt (some string) None &
72
-
info ["password"] ~docv:"PASS" ~doc ~env)
83
+
Arg.(
84
+
value & opt (some string) None & info [ "password" ] ~docv:"PASS" ~doc ~env)
73
85
74
86
(** {1 Combined Connection Parameters} *)
75
87
88
+
type connection = { host : string; port : int; tls : bool; insecure : bool }
76
89
(** Type for connection parameters parsed from command line *)
77
-
type connection = {
78
-
host : string;
79
-
port : int;
80
-
tls : bool;
81
-
insecure : bool;
82
-
}
83
90
84
-
(** Type for all MQTT configuration parsed from command line *)
85
91
type t = {
86
92
connection : connection;
87
93
config : Client.config;
88
94
pool_config : Conpool.Config.t;
89
95
}
96
+
(** Type for all MQTT configuration parsed from command line *)
90
97
91
98
(** Build credentials from username/password options *)
92
99
let make_credentials username password =
93
-
match username, password with
100
+
match (username, password) with
94
101
| Some u, Some p -> Some (`Username_password (u, p))
95
102
| Some u, None -> Some (`Username u)
96
103
| None, _ -> None
···
106
113
(** Term that parses the full MQTT client configuration *)
107
114
let config_term =
108
115
let make client_id clean_session keep_alive version username password =
109
-
let client_id = match client_id with
116
+
let client_id =
117
+
match client_id with
110
118
| Some id -> id
111
119
| None -> Printf.sprintf "mqtt-eio-%d" (Random.int 100000)
112
120
in
113
121
let credentials = make_credentials username password in
114
-
Client.{
115
-
client_id;
116
-
version;
117
-
clean_session;
118
-
keep_alive;
119
-
credentials;
120
-
will = None;
121
-
}
122
+
Client.
123
+
{
124
+
client_id;
125
+
version;
126
+
clean_session;
127
+
keep_alive;
128
+
credentials;
129
+
will = None;
130
+
}
122
131
in
123
-
Term.(const make $ client_id $ clean_session $ keep_alive $
124
-
protocol_version $ username $ password)
132
+
Term.(
133
+
const make $ client_id $ clean_session $ keep_alive $ protocol_version
134
+
$ username $ password)
125
135
126
136
(** Term that parses both connection and config together *)
127
137
let term =
128
-
let make connection config pool_config = { connection; config; pool_config } in
138
+
let make connection config pool_config =
139
+
{ connection; config; pool_config }
140
+
in
129
141
Term.(const make $ connection_term $ config_term $ Conpool.Cmd.config)
130
142
131
143
(** {1 Connection Pool Helpers} *)
···
142
154
let tls_config =
143
155
if tls then
144
156
let authenticator =
145
-
if insecure then
146
-
fun ?ip:_ ~host:_ _ -> Ok None
157
+
if insecure then fun ?ip:_ ~host:_ _ -> Ok None
147
158
else
148
159
match Ca_certs.authenticator () with
149
160
| Ok auth -> auth
150
-
| Error (`Msg msg) -> failwith ("Failed to load CA certificates: " ^ msg)
161
+
| Error (`Msg msg) ->
162
+
failwith ("Failed to load CA certificates: " ^ msg)
151
163
in
152
164
match Tls.Config.client ~authenticator () with
153
165
| Ok config -> Some config
154
166
| Error (`Msg msg) -> failwith ("Failed to create TLS config: " ^ msg)
155
-
else
156
-
None
167
+
else None
157
168
in
158
169
Conpool.create ~sw ~net ~clock ?tls:tls_config ~config:pool_config ()
159
170
160
171
(** Create a Conpool endpoint from connection parameters *)
161
-
let endpoint conn =
162
-
Conpool.Endpoint.make ~host:conn.host ~port:conn.port
172
+
let endpoint conn = Conpool.Endpoint.make ~host:conn.host ~port:conn.port
+3
-3
lib/eio/dune
+3
-3
lib/eio/dune
-10
lib/eio/mqtt_eio.ml
-10
lib/eio/mqtt_eio.ml
···
1
-
(** MQTT Client for Eio
2
-
3
-
This library provides an MQTT client implementation using Eio for
4
-
asynchronous I/O. It supports both MQTT v3.1.1 and v5.0 protocols.
5
-
*)
6
-
7
-
module Client = Client
8
-
module Transport = Transport
9
-
module Protocol = Protocol
10
-
module Cmd = Cmd
+14
lib/eio/mqtte_eio.ml
+14
lib/eio/mqtte_eio.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** MQTT Client for Eio
7
+
8
+
This library provides an MQTT client implementation using Eio for
9
+
asynchronous I/O. It supports both MQTT v3.1.1 and v5.0 protocols. *)
10
+
11
+
module Client = Client
12
+
module Transport = Transport
13
+
module Protocol = Protocol
14
+
module Cmd = Cmd
+62
-92
lib/eio/protocol.ml
+62
-92
lib/eio/protocol.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT Protocol State Machine *)
2
7
3
8
module Packet_id = struct
4
-
type t = {
5
-
mutable next : int;
6
-
in_use : (int, unit) Hashtbl.t;
7
-
}
9
+
type t = { mutable next : int; in_use : (int, unit) Hashtbl.t }
8
10
9
-
let create () = {
10
-
next = 1;
11
-
in_use = Hashtbl.create 16;
12
-
}
11
+
let create () = { next = 1; in_use = Hashtbl.create 16 }
13
12
14
13
let next t =
15
14
let rec find_free () =
16
15
let id = t.next in
17
-
t.next <- if t.next >= 65535 then 1 else t.next + 1;
16
+
t.next <- (if t.next >= 65535 then 1 else t.next + 1);
18
17
if Hashtbl.mem t.in_use id then find_free ()
19
18
else begin
20
19
Hashtbl.add t.in_use id ();
···
23
22
in
24
23
find_free ()
25
24
26
-
let release t id =
27
-
Hashtbl.remove t.in_use id
25
+
let release t id = Hashtbl.remove t.in_use id
28
26
end
29
27
30
28
module Inflight = struct
31
-
type 'a t = (Mqtt.Packet_id.t, 'a) Hashtbl.t
29
+
type 'a t = (Mqtte.Packet_id.t, 'a) Hashtbl.t
32
30
33
31
let create () = Hashtbl.create 16
34
-
35
-
let add t id value =
36
-
Hashtbl.replace t id value
37
-
38
-
let find t id =
39
-
Hashtbl.find_opt t id
32
+
let add t id value = Hashtbl.replace t id value
33
+
let find t id = Hashtbl.find_opt t id
40
34
41
35
let remove t id =
42
36
let v = Hashtbl.find_opt t id in
···
44
38
v
45
39
46
40
let count t = Hashtbl.length t
47
-
48
41
let iter f t = Hashtbl.iter f t
49
42
end
50
43
51
44
module Qos1 = struct
52
-
type state =
53
-
| Waiting_puback
54
-
| Complete
45
+
type state = Waiting_puback | Complete
55
46
56
47
type t = {
57
-
packet_id : Mqtt.Packet_id.t;
48
+
packet_id : Mqtte.Packet_id.t;
58
49
mutable state : state;
59
50
topic : string;
60
51
payload : string;
61
52
mutable retries : int;
62
53
}
63
54
64
-
let create packet_id ~topic ~payload = {
65
-
packet_id;
66
-
state = Waiting_puback;
67
-
topic;
68
-
payload;
69
-
retries = 0;
70
-
}
55
+
let create packet_id ~topic ~payload =
56
+
{ packet_id; state = Waiting_puback; topic; payload; retries = 0 }
71
57
72
58
let handle_puback t id =
73
59
if t.packet_id = id && t.state = Waiting_puback then begin
74
60
t.state <- Complete;
75
61
true
76
-
end else
77
-
false
62
+
end
63
+
else false
78
64
end
79
65
80
66
module Qos2_sender = struct
81
-
type state =
82
-
| Waiting_pubrec
83
-
| Waiting_pubcomp
84
-
| Complete
67
+
type state = Waiting_pubrec | Waiting_pubcomp | Complete
85
68
86
69
type t = {
87
-
packet_id : Mqtt.Packet_id.t;
70
+
packet_id : Mqtte.Packet_id.t;
88
71
mutable state : state;
89
72
topic : string;
90
73
payload : string;
91
74
mutable retries : int;
92
75
}
93
76
94
-
let create packet_id ~topic ~payload = {
95
-
packet_id;
96
-
state = Waiting_pubrec;
97
-
topic;
98
-
payload;
99
-
retries = 0;
100
-
}
77
+
let create packet_id ~topic ~payload =
78
+
{ packet_id; state = Waiting_pubrec; topic; payload; retries = 0 }
101
79
102
80
let handle_pubrec t id =
103
81
if t.packet_id = id && t.state = Waiting_pubrec then begin
104
82
t.state <- Waiting_pubcomp;
105
83
true
106
-
end else
107
-
false
84
+
end
85
+
else false
108
86
109
87
let handle_pubcomp t id =
110
88
if t.packet_id = id && t.state = Waiting_pubcomp then begin
111
89
t.state <- Complete;
112
90
true
113
-
end else
114
-
false
91
+
end
92
+
else false
115
93
end
116
94
117
95
module Qos2_receiver = struct
118
-
type state =
119
-
| Received
120
-
| Waiting_pubrel
121
-
| Complete
122
-
123
-
type t = {
124
-
packet_id : Mqtt.Packet_id.t;
125
-
mutable state : state;
126
-
}
96
+
type state = Received | Waiting_pubrel | Complete
97
+
type t = { packet_id : Mqtte.Packet_id.t; mutable state : state }
127
98
128
-
let create packet_id = {
129
-
packet_id;
130
-
state = Received;
131
-
}
99
+
let create packet_id = { packet_id; state = Received }
132
100
133
101
let handle_pubrel t id =
134
102
if t.packet_id = id && t.state = Waiting_pubrel then begin
135
103
t.state <- Complete;
136
104
true
137
-
end else
138
-
false
105
+
end
106
+
else false
139
107
end
140
108
141
109
type session = {
142
110
mutable clean_session : bool;
143
-
mutable subscriptions : (Mqtt.Topic.Filter.t * Mqtt.Qos.t) list;
111
+
mutable subscriptions : (Mqtte.Topic.Filter.t * Mqtte.Qos.t) list;
144
112
packet_ids : Packet_id.t;
145
113
qos1_inflight : Qos1.t Inflight.t;
146
114
qos2_send_inflight : Qos2_sender.t Inflight.t;
147
115
qos2_recv_inflight : Qos2_receiver.t Inflight.t;
148
116
}
149
117
150
-
let create_session ~clean_session = {
151
-
clean_session;
152
-
subscriptions = [];
153
-
packet_ids = Packet_id.create ();
154
-
qos1_inflight = Inflight.create ();
155
-
qos2_send_inflight = Inflight.create ();
156
-
qos2_recv_inflight = Inflight.create ();
157
-
}
118
+
let create_session ~clean_session =
119
+
{
120
+
clean_session;
121
+
subscriptions = [];
122
+
packet_ids = Packet_id.create ();
123
+
qos1_inflight = Inflight.create ();
124
+
qos2_send_inflight = Inflight.create ();
125
+
qos2_recv_inflight = Inflight.create ();
126
+
}
158
127
159
128
module Topic_alias = struct
160
129
type t = {
···
166
135
mutable next_outbound : int;
167
136
}
168
137
169
-
let create ~max_outbound ~max_inbound = {
170
-
max_outbound;
171
-
max_inbound;
172
-
outbound = Hashtbl.create 16;
173
-
inbound = Hashtbl.create 16;
174
-
reverse_outbound = Hashtbl.create 16;
175
-
next_outbound = 1;
176
-
}
138
+
let create ~max_outbound ~max_inbound =
139
+
{
140
+
max_outbound;
141
+
max_inbound;
142
+
outbound = Hashtbl.create 16;
143
+
inbound = Hashtbl.create 16;
144
+
reverse_outbound = Hashtbl.create 16;
145
+
next_outbound = 1;
146
+
}
177
147
178
148
let set_outbound t alias topic =
179
149
if alias > 0 && alias <= t.max_outbound then begin
180
-
Option.iter (Hashtbl.remove t.reverse_outbound) (Hashtbl.find_opt t.outbound alias);
150
+
Option.iter
151
+
(Hashtbl.remove t.reverse_outbound)
152
+
(Hashtbl.find_opt t.outbound alias);
181
153
Hashtbl.replace t.outbound alias topic;
182
154
Hashtbl.replace t.reverse_outbound topic alias
183
155
end
184
156
185
-
let get_outbound t alias =
186
-
Hashtbl.find_opt t.outbound alias
157
+
let get_outbound t alias = Hashtbl.find_opt t.outbound alias
187
158
188
159
let set_inbound t alias topic =
189
160
if alias > 0 && alias <= t.max_inbound then
190
161
Hashtbl.replace t.inbound alias topic
191
162
192
-
let get_inbound t alias =
193
-
Hashtbl.find_opt t.inbound alias
163
+
let get_inbound t alias = Hashtbl.find_opt t.inbound alias
194
164
195
165
let allocate_outbound t topic =
196
166
if t.max_outbound = 0 then None
···
198
168
match Hashtbl.find_opt t.reverse_outbound topic with
199
169
| Some alias -> Some alias
200
170
| None ->
201
-
if t.next_outbound <= t.max_outbound then begin
202
-
let alias = t.next_outbound in
203
-
t.next_outbound <- t.next_outbound + 1;
204
-
set_outbound t alias topic;
205
-
Some alias
206
-
end else
207
-
None
171
+
if t.next_outbound <= t.max_outbound then begin
172
+
let alias = t.next_outbound in
173
+
t.next_outbound <- t.next_outbound + 1;
174
+
set_outbound t alias topic;
175
+
Some alias
176
+
end
177
+
else None
208
178
end
+31
-30
lib/eio/transport.ml
+31
-30
lib/eio/transport.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT Transport Layer using Eio and bytesrw-eio *)
2
7
3
8
let src = Logs.Src.create "mqtt.transport" ~doc:"MQTT Transport"
9
+
4
10
module Log = (val Logs.src_log src : Logs.LOG)
5
11
6
-
type packet =
7
-
| V3 of Mqtt.V3.Packet.t
8
-
| V5 of Mqtt.V5.Packet.t
12
+
type packet = V3 of Mqtte.V3.Packet.t | V5 of Mqtte.V5.Packet.t
9
13
10
14
module Reader = struct
11
15
type t = {
12
16
reader : Bytesrw.Bytes.Reader.t;
13
-
version : Mqtt.Protocol_version.t;
17
+
version : Mqtte.Protocol_version.t;
14
18
}
15
19
16
20
let create flow version =
···
20
24
let read_packet t =
21
25
match t.version with
22
26
| `V3_1_1 ->
23
-
let pkt = Mqtt.V3.Packet.read t.reader in
24
-
Log.debug (fun m -> m "Read V3 packet");
25
-
V3 pkt
27
+
let pkt = Mqtte.V3.Packet.read t.reader in
28
+
Log.debug (fun m -> m "Read V3 packet");
29
+
V3 pkt
26
30
| `V5_0 ->
27
-
let pkt = Mqtt.V5.Packet.read t.reader in
28
-
Log.debug (fun m -> m "Read V5 packet");
29
-
V5 pkt
31
+
let pkt = Mqtte.V5.Packet.read t.reader in
32
+
Log.debug (fun m -> m "Read V5 packet");
33
+
V5 pkt
30
34
31
35
let read_packet_timeout t clock timeout =
32
-
Eio.Time.with_timeout clock timeout (fun () ->
33
-
Ok (read_packet t)
34
-
) |> Result.to_option
36
+
Eio.Time.with_timeout clock timeout (fun () -> Ok (read_packet t))
37
+
|> Result.to_option
35
38
end
36
39
37
40
module Writer = struct
38
41
type t = {
39
42
writer : Bytesrw.Bytes.Writer.t;
40
-
version : Mqtt.Protocol_version.t;
43
+
version : Mqtte.Protocol_version.t;
41
44
}
42
45
43
46
let create flow version =
···
45
48
{ writer; version }
46
49
47
50
let write_packet t packet =
48
-
(match packet with
49
-
| V3 pkt ->
50
-
Log.debug (fun m -> m "Writing V3 packet");
51
-
Mqtt.V3.Packet.write t.writer pkt
52
-
| V5 pkt ->
53
-
Log.debug (fun m -> m "Writing V5 packet");
54
-
Mqtt.V5.Packet.write t.writer pkt)
51
+
match packet with
52
+
| V3 pkt ->
53
+
Log.debug (fun m -> m "Writing V3 packet");
54
+
Mqtte.V3.Packet.write t.writer pkt
55
+
| V5 pkt ->
56
+
Log.debug (fun m -> m "Writing V5 packet");
57
+
Mqtte.V5.Packet.write t.writer pkt
55
58
56
59
let flush _t =
57
60
(* bytesrw writers are flushed automatically when data is written *)
···
59
62
end
60
63
61
64
module Connection = struct
62
-
type t = {
63
-
flow : Eio.Flow.two_way_ty Eio.Resource.t;
64
-
mutable closed : bool;
65
-
}
65
+
type t = { flow : Eio.Flow.two_way_ty Eio.Resource.t; mutable closed : bool }
66
66
67
67
let connect ~sw ~net ~host ~port =
68
68
Log.info (fun m -> m "Connecting to %s:%d" host port);
69
-
let addrs = Eio.Net.getaddrinfo_stream net host ~service:(string_of_int port) in
69
+
let addrs =
70
+
Eio.Net.getaddrinfo_stream net host ~service:(string_of_int port)
71
+
in
70
72
match addrs with
71
73
| [] -> failwith (Printf.sprintf "Could not resolve %s" host)
72
74
| addr :: _ ->
73
-
let flow = Eio.Net.connect ~sw net addr in
74
-
Log.info (fun m -> m "Connected to %s:%d" host port);
75
-
{ flow = (flow :> Eio.Flow.two_way_ty Eio.Resource.t); closed = false }
75
+
let flow = Eio.Net.connect ~sw net addr in
76
+
Log.info (fun m -> m "Connected to %s:%d" host port);
77
+
{ flow :> Eio.Flow.two_way_ty Eio.Resource.t; closed = false }
76
78
77
79
let connect_tls ~sw:_ ~net:_ ~host:_ ~port:_ ?authenticator:_ () =
78
80
failwith "TLS not yet implemented - requires tls-eio"
79
81
80
82
let flow t = t.flow
81
-
82
83
let reader t version = Reader.create t.flow version
83
84
let writer t version = Writer.create t.flow version
84
85
-37
mqtt-eio.opam
-37
mqtt-eio.opam
···
1
-
# This file is generated by dune, edit dune-project instead
2
-
opam-version: "2.0"
3
-
synopsis: "MQTT client library for OCaml using Eio"
4
-
description:
5
-
"An MQTT v3.1.1 and v5.0 client library using Eio for effects-based IO"
6
-
maintainer: ["anil@recoil.org"]
7
-
authors: ["Anil Madhavapeddy"]
8
-
license: "ISC"
9
-
homepage: "https://github.com/avsm/mqtt-eio"
10
-
bug-reports: "https://github.com/avsm/mqtt-eio/issues"
11
-
depends: [
12
-
"dune" {>= "3.20"}
13
-
"ocaml" {>= "5.1"}
14
-
"eio" {>= "1.0"}
15
-
"eio_main" {>= "1.0"}
16
-
"cstruct" {>= "6.0"}
17
-
"logs" {>= "0.7"}
18
-
"fmt" {>= "0.9"}
19
-
"alcotest" {with-test}
20
-
"odoc" {with-doc}
21
-
]
22
-
build: [
23
-
["dune" "subst"] {dev}
24
-
[
25
-
"dune"
26
-
"build"
27
-
"-p"
28
-
name
29
-
"-j"
30
-
jobs
31
-
"@install"
32
-
"@runtest" {with-test}
33
-
"@doc" {with-doc}
34
-
]
35
-
]
36
-
dev-repo: "git+https://github.com/avsm/mqtt-eio.git"
37
-
x-maintenance-intent: ["(latest)"]
+40
mqtte.opam
+40
mqtte.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "MQTT protocol library for OCaml"
4
+
description: "An MQTT v3.1.1 and v5.0 protocol library with Eio-based client"
5
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
6
+
authors: ["Anil Madhavapeddy"]
7
+
license: "ISC"
8
+
homepage: "https://tangled.org/@anil.recoil.org/ocaml-mqtte"
9
+
bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-mqtte/issues"
10
+
depends: [
11
+
"dune" {>= "3.20"}
12
+
"ocaml" {>= "5.1"}
13
+
"eio" {>= "1.0"}
14
+
"eio_main" {>= "1.0"}
15
+
"bytesrw" {>= "0.1"}
16
+
"bytesrw-eio" {>= "0.1"}
17
+
"conpool"
18
+
"ca-certs"
19
+
"cmdliner" {>= "1.2"}
20
+
"tls"
21
+
"logs" {>= "0.7"}
22
+
"fmt" {>= "0.9"}
23
+
"alcotest" {with-test}
24
+
"odoc" {with-doc}
25
+
]
26
+
build: [
27
+
["dune" "subst"] {dev}
28
+
[
29
+
"dune"
30
+
"build"
31
+
"-p"
32
+
name
33
+
"-j"
34
+
jobs
35
+
"@install"
36
+
"@runtest" {with-test}
37
+
"@doc" {with-doc}
38
+
]
39
+
]
40
+
x-maintenance-intent: ["(latest)"]
+1
-1
test/dune
+1
-1
test/dune
+287
-185
test/test_mqtt.ml
+287
-185
test/test_mqtt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** MQTT Library Tests *)
2
7
3
8
open Bytesrw
4
-
5
-
module V3 = Mqtt.V3.Packet
6
-
module V5 = Mqtt.V5.Packet
7
-
module Protocol = Mqtt_eio.Protocol
9
+
module V3 = Mqtte.V3.Packet
10
+
module V5 = Mqtte.V5.Packet
11
+
module Protocol = Mqtte_eio.Protocol
8
12
9
13
(** {1 Helper Functions} *)
10
14
···
33
37
(** {1 Topic Validation Tests} *)
34
38
35
39
let test_topic_valid () =
36
-
Alcotest.(check bool) "simple topic" true (Mqtt.Topic.Name.validate "home/sensor/temp");
37
-
Alcotest.(check bool) "single level" true (Mqtt.Topic.Name.validate "topic");
38
-
Alcotest.(check bool) "empty topic" false (Mqtt.Topic.Name.validate "");
39
-
Alcotest.(check bool) "wildcard in name" false (Mqtt.Topic.Name.validate "home/+/temp");
40
-
Alcotest.(check bool) "multi wildcard in name" false (Mqtt.Topic.Name.validate "home/#")
40
+
Alcotest.(check bool)
41
+
"simple topic" true
42
+
(Mqtte.Topic.Name.validate "home/sensor/temp");
43
+
Alcotest.(check bool) "single level" true (Mqtte.Topic.Name.validate "topic");
44
+
Alcotest.(check bool) "empty topic" false (Mqtte.Topic.Name.validate "");
45
+
Alcotest.(check bool)
46
+
"wildcard in name" false
47
+
(Mqtte.Topic.Name.validate "home/+/temp");
48
+
Alcotest.(check bool)
49
+
"multi wildcard in name" false
50
+
(Mqtte.Topic.Name.validate "home/#")
41
51
42
52
let test_topic_filter_valid () =
43
-
Alcotest.(check bool) "simple filter" true (Mqtt.Topic.Filter.validate "home/sensor/temp");
44
-
Alcotest.(check bool) "single level wildcard" true (Mqtt.Topic.Filter.validate "home/+/temp");
45
-
Alcotest.(check bool) "multi level wildcard" true (Mqtt.Topic.Filter.validate "home/#");
46
-
Alcotest.(check bool) "multi at end" true (Mqtt.Topic.Filter.validate "home/sensor/#");
47
-
Alcotest.(check bool) "multi not at end" false (Mqtt.Topic.Filter.validate "home/#/temp");
48
-
Alcotest.(check bool) "empty filter" false (Mqtt.Topic.Filter.validate "")
53
+
Alcotest.(check bool)
54
+
"simple filter" true
55
+
(Mqtte.Topic.Filter.validate "home/sensor/temp");
56
+
Alcotest.(check bool)
57
+
"single level wildcard" true
58
+
(Mqtte.Topic.Filter.validate "home/+/temp");
59
+
Alcotest.(check bool)
60
+
"multi level wildcard" true
61
+
(Mqtte.Topic.Filter.validate "home/#");
62
+
Alcotest.(check bool)
63
+
"multi at end" true
64
+
(Mqtte.Topic.Filter.validate "home/sensor/#");
65
+
Alcotest.(check bool)
66
+
"multi not at end" false
67
+
(Mqtte.Topic.Filter.validate "home/#/temp");
68
+
Alcotest.(check bool) "empty filter" false (Mqtte.Topic.Filter.validate "")
49
69
50
70
let test_topic_match () =
51
-
Alcotest.(check bool) "exact match" true (Mqtt.Topic.Filter.matches ~filter:"home/sensor" ~topic:"home/sensor");
52
-
Alcotest.(check bool) "single level wildcard" true (Mqtt.Topic.Filter.matches ~filter:"home/+/temp" ~topic:"home/sensor/temp");
53
-
Alcotest.(check bool) "multi level wildcard" true (Mqtt.Topic.Filter.matches ~filter:"home/#" ~topic:"home/sensor/temp");
54
-
Alcotest.(check bool) "multi at root" true (Mqtt.Topic.Filter.matches ~filter:"#" ~topic:"any/topic/here");
55
-
Alcotest.(check bool) "no match" false (Mqtt.Topic.Filter.matches ~filter:"home/sensor" ~topic:"home/other")
71
+
Alcotest.(check bool)
72
+
"exact match" true
73
+
(Mqtte.Topic.Filter.matches ~filter:"home/sensor" ~topic:"home/sensor");
74
+
Alcotest.(check bool)
75
+
"single level wildcard" true
76
+
(Mqtte.Topic.Filter.matches ~filter:"home/+/temp" ~topic:"home/sensor/temp");
77
+
Alcotest.(check bool)
78
+
"multi level wildcard" true
79
+
(Mqtte.Topic.Filter.matches ~filter:"home/#" ~topic:"home/sensor/temp");
80
+
Alcotest.(check bool)
81
+
"multi at root" true
82
+
(Mqtte.Topic.Filter.matches ~filter:"#" ~topic:"any/topic/here");
83
+
Alcotest.(check bool)
84
+
"no match" false
85
+
(Mqtte.Topic.Filter.matches ~filter:"home/sensor" ~topic:"home/other")
56
86
57
87
(** {1 MQTT v3.1.1 Codec Tests} *)
58
88
59
89
let test_v3_connect () =
60
-
let packet = V3.Connect {
61
-
clean_session = true;
62
-
keep_alive = 60;
63
-
client_id = "test-client";
64
-
will = None;
65
-
credentials = Some (`Username_password ("user", "pass"));
66
-
} in
90
+
let packet =
91
+
V3.Connect
92
+
{
93
+
clean_session = true;
94
+
keep_alive = 60;
95
+
client_id = "test-client";
96
+
will = None;
97
+
credentials = Some (`Username_password ("user", "pass"));
98
+
}
99
+
in
67
100
let decoded = roundtrip_v3 packet in
68
101
match decoded with
69
-
| V3.Connect c ->
70
-
Alcotest.(check string) "client_id" "test-client" c.client_id;
71
-
Alcotest.(check bool) "clean_session" true c.clean_session;
72
-
Alcotest.(check int) "keep_alive" 60 c.keep_alive;
73
-
(match c.credentials with
74
-
| Some (`Username_password (username, password)) ->
75
-
Alcotest.(check string) "username" "user" username;
76
-
Alcotest.(check string) "password" "pass" password
77
-
| _ -> Alcotest.fail "Expected credentials")
102
+
| V3.Connect c -> (
103
+
Alcotest.(check string) "client_id" "test-client" c.client_id;
104
+
Alcotest.(check bool) "clean_session" true c.clean_session;
105
+
Alcotest.(check int) "keep_alive" 60 c.keep_alive;
106
+
match c.credentials with
107
+
| Some (`Username_password (username, password)) ->
108
+
Alcotest.(check string) "username" "user" username;
109
+
Alcotest.(check string) "password" "pass" password
110
+
| _ -> Alcotest.fail "Expected credentials")
78
111
| _ -> Alcotest.fail "Expected Connect packet"
79
112
80
113
let test_v3_connack () =
81
-
let packet = V3.Connack {
82
-
session_present = true;
83
-
return_code = `Accepted;
84
-
} in
114
+
let packet = V3.Connack { session_present = true; return_code = `Accepted } in
85
115
let decoded = roundtrip_v3 packet in
86
116
match decoded with
87
117
| V3.Connack c ->
88
-
Alcotest.(check bool) "session_present" true c.session_present;
89
-
Alcotest.(check bool) "return_code accepted" true (c.return_code = `Accepted)
118
+
Alcotest.(check bool) "session_present" true c.session_present;
119
+
Alcotest.(check bool)
120
+
"return_code accepted" true
121
+
(c.return_code = `Accepted)
90
122
| _ -> Alcotest.fail "Expected Connack packet"
91
123
92
124
let test_v3_publish_qos0 () =
93
-
let packet = V3.Publish {
94
-
dup = false;
95
-
qos = `At_most_once;
96
-
retain = false;
97
-
topic = "test/topic";
98
-
packet_id = None;
99
-
payload = "Hello, MQTT!";
100
-
} in
125
+
let packet =
126
+
V3.Publish
127
+
{
128
+
dup = false;
129
+
qos = `At_most_once;
130
+
retain = false;
131
+
topic = "test/topic";
132
+
packet_id = None;
133
+
payload = "Hello, MQTT!";
134
+
}
135
+
in
101
136
let decoded = roundtrip_v3 packet in
102
137
match decoded with
103
138
| V3.Publish p ->
104
-
Alcotest.(check bool) "dup" false p.dup;
105
-
Alcotest.(check bool) "retain" false p.retain;
106
-
Alcotest.(check string) "topic" "test/topic" p.topic;
107
-
Alcotest.(check string) "payload" "Hello, MQTT!" p.payload
139
+
Alcotest.(check bool) "dup" false p.dup;
140
+
Alcotest.(check bool) "retain" false p.retain;
141
+
Alcotest.(check string) "topic" "test/topic" p.topic;
142
+
Alcotest.(check string) "payload" "Hello, MQTT!" p.payload
108
143
| _ -> Alcotest.fail "Expected Publish packet"
109
144
110
145
let test_v3_publish_qos1 () =
111
-
let packet = V3.Publish {
112
-
dup = false;
113
-
qos = `At_least_once;
114
-
retain = true;
115
-
topic = "test/retained";
116
-
packet_id = Some 1234;
117
-
payload = "Retained message";
118
-
} in
146
+
let packet =
147
+
V3.Publish
148
+
{
149
+
dup = false;
150
+
qos = `At_least_once;
151
+
retain = true;
152
+
topic = "test/retained";
153
+
packet_id = Some 1234;
154
+
payload = "Retained message";
155
+
}
156
+
in
119
157
let decoded = roundtrip_v3 packet in
120
158
match decoded with
121
159
| V3.Publish p ->
122
-
Alcotest.(check bool) "retain" true p.retain;
123
-
Alcotest.(check (option int)) "packet_id" (Some 1234) p.packet_id;
124
-
Alcotest.(check string) "payload" "Retained message" p.payload
160
+
Alcotest.(check bool) "retain" true p.retain;
161
+
Alcotest.(check (option int)) "packet_id" (Some 1234) p.packet_id;
162
+
Alcotest.(check string) "payload" "Retained message" p.payload
125
163
| _ -> Alcotest.fail "Expected Publish packet"
126
164
127
165
let test_v3_subscribe () =
128
-
let packet = V3.Subscribe {
129
-
packet_id = 42;
130
-
topics = [
131
-
Mqtt.V3.Subscription.{ filter = "topic/a"; qos = `At_most_once };
132
-
Mqtt.V3.Subscription.{ filter = "topic/b"; qos = `At_least_once };
133
-
Mqtt.V3.Subscription.{ filter = "topic/c"; qos = `Exactly_once };
134
-
];
135
-
} in
166
+
let packet =
167
+
V3.Subscribe
168
+
{
169
+
packet_id = 42;
170
+
topics =
171
+
[
172
+
Mqtte.V3.Subscription.{ filter = "topic/a"; qos = `At_most_once };
173
+
Mqtte.V3.Subscription.{ filter = "topic/b"; qos = `At_least_once };
174
+
Mqtte.V3.Subscription.{ filter = "topic/c"; qos = `Exactly_once };
175
+
];
176
+
}
177
+
in
136
178
let decoded = roundtrip_v3 packet in
137
179
match decoded with
138
180
| V3.Subscribe s ->
139
-
Alcotest.(check int) "packet_id" 42 s.packet_id;
140
-
Alcotest.(check int) "topics length" 3 (List.length s.topics)
181
+
Alcotest.(check int) "packet_id" 42 s.packet_id;
182
+
Alcotest.(check int) "topics length" 3 (List.length s.topics)
141
183
| _ -> Alcotest.fail "Expected Subscribe packet"
142
184
143
185
let test_v3_suback () =
144
-
let packet = V3.Suback {
145
-
packet_id = 42;
146
-
return_codes = [`Granted_qos_0; `Granted_qos_1; `Granted_qos_2; `Failure];
147
-
} in
186
+
let packet =
187
+
V3.Suback
188
+
{
189
+
packet_id = 42;
190
+
return_codes =
191
+
[ `Granted_qos_0; `Granted_qos_1; `Granted_qos_2; `Failure ];
192
+
}
193
+
in
148
194
let decoded = roundtrip_v3 packet in
149
195
match decoded with
150
196
| V3.Suback s ->
151
-
Alcotest.(check int) "packet_id" 42 s.packet_id;
152
-
Alcotest.(check int) "return_codes length" 4 (List.length s.return_codes)
197
+
Alcotest.(check int) "packet_id" 42 s.packet_id;
198
+
Alcotest.(check int) "return_codes length" 4 (List.length s.return_codes)
153
199
| _ -> Alcotest.fail "Expected Suback packet"
154
200
155
201
let test_v3_pingreq () =
···
176
222
(** {1 MQTT v5.0 Codec Tests} *)
177
223
178
224
let test_v5_connect () =
179
-
let packet = V5.Connect {
180
-
clean_start = true;
181
-
keep_alive = 120;
182
-
client_id = "v5-client";
183
-
will = None;
184
-
credentials = Some (`Username_password ("admin", "secret"));
185
-
properties = [
186
-
Mqtt.V5.Property.Session_expiry_interval 3600l;
187
-
Mqtt.V5.Property.Receive_maximum 100;
188
-
];
189
-
} in
225
+
let packet =
226
+
V5.Connect
227
+
{
228
+
clean_start = true;
229
+
keep_alive = 120;
230
+
client_id = "v5-client";
231
+
will = None;
232
+
credentials = Some (`Username_password ("admin", "secret"));
233
+
properties =
234
+
[
235
+
Mqtte.V5.Property.Session_expiry_interval 3600l;
236
+
Mqtte.V5.Property.Receive_maximum 100;
237
+
];
238
+
}
239
+
in
190
240
let decoded = roundtrip_v5 packet in
191
241
match decoded with
192
242
| V5.Connect c ->
193
-
Alcotest.(check string) "client_id" "v5-client" c.client_id;
194
-
Alcotest.(check bool) "clean_start" true c.clean_start;
195
-
Alcotest.(check int) "keep_alive" 120 c.keep_alive;
196
-
Alcotest.(check int) "properties count" 2 (List.length c.properties)
243
+
Alcotest.(check string) "client_id" "v5-client" c.client_id;
244
+
Alcotest.(check bool) "clean_start" true c.clean_start;
245
+
Alcotest.(check int) "keep_alive" 120 c.keep_alive;
246
+
Alcotest.(check int) "properties count" 2 (List.length c.properties)
197
247
| _ -> Alcotest.fail "Expected V5 Connect packet"
198
248
199
249
let test_v5_connack () =
200
-
let packet = V5.Connack {
201
-
session_present = false;
202
-
reason_code = `Success;
203
-
properties = [
204
-
Mqtt.V5.Property.Topic_alias_maximum 10;
205
-
Mqtt.V5.Property.Maximum_packet_size 65536l;
206
-
];
207
-
} in
250
+
let packet =
251
+
V5.Connack
252
+
{
253
+
session_present = false;
254
+
reason_code = `Success;
255
+
properties =
256
+
[
257
+
Mqtte.V5.Property.Topic_alias_maximum 10;
258
+
Mqtte.V5.Property.Maximum_packet_size 65536l;
259
+
];
260
+
}
261
+
in
208
262
let decoded = roundtrip_v5 packet in
209
263
match decoded with
210
264
| V5.Connack c ->
211
-
Alcotest.(check bool) "session_present" false c.session_present
265
+
Alcotest.(check bool) "session_present" false c.session_present
212
266
| _ -> Alcotest.fail "Expected V5 Connack packet"
213
267
214
268
let test_v5_publish_with_properties () =
215
-
let packet = V5.Publish {
216
-
dup = false;
217
-
qos = `At_least_once;
218
-
retain = false;
219
-
topic = "sensor/data";
220
-
packet_id = Some 100;
221
-
payload = "{\"temp\": 22.5}";
222
-
properties = [
223
-
Mqtt.V5.Property.Content_type "application/json";
224
-
Mqtt.V5.Property.Message_expiry_interval 3600l;
225
-
Mqtt.V5.Property.Topic_alias 5;
226
-
];
227
-
} in
269
+
let packet =
270
+
V5.Publish
271
+
{
272
+
dup = false;
273
+
qos = `At_least_once;
274
+
retain = false;
275
+
topic = "sensor/data";
276
+
packet_id = Some 100;
277
+
payload = "{\"temp\": 22.5}";
278
+
properties =
279
+
[
280
+
Mqtte.V5.Property.Content_type "application/json";
281
+
Mqtte.V5.Property.Message_expiry_interval 3600l;
282
+
Mqtte.V5.Property.Topic_alias 5;
283
+
];
284
+
}
285
+
in
228
286
let decoded = roundtrip_v5 packet in
229
287
match decoded with
230
288
| V5.Publish p ->
231
-
Alcotest.(check string) "topic" "sensor/data" p.topic;
232
-
Alcotest.(check string) "payload" "{\"temp\": 22.5}" p.payload;
233
-
Alcotest.(check int) "properties count" 3 (List.length p.properties)
289
+
Alcotest.(check string) "topic" "sensor/data" p.topic;
290
+
Alcotest.(check string) "payload" "{\"temp\": 22.5}" p.payload;
291
+
Alcotest.(check int) "properties count" 3 (List.length p.properties)
234
292
| _ -> Alcotest.fail "Expected V5 Publish packet"
235
293
236
294
let test_v5_subscribe () =
237
-
let packet = V5.Subscribe {
238
-
packet_id = 55;
239
-
properties = [];
240
-
topics = [
241
-
Mqtt.V5.Subscription.{ filter = "home/+/temperature";
242
-
options = Mqtt.V5.Subscription_options.{ qos = `At_least_once; no_local = true;
243
-
retain_as_published = false; retain_handling = 0 } };
244
-
Mqtt.V5.Subscription.{ filter = "home/#";
245
-
options = Mqtt.V5.Subscription_options.{ qos = `Exactly_once; no_local = false;
246
-
retain_as_published = true; retain_handling = 1 } };
247
-
];
248
-
} in
295
+
let packet =
296
+
V5.Subscribe
297
+
{
298
+
packet_id = 55;
299
+
properties = [];
300
+
topics =
301
+
[
302
+
Mqtte.V5.Subscription.
303
+
{
304
+
filter = "home/+/temperature";
305
+
options =
306
+
Mqtte.V5.Subscription_options.
307
+
{
308
+
qos = `At_least_once;
309
+
no_local = true;
310
+
retain_as_published = false;
311
+
retain_handling = 0;
312
+
};
313
+
};
314
+
Mqtte.V5.Subscription.
315
+
{
316
+
filter = "home/#";
317
+
options =
318
+
Mqtte.V5.Subscription_options.
319
+
{
320
+
qos = `Exactly_once;
321
+
no_local = false;
322
+
retain_as_published = true;
323
+
retain_handling = 1;
324
+
};
325
+
};
326
+
];
327
+
}
328
+
in
249
329
let decoded = roundtrip_v5 packet in
250
330
match decoded with
251
331
| V5.Subscribe s ->
252
-
Alcotest.(check int) "packet_id" 55 s.packet_id;
253
-
Alcotest.(check int) "topics count" 2 (List.length s.topics)
332
+
Alcotest.(check int) "packet_id" 55 s.packet_id;
333
+
Alcotest.(check int) "topics count" 2 (List.length s.topics)
254
334
| _ -> Alcotest.fail "Expected V5 Subscribe packet"
255
335
256
336
let test_v5_disconnect_with_reason () =
257
-
let packet = V5.Disconnect {
258
-
reason_code = `Session_taken_over;
259
-
properties = [Mqtt.V5.Property.Reason_string "Another client connected"];
260
-
} in
337
+
let packet =
338
+
V5.Disconnect
339
+
{
340
+
reason_code = `Session_taken_over;
341
+
properties =
342
+
[ Mqtte.V5.Property.Reason_string "Another client connected" ];
343
+
}
344
+
in
261
345
let decoded = roundtrip_v5 packet in
262
346
match decoded with
263
347
| V5.Disconnect d ->
264
-
Alcotest.(check bool) "reason is session_taken_over" true
265
-
(d.reason_code = `Session_taken_over)
348
+
Alcotest.(check bool)
349
+
"reason is session_taken_over" true
350
+
(d.reason_code = `Session_taken_over)
266
351
| _ -> Alcotest.fail "Expected V5 Disconnect packet"
267
352
268
353
(** {1 Protocol State Tests} *)
···
281
366
282
367
let test_qos1_state_machine () =
283
368
let flow = Protocol.Qos1.create 1 ~topic:"test" ~payload:"data" in
284
-
Alcotest.(check bool) "initial state is Waiting_puback" true
369
+
Alcotest.(check bool)
370
+
"initial state is Waiting_puback" true
285
371
(flow.state = Protocol.Qos1.Waiting_puback);
286
372
let handled = Protocol.Qos1.handle_puback flow 1 in
287
373
Alcotest.(check bool) "puback handled" true handled;
288
-
Alcotest.(check bool) "final state is Complete" true
374
+
Alcotest.(check bool)
375
+
"final state is Complete" true
289
376
(flow.state = Protocol.Qos1.Complete)
290
377
291
378
let test_qos2_sender_state_machine () =
292
379
let flow = Protocol.Qos2_sender.create 1 ~topic:"test" ~payload:"data" in
293
-
Alcotest.(check bool) "initial state is Waiting_pubrec" true
380
+
Alcotest.(check bool)
381
+
"initial state is Waiting_pubrec" true
294
382
(flow.state = Protocol.Qos2_sender.Waiting_pubrec);
295
383
let _ = Protocol.Qos2_sender.handle_pubrec flow 1 in
296
-
Alcotest.(check bool) "after pubrec is Waiting_pubcomp" true
384
+
Alcotest.(check bool)
385
+
"after pubrec is Waiting_pubcomp" true
297
386
(flow.state = Protocol.Qos2_sender.Waiting_pubcomp);
298
387
let _ = Protocol.Qos2_sender.handle_pubcomp flow 1 in
299
-
Alcotest.(check bool) "final state is Complete" true
388
+
Alcotest.(check bool)
389
+
"final state is Complete" true
300
390
(flow.state = Protocol.Qos2_sender.Complete)
301
391
302
392
let test_topic_alias () =
303
393
let aliases = Protocol.Topic_alias.create ~max_outbound:10 ~max_inbound:10 in
304
-
let alias1 = Protocol.Topic_alias.allocate_outbound aliases "home/sensor/temp" in
394
+
let alias1 =
395
+
Protocol.Topic_alias.allocate_outbound aliases "home/sensor/temp"
396
+
in
305
397
Alcotest.(check (option int)) "first alias" (Some 1) alias1;
306
-
let alias2 = Protocol.Topic_alias.allocate_outbound aliases "home/sensor/humidity" in
398
+
let alias2 =
399
+
Protocol.Topic_alias.allocate_outbound aliases "home/sensor/humidity"
400
+
in
307
401
Alcotest.(check (option int)) "second alias" (Some 2) alias2;
308
-
let alias1_again = Protocol.Topic_alias.allocate_outbound aliases "home/sensor/temp" in
402
+
let alias1_again =
403
+
Protocol.Topic_alias.allocate_outbound aliases "home/sensor/temp"
404
+
in
309
405
Alcotest.(check (option int)) "same topic same alias" (Some 1) alias1_again;
310
406
Protocol.Topic_alias.set_inbound aliases 5 "external/topic";
311
407
let topic = Protocol.Topic_alias.get_inbound aliases 5 in
312
-
Alcotest.(check (option string)) "inbound lookup" (Some "external/topic") topic
408
+
Alcotest.(check (option string))
409
+
"inbound lookup" (Some "external/topic") topic
313
410
314
411
(** {1 Test Suites} *)
315
412
316
-
let topic_tests = [
317
-
"valid topic names", `Quick, test_topic_valid;
318
-
"valid topic filters", `Quick, test_topic_filter_valid;
319
-
"topic matching", `Quick, test_topic_match;
320
-
]
413
+
let topic_tests =
414
+
[
415
+
("valid topic names", `Quick, test_topic_valid);
416
+
("valid topic filters", `Quick, test_topic_filter_valid);
417
+
("topic matching", `Quick, test_topic_match);
418
+
]
321
419
322
-
let v3_tests = [
323
-
"connect roundtrip", `Quick, test_v3_connect;
324
-
"connack roundtrip", `Quick, test_v3_connack;
325
-
"publish qos0 roundtrip", `Quick, test_v3_publish_qos0;
326
-
"publish qos1 roundtrip", `Quick, test_v3_publish_qos1;
327
-
"subscribe roundtrip", `Quick, test_v3_subscribe;
328
-
"suback roundtrip", `Quick, test_v3_suback;
329
-
"pingreq roundtrip", `Quick, test_v3_pingreq;
330
-
"pingresp roundtrip", `Quick, test_v3_pingresp;
331
-
"disconnect roundtrip", `Quick, test_v3_disconnect;
332
-
]
420
+
let v3_tests =
421
+
[
422
+
("connect roundtrip", `Quick, test_v3_connect);
423
+
("connack roundtrip", `Quick, test_v3_connack);
424
+
("publish qos0 roundtrip", `Quick, test_v3_publish_qos0);
425
+
("publish qos1 roundtrip", `Quick, test_v3_publish_qos1);
426
+
("subscribe roundtrip", `Quick, test_v3_subscribe);
427
+
("suback roundtrip", `Quick, test_v3_suback);
428
+
("pingreq roundtrip", `Quick, test_v3_pingreq);
429
+
("pingresp roundtrip", `Quick, test_v3_pingresp);
430
+
("disconnect roundtrip", `Quick, test_v3_disconnect);
431
+
]
333
432
334
-
let v5_tests = [
335
-
"connect roundtrip", `Quick, test_v5_connect;
336
-
"connack roundtrip", `Quick, test_v5_connack;
337
-
"publish with properties", `Quick, test_v5_publish_with_properties;
338
-
"subscribe roundtrip", `Quick, test_v5_subscribe;
339
-
"disconnect with reason", `Quick, test_v5_disconnect_with_reason;
340
-
]
433
+
let v5_tests =
434
+
[
435
+
("connect roundtrip", `Quick, test_v5_connect);
436
+
("connack roundtrip", `Quick, test_v5_connack);
437
+
("publish with properties", `Quick, test_v5_publish_with_properties);
438
+
("subscribe roundtrip", `Quick, test_v5_subscribe);
439
+
("disconnect with reason", `Quick, test_v5_disconnect_with_reason);
440
+
]
341
441
342
-
let protocol_tests = [
343
-
"packet id generator", `Quick, test_packet_id_generator;
344
-
"qos1 state machine", `Quick, test_qos1_state_machine;
345
-
"qos2 sender state machine", `Quick, test_qos2_sender_state_machine;
346
-
"topic alias", `Quick, test_topic_alias;
347
-
]
442
+
let protocol_tests =
443
+
[
444
+
("packet id generator", `Quick, test_packet_id_generator);
445
+
("qos1 state machine", `Quick, test_qos1_state_machine);
446
+
("qos2 sender state machine", `Quick, test_qos2_sender_state_machine);
447
+
("topic alias", `Quick, test_topic_alias);
448
+
]
348
449
349
450
let () =
350
-
Alcotest.run "mqtt-eio" [
351
-
"topics", topic_tests;
352
-
"mqtt v3.1.1", v3_tests;
353
-
"mqtt v5.0", v5_tests;
354
-
"protocol", protocol_tests;
355
-
]
451
+
Alcotest.run "mqtt-eio"
452
+
[
453
+
("topics", topic_tests);
454
+
("mqtt v3.1.1", v3_tests);
455
+
("mqtt v5.0", v5_tests);
456
+
("protocol", protocol_tests);
457
+
]