Owntracks location tracking with MQTT and HTTPS (recorder) support
cli
+1057
-134
+3
-3
bin/dune
+3
-3
bin/dune
···
1
1
(executable
2
-
(name owntracks_example)
3
-
(public_name owntracks-subscriber)
2
+
(name main)
3
+
(public_name owntracks)
4
4
(package owntracks)
5
-
(libraries mqtte mqtte.eio owntracks eio_main logs.fmt fmt.tty mirage-crypto-rng.unix))
5
+
(libraries mqtte mqtte.eio mqtte.cmd owntracks eio_main xdge tomlt tomlt.eio logs.fmt fmt.tty mirage-crypto-rng.unix geojson jsont jsont.bytesrw requests))
+921
bin/main.ml
+921
bin/main.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** OwnTracks CLI - Subscribe to OwnTracks location updates over MQTT *)
7
+
8
+
open Cmdliner
9
+
10
+
let app_name = "owntracks"
11
+
12
+
(** {1 Configuration} *)
13
+
14
+
module Config = struct
15
+
type device = { id : string; name : string }
16
+
17
+
let device_codec : device Tomlt.t =
18
+
Tomlt.(
19
+
Table.(
20
+
obj (fun id name -> { id; name })
21
+
|> mem "id" string ~enc:(fun d -> d.id)
22
+
|> mem "name" string ~enc:(fun d -> d.name)
23
+
|> finish))
24
+
25
+
type recorder = {
26
+
url : string option;
27
+
user : string option;
28
+
password : string option;
29
+
}
30
+
31
+
let empty_recorder = { url = None; user = None; password = None }
32
+
33
+
let recorder_codec : recorder Tomlt.t =
34
+
Tomlt.(
35
+
Table.(
36
+
obj (fun url user password -> { url; user; password })
37
+
|> opt_mem "url" string ~enc:(fun r -> r.url)
38
+
|> opt_mem "user" string ~enc:(fun r -> r.user)
39
+
|> opt_mem "password" string ~enc:(fun r -> r.password)
40
+
|> finish))
41
+
42
+
type owntracks = {
43
+
topic : string option;
44
+
default_device : string option;
45
+
recorder : recorder;
46
+
devices : device list;
47
+
}
48
+
49
+
let empty_owntracks = {
50
+
topic = None;
51
+
default_device = None;
52
+
recorder = empty_recorder;
53
+
devices = [];
54
+
}
55
+
56
+
let owntracks_codec : owntracks Tomlt.t =
57
+
Tomlt.(
58
+
Table.(
59
+
obj (fun topic default_device recorder devices ->
60
+
{ topic; default_device;
61
+
recorder = Option.value ~default:empty_recorder recorder;
62
+
devices = Option.value ~default:[] devices })
63
+
|> opt_mem "topic" string ~enc:(fun c -> c.topic)
64
+
|> opt_mem "default_device" string ~enc:(fun c -> c.default_device)
65
+
|> opt_mem "recorder" recorder_codec
66
+
~enc:(fun c -> if c.recorder = empty_recorder then None else Some c.recorder)
67
+
|> opt_mem "devices" (list device_codec)
68
+
~enc:(fun c -> match c.devices with [] -> None | ds -> Some ds)
69
+
|> finish))
70
+
71
+
type t = {
72
+
owntracks : owntracks;
73
+
mqtt : Mqtte_cmd.Config_file.mqtt_config;
74
+
pool : Mqtte_cmd.Config_file.pool_config;
75
+
}
76
+
77
+
let empty =
78
+
{
79
+
owntracks = empty_owntracks;
80
+
mqtt = Mqtte_cmd.Config_file.empty_mqtt_config;
81
+
pool = Mqtte_cmd.Config_file.empty_pool_config;
82
+
}
83
+
84
+
let codec : t Tomlt.t =
85
+
Tomlt.(
86
+
Table.(
87
+
obj (fun owntracks mqtt pool ->
88
+
{
89
+
owntracks = Option.value ~default:empty_owntracks owntracks;
90
+
mqtt =
91
+
Option.value ~default:Mqtte_cmd.Config_file.empty_mqtt_config mqtt;
92
+
pool =
93
+
Option.value ~default:Mqtte_cmd.Config_file.empty_pool_config pool;
94
+
})
95
+
|> opt_mem "owntracks" owntracks_codec
96
+
~enc:(fun c ->
97
+
if c.owntracks = empty_owntracks then None else Some c.owntracks)
98
+
|> opt_mem "mqtt" Mqtte_cmd.Config_file.mqtt_codec
99
+
~enc:(fun c ->
100
+
if c.mqtt = Mqtte_cmd.Config_file.empty_mqtt_config then None
101
+
else Some c.mqtt)
102
+
|> opt_mem "pool" Mqtte_cmd.Config_file.pool_codec
103
+
~enc:(fun c ->
104
+
if c.pool = Mqtte_cmd.Config_file.empty_pool_config then None
105
+
else Some c.pool)
106
+
|> finish))
107
+
108
+
let load xdg =
109
+
match Xdge.find_config_file xdg "owntracks.toml" with
110
+
| Some path ->
111
+
(try Some (Tomlt_eio.decode_file_exn codec path)
112
+
with exn ->
113
+
Logs.warn (fun m ->
114
+
m "Failed to parse owntracks.toml: %s" (Printexc.to_string exn));
115
+
None)
116
+
| None -> None
117
+
118
+
let resolve_device_name config device_id =
119
+
List.find_map
120
+
(fun d -> if d.id = device_id then Some d.name else None)
121
+
config.owntracks.devices
122
+
|> Option.value ~default:device_id
123
+
124
+
let to_mqtt_config t : Mqtte_cmd.Config_file.t = { mqtt = t.mqtt; pool = t.pool }
125
+
126
+
let default_toml =
127
+
{|# OwnTracks Configuration
128
+
129
+
[owntracks]
130
+
# topic = "owntracks/#"
131
+
# default_device = "My Phone"
132
+
133
+
# OwnTracks Recorder HTTP API settings (for historical queries)
134
+
# [owntracks.recorder]
135
+
# url = "https://recorder.example.com"
136
+
# user = "api_user"
137
+
# password = "api_secret"
138
+
139
+
# [[owntracks.devices]]
140
+
# id = "DEVICE-UUID"
141
+
# name = "Alice Phone"
142
+
143
+
[mqtt]
144
+
host = "127.0.0.1"
145
+
port = 1883
146
+
# tls = false
147
+
# username = "user"
148
+
# password = "secret"
149
+
keep_alive = 60
150
+
151
+
[pool]
152
+
max_connections = 10
153
+
idle_timeout = 60.0
154
+
|}
155
+
end
156
+
157
+
(** {1 Message Handling} *)
158
+
159
+
let handle_message config msg =
160
+
let open Mqtte_eio.Client in
161
+
match Owntracks.Mqtt.of_mqtt ~topic:msg.topic ~payload:msg.payload with
162
+
| Ok ot_msg -> (
163
+
match ot_msg.Owntracks.Mqtt.message with
164
+
| Owntracks.Location loc ->
165
+
let user = Option.value ~default:"unknown" ot_msg.user in
166
+
let device = Option.value ~default:"unknown" ot_msg.device in
167
+
let device_name = Config.resolve_device_name config device in
168
+
Format.printf "@[<v 0>-------------------------------------------@,";
169
+
Format.printf " Device: %s" device_name;
170
+
if device_name <> device then Format.printf " (%s)" device;
171
+
Format.printf "@, User: %s@," user;
172
+
Format.printf " Time: %s@," (Owntracks.format_timestamp loc.tst);
173
+
Format.printf " Location: %.6f, %.6f@," loc.lat loc.lon;
174
+
Option.iter (fun v -> Format.printf " Altitude: %.1f m@," v) loc.alt;
175
+
Option.iter (fun v -> Format.printf " Accuracy: +/- %.0f m@," v) loc.acc;
176
+
Option.iter (fun v -> Format.printf " Speed: %.1f km/h@," v) loc.vel;
177
+
Option.iter (fun v -> Format.printf " Battery: %d%%@," v) loc.batt;
178
+
Format.printf "-------------------------------------------@]@."
179
+
| Owntracks.Transition tr ->
180
+
let device = Option.value ~default:"unknown" ot_msg.device in
181
+
let device_name = Config.resolve_device_name config device in
182
+
Format.printf "[%s] %s region: %s@." device_name
183
+
(String.uppercase_ascii tr.t_event)
184
+
(Option.value ~default:"unknown" tr.t_desc)
185
+
| _ -> ())
186
+
| Error err -> Logs.debug (fun m -> m "Failed to parse: %s" err)
187
+
188
+
(** {1 Commands} *)
189
+
190
+
let listen_cmd ~fs =
191
+
let xdg = Xdge.create fs app_name in
192
+
let config = Config.load xdg |> Option.value ~default:Config.empty in
193
+
let mqtt_config = Config.to_mqtt_config config in
194
+
195
+
let run parsed topic =
196
+
Fmt_tty.setup_std_outputs ();
197
+
Logs.set_level (Some Logs.Info);
198
+
Logs.set_reporter (Logs_fmt.reporter ());
199
+
200
+
let mqtt = parsed.Mqtte_cmd.mqtt in
201
+
let conn = mqtt.connection in
202
+
let topic =
203
+
match topic with
204
+
| Some t -> t
205
+
| None ->
206
+
Option.value ~default:Owntracks.Mqtt.default_topic config.owntracks.topic
207
+
in
208
+
209
+
Logs.info (fun m -> m "OwnTracks Location Listener");
210
+
Logs.info (fun m ->
211
+
m "Connecting to %s:%d%s" conn.host conn.port
212
+
(if conn.tls then " (TLS)" else ""));
213
+
Logs.info (fun m -> m "Subscribing to: %s" topic);
214
+
215
+
Eio_main.run @@ fun env ->
216
+
Mirage_crypto_rng_unix.use_default ();
217
+
Eio.Switch.run @@ fun sw ->
218
+
let on_message msg = handle_message config msg in
219
+
let on_disconnect () = Logs.warn (fun m -> m "Disconnected from broker") in
220
+
221
+
let net = Eio.Stdenv.net env in
222
+
let clock = Eio.Stdenv.clock env in
223
+
224
+
let pool =
225
+
Mqtte_cmd.create_pool ~sw ~net ~clock ~tls:conn.tls ~insecure:conn.insecure
226
+
~pool_config:mqtt.pool_config ()
227
+
in
228
+
let endpoint = Mqtte_cmd.endpoint conn in
229
+
230
+
let client =
231
+
Mqtte_eio.Client.connect_with_pool ~sw ~clock ~on_message ~on_disconnect
232
+
~config:mqtt.config ~pool ~endpoint ()
233
+
in
234
+
235
+
Logs.info (fun m -> m "Connected to MQTT broker");
236
+
Mqtte_eio.Client.subscribe ~qos:`At_least_once [ topic ] client;
237
+
Logs.info (fun m -> m "Subscribed to %s" topic);
238
+
Logs.info (fun m -> m "Listening for location updates... (Ctrl+C to exit)");
239
+
240
+
while Mqtte_eio.Client.is_connected client do
241
+
Eio.Time.sleep clock 1.0
242
+
done;
243
+
244
+
Mqtte_eio.Client.disconnect client;
245
+
Logs.info (fun m -> m "Disconnected");
246
+
0
247
+
in
248
+
let topic =
249
+
let doc = "MQTT topic (supports wildcards). Default: owntracks/#" in
250
+
let env = Cmd.Env.info "OWNTRACKS_TOPIC" ~doc in
251
+
Arg.(value & opt (some string) None & info [ "t"; "topic" ] ~docv:"TOPIC" ~doc ~env)
252
+
in
253
+
let term =
254
+
Term.(
255
+
const run
256
+
$ Mqtte_cmd.term_with_config ~app_name ~fs ~config:mqtt_config ()
257
+
$ topic)
258
+
in
259
+
let doc = "Listen for OwnTracks location updates" in
260
+
let man =
261
+
[
262
+
`S Manpage.s_description;
263
+
`P "Connects to an MQTT broker and displays OwnTracks location updates.";
264
+
`S Manpage.s_examples;
265
+
`Pre " owntracks listen -h broker.example.com --tls";
266
+
`Pre " owntracks listen -t 'owntracks/alice/#'";
267
+
]
268
+
@ Mqtte_cmd.man_sections ~app_name
269
+
in
270
+
Cmd.v (Cmd.info "listen" ~doc ~man) term
271
+
272
+
let devices_cmd ~fs:_ =
273
+
let run () =
274
+
Eio_main.run @@ fun env ->
275
+
let xdg = Xdge.create (Eio.Stdenv.fs env) app_name in
276
+
(match Config.load xdg with
277
+
| Some config when config.owntracks.devices <> [] ->
278
+
Format.printf "Configured devices:@.@.";
279
+
List.iter
280
+
(fun (d : Config.device) ->
281
+
let is_default =
282
+
config.owntracks.default_device = Some d.id
283
+
|| config.owntracks.default_device = Some d.name
284
+
in
285
+
Format.printf " %s%s@. ID: %s@."
286
+
d.name
287
+
(if is_default then " (default)" else "")
288
+
d.id)
289
+
config.owntracks.devices
290
+
| Some _ ->
291
+
Format.printf "No devices configured.@.";
292
+
Format.printf "Add to ~/.config/%s/owntracks.toml:@.@." app_name;
293
+
Format.printf " [[owntracks.devices]]@.";
294
+
Format.printf " id = \"DEVICE-UUID\"@.";
295
+
Format.printf " name = \"My Phone\"@."
296
+
| None ->
297
+
Format.printf "No config file. Run 'owntracks init' to create one.@.");
298
+
0
299
+
in
300
+
let doc = "List configured device name mappings" in
301
+
Cmd.v (Cmd.info "devices" ~doc) Term.(const run $ const ())
302
+
303
+
(** {1 GeoJSON Output} *)
304
+
305
+
(** Jsont adapter for the Geojson library *)
306
+
module Jsont_json : Geojson.Json with type t = Jsont.json = struct
307
+
type t = Jsont.json
308
+
309
+
let find json keys =
310
+
let rec go j = function
311
+
| [] -> Some j
312
+
| k :: ks ->
313
+
match j with
314
+
| Jsont.Object (mems, _) ->
315
+
(match List.find_opt (fun ((n, _), _) -> n = k) mems with
316
+
| Some (_, v) -> go v ks
317
+
| None -> None)
318
+
| _ -> None
319
+
in
320
+
go json keys
321
+
322
+
let to_string = function
323
+
| Jsont.String (s, _) -> Ok s
324
+
| _ -> Error (`Msg "expected string")
325
+
326
+
let string s = Jsont.Json.string s
327
+
328
+
let to_float = function
329
+
| Jsont.Number (f, _) -> Ok f
330
+
| _ -> Error (`Msg "expected number")
331
+
332
+
let float f = Jsont.Json.number f
333
+
334
+
let to_int = function
335
+
| Jsont.Number (f, _) -> Ok (int_of_float f)
336
+
| _ -> Error (`Msg "expected number")
337
+
338
+
let int i = Jsont.Json.int i
339
+
340
+
let to_list f = function
341
+
| Jsont.Array (l, _) -> Ok (List.map f l)
342
+
| _ -> Error (`Msg "expected array")
343
+
344
+
let list f l = Jsont.Json.list (List.map f l)
345
+
346
+
let to_array f = function
347
+
| Jsont.Array (l, _) -> Ok (Array.of_list (List.map f l))
348
+
| _ -> Error (`Msg "expected array")
349
+
350
+
let array f a = Jsont.Json.list (List.map f (Array.to_list a))
351
+
352
+
let to_obj = function
353
+
| Jsont.Object (mems, _) -> Ok (List.map (fun ((n, _), v) -> (n, v)) mems)
354
+
| _ -> Error (`Msg "expected object")
355
+
356
+
let obj l = Jsont.Json.object' (List.map (fun (n, v) -> Jsont.Json.mem (Jsont.Json.name n) v) l)
357
+
358
+
let null = Jsont.Json.null ()
359
+
let is_null = function Jsont.Null _ -> true | _ -> false
360
+
end
361
+
362
+
module Geo = Geojson.Make (Jsont_json)
363
+
364
+
module Geojson_output = struct
365
+
let pos_of_loc (loc : Owntracks.location) =
366
+
Geo.Geometry.Position.v ?altitude:loc.alt ~lng:loc.lon ~lat:loc.lat ()
367
+
368
+
let props ~device_name ~timestamp ~time ?accuracy ?speed ?battery ?tracker_id () =
369
+
let open Jsont.Json in
370
+
let add n f opt acc = match opt with Some v -> (n, f v) :: acc | None -> acc in
371
+
[
372
+
("name", string device_name);
373
+
("timestamp", int timestamp);
374
+
("time", string time)
375
+
]
376
+
|> add "accuracy" number accuracy
377
+
|> add "speed" number speed
378
+
|> add "battery" int battery
379
+
|> add "tracker_id" string tracker_id
380
+
|> Jsont_json.obj
381
+
382
+
(** Convert a location to GeoJSON Feature with Point geometry *)
383
+
let point_feature ~device_name (loc : Owntracks.location) : Geo.t =
384
+
let point = Geo.Geometry.Point.v (pos_of_loc loc) in
385
+
let geom = Geo.Geometry.v (Point point) in
386
+
let properties = Some (props ~device_name ~timestamp:loc.tst
387
+
~time:(Owntracks.format_timestamp loc.tst)
388
+
?accuracy:loc.acc ?speed:loc.vel ?battery:loc.batt ?tracker_id:loc.tid ()) in
389
+
let feature = Geo.Feature.v ?properties geom in
390
+
Geo.v (Feature feature)
391
+
392
+
(** Convert a list of locations to GeoJSON Feature with LineString geometry *)
393
+
let linestring_feature ~device_name (locs : Owntracks.location list) : Geo.t =
394
+
let sorted = List.sort (fun a b -> Int.compare a.Owntracks.tst b.Owntracks.tst) locs in
395
+
let positions = Array.of_list (List.map pos_of_loc sorted) in
396
+
let line = Geo.Geometry.LineString.v positions in
397
+
let geom = Geo.Geometry.v (LineString line) in
398
+
let start_time = match sorted with [] -> 0 | h :: _ -> h.tst in
399
+
let end_time = match List.rev sorted with [] -> 0 | h :: _ -> h.tst in
400
+
let properties = Some (Jsont_json.obj [
401
+
("name", Jsont.Json.string device_name);
402
+
("points", Jsont.Json.int (List.length sorted));
403
+
("start_time", Jsont.Json.string (Owntracks.format_timestamp start_time));
404
+
("end_time", Jsont.Json.string (Owntracks.format_timestamp end_time));
405
+
]) in
406
+
let feature = Geo.Feature.v ?properties geom in
407
+
Geo.v (Feature feature)
408
+
409
+
let to_string geo =
410
+
let json = Geo.to_json geo in
411
+
match Jsont_bytesrw.encode_string Jsont.json json with
412
+
| Ok s -> s
413
+
| Error e -> failwith e
414
+
end
415
+
416
+
(** {1 OwnTracks Recorder HTTP API} *)
417
+
418
+
module Recorder = struct
419
+
(** Query the OwnTracks Recorder HTTP API for historical locations.
420
+
API: GET /api/0/locations?user=USER&device=DEVICE&from=YYYY-MM-DD&to=YYYY-MM-DD *)
421
+
422
+
let location_of_json (json : Jsont.json) : Owntracks.location option =
423
+
let get_float key =
424
+
match json with
425
+
| Jsont.Object (mems, _) ->
426
+
List.find_map (fun ((k, _), v) ->
427
+
if k = key then
428
+
match v with
429
+
| Jsont.Number (f, _) -> Some f
430
+
| _ -> None
431
+
else None) mems
432
+
| _ -> None
433
+
in
434
+
let get_int key = Option.map int_of_float (get_float key) in
435
+
let get_string key =
436
+
match json with
437
+
| Jsont.Object (mems, _) ->
438
+
List.find_map (fun ((k, _), v) ->
439
+
if k = key then
440
+
match v with
441
+
| Jsont.String (s, _) -> Some s
442
+
| _ -> None
443
+
else None) mems
444
+
| _ -> None
445
+
in
446
+
match (get_float "lat", get_float "lon", get_int "tst") with
447
+
| (Some lat, Some lon, Some tst) ->
448
+
Some {
449
+
Owntracks.lat; lon; tst;
450
+
tid = get_string "tid";
451
+
alt = get_float "alt";
452
+
acc = get_float "acc";
453
+
vel = get_float "vel";
454
+
cog = get_float "cog";
455
+
batt = get_int "batt";
456
+
bs = get_int "bs";
457
+
conn = get_string "conn";
458
+
t = get_string "t";
459
+
m = get_int "m";
460
+
poi = get_string "poi";
461
+
inregions = [];
462
+
addr = get_string "addr";
463
+
topic = get_string "topic";
464
+
}
465
+
| _ -> None
466
+
467
+
let parse_locations_json json_str : Owntracks.location list =
468
+
match Jsont_bytesrw.decode_string Jsont.json json_str with
469
+
| Error _ -> []
470
+
| Ok json ->
471
+
match json with
472
+
| Jsont.Array (items, _) ->
473
+
List.filter_map location_of_json items
474
+
| Jsont.Object (mems, _) ->
475
+
(* Sometimes the API returns { "data": [...] } *)
476
+
(match List.find_opt (fun ((k, _), _) -> k = "data") mems with
477
+
| Some (_, Jsont.Array (items, _)) -> List.filter_map location_of_json items
478
+
| _ -> [])
479
+
| _ -> []
480
+
481
+
let parse_string_list json_str : string list =
482
+
match Jsont_bytesrw.decode_string Jsont.json json_str with
483
+
| Error _ -> []
484
+
| Ok json ->
485
+
match json with
486
+
| Jsont.Object (mems, _) ->
487
+
(* API returns { "results": ["user1", "user2", ...] } *)
488
+
(match List.find_opt (fun ((k, _), _) -> k = "results") mems with
489
+
| Some (_, Jsont.Array (items, _)) ->
490
+
List.filter_map (function
491
+
| Jsont.String (s, _) -> Some s
492
+
| _ -> None) items
493
+
| _ -> [])
494
+
| Jsont.Array (items, _) ->
495
+
List.filter_map (function
496
+
| Jsont.String (s, _) -> Some s
497
+
| _ -> None) items
498
+
| _ -> []
499
+
500
+
let list_users ~sw env ~verbose_http ~recorder_url ?auth () : string list =
501
+
let url = Printf.sprintf "%s/api/0/list" recorder_url in
502
+
if verbose_http then begin
503
+
Logs.set_level (Some Logs.Debug);
504
+
Logs.set_reporter (Logs_fmt.reporter ())
505
+
end;
506
+
let session = Requests.create ~sw env in
507
+
let headers = match auth with
508
+
| Some (username, password) ->
509
+
Requests.Headers.empty |> Requests.Headers.basic ~username ~password
510
+
| None -> Requests.Headers.empty
511
+
in
512
+
let response = Requests.get ~headers session url in
513
+
if Requests.Response.ok response then begin
514
+
let body = Requests.Response.body response |> Eio.Flow.read_all in
515
+
parse_string_list body
516
+
end else begin
517
+
Format.eprintf "HTTP error: %d@." (Requests.Response.status_code response);
518
+
[]
519
+
end
520
+
521
+
let list_devices ~sw env ~verbose_http ~recorder_url ~user ?auth () : string list =
522
+
let url = Printf.sprintf "%s/api/0/list?user=%s" recorder_url (Uri.pct_encode user) in
523
+
if verbose_http then begin
524
+
Logs.set_level (Some Logs.Debug);
525
+
Logs.set_reporter (Logs_fmt.reporter ())
526
+
end;
527
+
let session = Requests.create ~sw env in
528
+
let headers = match auth with
529
+
| Some (username, password) ->
530
+
Requests.Headers.empty |> Requests.Headers.basic ~username ~password
531
+
| None -> Requests.Headers.empty
532
+
in
533
+
let response = Requests.get ~headers session url in
534
+
if Requests.Response.ok response then begin
535
+
let body = Requests.Response.body response |> Eio.Flow.read_all in
536
+
parse_string_list body
537
+
end else begin
538
+
Format.eprintf "HTTP error: %d@." (Requests.Response.status_code response);
539
+
[]
540
+
end
541
+
542
+
let fetch_locations ~sw env ~verbose_http ~recorder_url ~user ~device ~from_date ~to_date ?auth () : Owntracks.location list =
543
+
let url = Printf.sprintf "%s/api/0/locations?user=%s&device=%s&from=%s&to=%s"
544
+
recorder_url
545
+
(Uri.pct_encode user)
546
+
(Uri.pct_encode device)
547
+
from_date
548
+
to_date
549
+
in
550
+
Format.eprintf "Fetching from %s...@." url;
551
+
(* Set up verbose logging if requested *)
552
+
if verbose_http then begin
553
+
Logs.set_level (Some Logs.Debug);
554
+
Logs.set_reporter (Logs_fmt.reporter ())
555
+
end;
556
+
let session = Requests.create ~sw env in
557
+
let headers = match auth with
558
+
| Some (username, password) ->
559
+
Requests.Headers.empty |> Requests.Headers.basic ~username ~password
560
+
| None -> Requests.Headers.empty
561
+
in
562
+
let response = Requests.get ~headers session url in
563
+
if Requests.Response.ok response then begin
564
+
let body = Requests.Response.body response |> Eio.Flow.read_all in
565
+
parse_locations_json body
566
+
end else begin
567
+
Format.eprintf "HTTP error: %d@." (Requests.Response.status_code response);
568
+
[]
569
+
end
570
+
end
571
+
572
+
let geojson_cmd ~fs =
573
+
let xdg = Xdge.create fs app_name in
574
+
let config = Config.load xdg |> Option.value ~default:Config.empty in
575
+
let mqtt_config = Config.to_mqtt_config config in
576
+
577
+
(* Helper to get today's date as YYYY-MM-DD *)
578
+
let today () =
579
+
let now = Unix.gettimeofday () in
580
+
let tm = Unix.gmtime now in
581
+
Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
582
+
in
583
+
584
+
let run parsed topic device duration track from_date to_date user recorder_url recorder_user recorder_password verbose_http =
585
+
let device = match device with Some _ -> device | None -> config.owntracks.default_device in
586
+
let recorder_url = match recorder_url with Some _ -> recorder_url | None -> config.owntracks.recorder.url in
587
+
let recorder_user = match recorder_user with Some _ -> recorder_user | None -> config.owntracks.recorder.user in
588
+
let recorder_password = match recorder_password with Some _ -> recorder_password | None -> config.owntracks.recorder.password in
589
+
590
+
(* If --from is specified, use HTTP API instead of MQTT *)
591
+
match from_date with
592
+
| Some from_date ->
593
+
let to_date = Option.value to_date ~default:(today ()) in
594
+
(* Default user from config recorder.user, then "owntracks" *)
595
+
let user = match user with
596
+
| Some u -> u
597
+
| None -> Option.value config.owntracks.recorder.user ~default:"owntracks"
598
+
in
599
+
(* Default device from config default_device, then "phone" *)
600
+
let device = Option.value device ~default:(Option.value config.owntracks.default_device ~default:"phone") in
601
+
(match recorder_url with
602
+
| None ->
603
+
Format.eprintf "Error: --recorder-url or recorder_url config required for historical queries@.";
604
+
1
605
+
| Some recorder_url ->
606
+
let auth = match (recorder_user, recorder_password) with
607
+
| (Some u, Some p) -> Some (u, p)
608
+
| _ -> None
609
+
in
610
+
Eio_main.run @@ fun env ->
611
+
Mirage_crypto_rng_unix.use_default ();
612
+
Eio.Switch.run @@ fun sw ->
613
+
let locations = Recorder.fetch_locations ~sw env ~verbose_http ~recorder_url ~user ~device ~from_date ~to_date ?auth () in
614
+
match locations with
615
+
| [] ->
616
+
Format.eprintf "No locations found for %s/%s from %s to %s@." user device from_date to_date;
617
+
1
618
+
| locs ->
619
+
let device_name = Config.resolve_device_name config device in
620
+
let json = Geojson_output.linestring_feature ~device_name locs in
621
+
print_endline (Geojson_output.to_string json);
622
+
0)
623
+
| None ->
624
+
(* Use MQTT for real-time data *)
625
+
let mqtt = parsed.Mqtte_cmd.mqtt in
626
+
let conn = mqtt.connection in
627
+
let topic =
628
+
Option.value topic
629
+
~default:(Option.value ~default:Owntracks.Mqtt.default_topic config.owntracks.topic)
630
+
in
631
+
let result = ref None in
632
+
let track_points = ref [] in
633
+
let track_device_name = ref "unknown" in
634
+
635
+
Eio_main.run @@ fun env ->
636
+
Mirage_crypto_rng_unix.use_default ();
637
+
Eio.Switch.run @@ fun sw ->
638
+
let net = Eio.Stdenv.net env in
639
+
let clock = Eio.Stdenv.clock env in
640
+
641
+
let on_message msg =
642
+
let open Mqtte_eio.Client in
643
+
match Owntracks.Mqtt.of_mqtt ~topic:msg.topic ~payload:msg.payload with
644
+
| Ok ot_msg -> (
645
+
match ot_msg.Owntracks.Mqtt.message with
646
+
| Owntracks.Location loc ->
647
+
let msg_device = Option.value ~default:"unknown" ot_msg.device in
648
+
let matches = match device with
649
+
| None -> true
650
+
| Some d -> d = msg_device || d = Config.resolve_device_name config msg_device
651
+
in
652
+
if matches then begin
653
+
let device_name = Config.resolve_device_name config msg_device in
654
+
if track then begin
655
+
track_device_name := device_name;
656
+
track_points := loc :: !track_points
657
+
end else if Option.is_none !result then
658
+
result := Some (Geojson_output.point_feature ~device_name loc)
659
+
end
660
+
| _ -> ())
661
+
| Error _ -> ()
662
+
in
663
+
let on_disconnect () = () in
664
+
665
+
let pool =
666
+
Mqtte_cmd.create_pool ~sw ~net ~clock ~tls:conn.tls ~insecure:conn.insecure
667
+
~pool_config:mqtt.pool_config ()
668
+
in
669
+
let endpoint = Mqtte_cmd.endpoint conn in
670
+
671
+
let client =
672
+
Mqtte_eio.Client.connect_with_pool ~sw ~clock ~on_message ~on_disconnect
673
+
~config:mqtt.config ~pool ~endpoint ()
674
+
in
675
+
676
+
Mqtte_eio.Client.subscribe ~qos:`At_least_once [ topic ] client;
677
+
678
+
if track then begin
679
+
(* Track mode: collect points for the full duration *)
680
+
let deadline = Eio.Time.now clock +. duration in
681
+
Format.eprintf "Collecting track for %.0f seconds...@." duration;
682
+
while Eio.Time.now clock < deadline && Mqtte_eio.Client.is_connected client do
683
+
Eio.Time.sleep clock 0.5
684
+
done;
685
+
Mqtte_eio.Client.disconnect client;
686
+
match !track_points with
687
+
| [] ->
688
+
Format.eprintf "No locations received within %.0f seconds@." duration;
689
+
1
690
+
| points ->
691
+
let json = Geojson_output.linestring_feature ~device_name:!track_device_name points in
692
+
print_endline (Geojson_output.to_string json);
693
+
0
694
+
end else begin
695
+
(* Single point mode: wait for first location then exit immediately *)
696
+
let deadline = Eio.Time.now clock +. duration in
697
+
while Option.is_none !result && Eio.Time.now clock < deadline && Mqtte_eio.Client.is_connected client do
698
+
Eio.Time.sleep clock 0.1
699
+
done;
700
+
Mqtte_eio.Client.disconnect client;
701
+
match !result with
702
+
| Some json ->
703
+
print_endline (Geojson_output.to_string json);
704
+
0
705
+
| None ->
706
+
Format.eprintf "No location received within %.0f seconds@." duration;
707
+
1
708
+
end
709
+
in
710
+
let topic =
711
+
let doc = "MQTT topic (supports wildcards). Default: owntracks/#" in
712
+
Arg.(value & opt (some string) None & info [ "t"; "topic" ] ~docv:"TOPIC" ~doc)
713
+
in
714
+
let device =
715
+
let doc = "Filter by device name or ID. Defaults to default_device from config." in
716
+
Arg.(value & opt (some string) None & info [ "d"; "device" ] ~docv:"DEVICE" ~doc)
717
+
in
718
+
let duration =
719
+
let doc = "Duration in seconds to wait for location (single point) or collect track data (with --track)" in
720
+
Arg.(value & opt float 30.0 & info [ "duration" ] ~docv:"SECONDS" ~doc)
721
+
in
722
+
let track =
723
+
let doc = "Collect a track (LineString) instead of a single point. \
724
+
Use --duration to set collection duration (e.g., --duration 86400 for 24h)." in
725
+
Arg.(value & flag & info [ "track" ] ~doc)
726
+
in
727
+
let from_date =
728
+
let doc = "Start date for historical query (YYYY-MM-DD). Uses HTTP API instead of MQTT." in
729
+
Arg.(value & opt (some string) None & info [ "from" ] ~docv:"DATE" ~doc)
730
+
in
731
+
let to_date =
732
+
let doc = "End date for historical query (YYYY-MM-DD). Defaults to today." in
733
+
Arg.(value & opt (some string) None & info [ "to" ] ~docv:"DATE" ~doc)
734
+
in
735
+
let user =
736
+
let doc = "OwnTracks user for HTTP API queries. Default: owntracks" in
737
+
Arg.(value & opt (some string) None & info [ "user" ] ~docv:"USER" ~doc)
738
+
in
739
+
let recorder_url =
740
+
let doc = "OwnTracks Recorder URL (e.g., https://recorder.example.com). \
741
+
Can also be set in config as [owntracks.recorder] url." in
742
+
Arg.(value & opt (some string) None & info [ "recorder-url" ] ~docv:"URL" ~doc)
743
+
in
744
+
let recorder_user =
745
+
let doc = "User for HTTP Basic Auth to OwnTracks Recorder. \
746
+
Can also be set in config as [owntracks.recorder] user." in
747
+
Arg.(value & opt (some string) None & info [ "recorder-user" ] ~docv:"USER" ~doc)
748
+
in
749
+
let recorder_password =
750
+
let doc = "Password for HTTP Basic Auth to OwnTracks Recorder. \
751
+
Can also be set in config as [owntracks.recorder] password." in
752
+
Arg.(value & opt (some string) None & info [ "recorder-password" ] ~docv:"PASS" ~doc)
753
+
in
754
+
let verbose_http =
755
+
let doc = "Enable verbose HTTP-level logging for debugging recorder requests." in
756
+
Arg.(value & flag & info [ "verbose-http" ] ~doc)
757
+
in
758
+
let term =
759
+
Term.(
760
+
const run
761
+
$ Mqtte_cmd.term_with_config ~app_name ~fs ~config:mqtt_config ()
762
+
$ topic $ device $ duration $ track $ from_date $ to_date $ user $ recorder_url
763
+
$ recorder_user $ recorder_password $ verbose_http)
764
+
in
765
+
let doc = "Output device location as GeoJSON" in
766
+
let man =
767
+
[
768
+
`S Manpage.s_description;
769
+
`P "Connects to MQTT and outputs location data as GeoJSON.";
770
+
`P "By default, outputs the first location as a GeoJSON Feature with Point geometry. \
771
+
With $(b,--track), collects locations for the specified duration and outputs a \
772
+
LineString showing the movement path.";
773
+
`P "With $(b,--from), queries the OwnTracks Recorder HTTP API for historical data \
774
+
instead of using MQTT. Requires $(b,--recorder-url) or recorder_url in config.";
775
+
`S Manpage.s_examples;
776
+
`Pre " owntracks geojson";
777
+
`Pre " owntracks geojson -d 'My Phone' --duration 60";
778
+
`Pre " owntracks geojson --track --duration 3600 # 1 hour track";
779
+
`Pre " owntracks geojson --from 2024-01-12 --to 2024-01-13 # historical";
780
+
`Pre " owntracks geojson --from 2024-01-12 --recorder-url https://recorder.example.com";
781
+
]
782
+
in
783
+
Cmd.v (Cmd.info "geojson" ~doc ~man) term
784
+
785
+
let recorder_cmd ~fs =
786
+
let xdg = Xdge.create fs app_name in
787
+
let config = Config.load xdg |> Option.value ~default:Config.empty in
788
+
789
+
let run recorder_url recorder_user recorder_password user verbose_http =
790
+
let recorder_url = match recorder_url with Some _ -> recorder_url | None -> config.owntracks.recorder.url in
791
+
let recorder_user = match recorder_user with Some _ -> recorder_user | None -> config.owntracks.recorder.user in
792
+
let recorder_password = match recorder_password with Some _ -> recorder_password | None -> config.owntracks.recorder.password in
793
+
794
+
match recorder_url with
795
+
| None ->
796
+
Format.eprintf "Error: --recorder-url or [owntracks.recorder] url config required@.";
797
+
1
798
+
| Some recorder_url ->
799
+
let auth = match (recorder_user, recorder_password) with
800
+
| (Some u, Some p) -> Some (u, p)
801
+
| _ -> None
802
+
in
803
+
Eio_main.run @@ fun env ->
804
+
Mirage_crypto_rng_unix.use_default ();
805
+
Eio.Switch.run @@ fun sw ->
806
+
match user with
807
+
| None ->
808
+
(* List all users *)
809
+
let users = Recorder.list_users ~sw env ~verbose_http ~recorder_url ?auth () in
810
+
(match users with
811
+
| [] ->
812
+
Format.printf "No users found (or unable to access recorder).@.";
813
+
1
814
+
| users ->
815
+
Format.printf "Users on recorder:@.";
816
+
List.iter (fun u -> Format.printf " %s@." u) users;
817
+
0)
818
+
| Some user ->
819
+
(* List devices for user *)
820
+
let devices = Recorder.list_devices ~sw env ~verbose_http ~recorder_url ~user ?auth () in
821
+
(match devices with
822
+
| [] ->
823
+
Format.printf "No devices found for user '%s'.@." user;
824
+
1
825
+
| devices ->
826
+
Format.printf "Devices for user '%s':@." user;
827
+
List.iter (fun d -> Format.printf " %s@." d) devices;
828
+
0)
829
+
in
830
+
let recorder_url =
831
+
let doc = "OwnTracks Recorder URL (e.g., https://recorder.example.com)." in
832
+
Arg.(value & opt (some string) None & info [ "recorder-url" ] ~docv:"URL" ~doc)
833
+
in
834
+
let recorder_user =
835
+
let doc = "User for HTTP Basic Auth to OwnTracks Recorder." in
836
+
Arg.(value & opt (some string) None & info [ "recorder-user" ] ~docv:"USER" ~doc)
837
+
in
838
+
let recorder_password =
839
+
let doc = "Password for HTTP Basic Auth to OwnTracks Recorder." in
840
+
Arg.(value & opt (some string) None & info [ "recorder-password" ] ~docv:"PASS" ~doc)
841
+
in
842
+
let user =
843
+
let doc = "List devices for this user. If omitted, lists all users." in
844
+
Arg.(value & opt (some string) None & info [ "user" ] ~docv:"USER" ~doc)
845
+
in
846
+
let verbose_http =
847
+
let doc = "Enable verbose HTTP-level logging." in
848
+
Arg.(value & flag & info [ "verbose-http" ] ~doc)
849
+
in
850
+
let term =
851
+
Term.(const run $ recorder_url $ recorder_user $ recorder_password $ user $ verbose_http)
852
+
in
853
+
let doc = "List users and devices from OwnTracks Recorder" in
854
+
let man =
855
+
[
856
+
`S Manpage.s_description;
857
+
`P "Query the OwnTracks Recorder HTTP API to list available users and devices.";
858
+
`P "Without $(b,--user), lists all users. With $(b,--user), lists devices for that user.";
859
+
`S Manpage.s_examples;
860
+
`Pre " owntracks recorder # list all users";
861
+
`Pre " owntracks recorder --user avsm # list devices for user 'avsm'";
862
+
]
863
+
in
864
+
Cmd.v (Cmd.info "recorder" ~doc ~man) term
865
+
866
+
let init_cmd ~fs:_ =
867
+
let run force =
868
+
Eio_main.run @@ fun env ->
869
+
let xdg = Xdge.create (Eio.Stdenv.fs env) app_name in
870
+
let path = Eio.Path.(Xdge.config_dir xdg / "owntracks.toml") in
871
+
let exists = Eio.Path.is_file path in
872
+
if exists && not force then begin
873
+
Format.printf "Config exists: %s@.Use --force to overwrite.@."
874
+
(Eio.Path.native_exn path);
875
+
1
876
+
end
877
+
else begin
878
+
Eio.Path.save ~create:(`Or_truncate 0o644) path Config.default_toml;
879
+
Format.printf "%s: %s@."
880
+
(if exists then "Overwrote" else "Created")
881
+
(Eio.Path.native_exn path);
882
+
0
883
+
end
884
+
in
885
+
let force = Arg.(value & flag & info [ "f"; "force" ] ~doc:"Overwrite existing") in
886
+
let doc = "Create default configuration file" in
887
+
Cmd.v (Cmd.info "init" ~doc) Term.(const run $ force)
888
+
889
+
(** {1 Main} *)
890
+
891
+
let () =
892
+
let main_cmd ~fs =
893
+
let doc = "OwnTracks location tracking CLI" in
894
+
let man =
895
+
[
896
+
`S Manpage.s_description;
897
+
`P "Subscribe to OwnTracks location updates over MQTT.";
898
+
`S "CONFIGURATION";
899
+
`P (Printf.sprintf "Settings are stored in ~/.config/%s/owntracks.toml:" app_name);
900
+
`Pre
901
+
{|[owntracks]
902
+
topic = "owntracks/#"
903
+
[[owntracks.devices]]
904
+
id = "DEVICE-UUID"
905
+
name = "My Phone"
906
+
907
+
[mqtt]
908
+
host = "mqtt.example.com"
909
+
port = 8883
910
+
tls = true
911
+
username = "user"
912
+
password = "secret"|};
913
+
`P "Run $(b,owntracks init) to create a config file.";
914
+
]
915
+
in
916
+
let default = Term.(ret (const (`Help (`Pager, None)))) in
917
+
Cmd.group (Cmd.info app_name ~version:"0.1.0" ~doc ~man) ~default
918
+
[ listen_cmd ~fs; geojson_cmd ~fs; recorder_cmd ~fs; devices_cmd ~fs; init_cmd ~fs ]
919
+
in
920
+
Eio_main.run @@ fun env ->
921
+
exit (Cmd.eval' (main_cmd ~fs:(Eio.Stdenv.fs env)))
-121
bin/owntracks_example.ml
-121
bin/owntracks_example.ml
···
1
-
(** OwnTracks MQTT Location Subscriber
2
-
3
-
This example connects to an MQTT broker and subscribes to OwnTracks
4
-
location messages, pretty-printing the received data.
5
-
6
-
Usage:
7
-
owntracks-subscriber [OPTIONS]
8
-
9
-
Options can also be set via environment variables:
10
-
MQTT_HOST - MQTT broker hostname (default: 127.0.0.1)
11
-
MQTT_PORT - MQTT broker port (default: 1883, or 8883 with --tls)
12
-
MQTT_TLS - Enable TLS (set to any value)
13
-
MQTT_USER - MQTT username (optional)
14
-
MQTT_PASSWORD - MQTT password (optional)
15
-
MQTT_CLIENT_ID - MQTT client ID (optional)
16
-
17
-
See vendor/git/recorder for the OwnTracks Recorder reference implementation.
18
-
*)
19
-
20
-
open Cmdliner
21
-
22
-
let topic =
23
-
let doc = "OwnTracks topic to subscribe to. Supports MQTT wildcards." in
24
-
let env = Cmd.Env.info "OT_TOPIC" ~doc in
25
-
Arg.(value & opt string "owntracks/#" &
26
-
info ["t"; "topic"] ~docv:"TOPIC" ~doc ~env)
27
-
28
-
let run mqtt topic =
29
-
Fmt_tty.setup_std_outputs ();
30
-
Logs.set_level (Some Logs.Info);
31
-
Logs.set_reporter (Logs_fmt.reporter ());
32
-
33
-
let conn = mqtt.Mqtte_eio.Cmd.connection in
34
-
let config = mqtt.Mqtte_eio.Cmd.config in
35
-
let pool_config = mqtt.Mqtte_eio.Cmd.pool_config in
36
-
37
-
Logs.info (fun m -> m "OwnTracks MQTT Subscriber");
38
-
Logs.info (fun m -> m "Connecting to %s:%d%s" conn.host conn.port
39
-
(if conn.tls then " (TLS)" else ""));
40
-
Logs.info (fun m -> m "Subscribing to: %s" topic);
41
-
42
-
Eio_main.run @@ fun env ->
43
-
Mirage_crypto_rng_unix.use_default ();
44
-
Eio.Switch.run @@ fun sw ->
45
-
46
-
let on_message msg =
47
-
let open Mqtte_eio.Client in
48
-
let payload_with_topic =
49
-
let payload = msg.payload in
50
-
if String.length payload > 0 && payload.[0] = '{' then
51
-
let topic_json = Printf.sprintf "{\"topic\":%S," msg.topic in
52
-
topic_json ^ String.sub payload 1 (String.length payload - 1)
53
-
else
54
-
payload
55
-
in
56
-
match Owntracks.decode_message payload_with_topic with
57
-
| Ok message ->
58
-
Format.printf "%a@." Owntracks.pp_message message
59
-
| Error err ->
60
-
Logs.warn (fun m -> m "Failed to parse message on [%s]: %s"
61
-
msg.topic err);
62
-
Logs.debug (fun m -> m "Raw payload: %s" msg.payload)
63
-
in
64
-
65
-
let on_disconnect () =
66
-
Logs.warn (fun m -> m "Disconnected from broker")
67
-
in
68
-
69
-
let net = Eio.Stdenv.net env in
70
-
let clock = Eio.Stdenv.clock env in
71
-
72
-
let pool = Mqtte_eio.Cmd.create_pool ~sw ~net ~clock
73
-
~tls:conn.tls ~insecure:conn.insecure ~pool_config () in
74
-
let endpoint = Mqtte_eio.Cmd.endpoint conn in
75
-
76
-
let client = Mqtte_eio.Client.connect_with_pool
77
-
~sw
78
-
~clock
79
-
~on_message
80
-
~on_disconnect
81
-
~config
82
-
~pool
83
-
~endpoint
84
-
()
85
-
in
86
-
87
-
Logs.info (fun m -> m "Connected to MQTT broker");
88
-
89
-
Mqtte_eio.Client.subscribe ~qos:`At_least_once [topic] client;
90
-
Logs.info (fun m -> m "Subscribed to %s" topic);
91
-
92
-
Logs.info (fun m -> m "Listening for OwnTracks location updates...");
93
-
Logs.info (fun m -> m "(Press Ctrl+C to exit)");
94
-
95
-
while Mqtte_eio.Client.is_connected client do
96
-
Eio.Time.sleep clock 1.0
97
-
done;
98
-
99
-
Mqtte_eio.Client.disconnect client;
100
-
Logs.info (fun m -> m "Disconnected")
101
-
102
-
let term =
103
-
Term.(const run $ Mqtte_eio.Cmd.term $ topic)
104
-
105
-
let cmd =
106
-
let doc = "Subscribe to OwnTracks location messages over MQTT" in
107
-
let man = [
108
-
`S Manpage.s_description;
109
-
`P "Connects to an MQTT broker and subscribes to OwnTracks location \
110
-
messages, pretty-printing the received data.";
111
-
`S Manpage.s_examples;
112
-
`Pre " owntracks-subscriber -h broker.example.com -p 1883 -t 'owntracks/#'";
113
-
`Pre " owntracks-subscriber -h secure.example.com --tls -u user";
114
-
`Pre " MQTT_HOST=broker.example.com owntracks-subscriber";
115
-
`S Manpage.s_bugs;
116
-
`P "Report bugs at https://github.com/example/mqtt-eio/issues";
117
-
] in
118
-
let info = Cmd.info "owntracks-subscriber" ~version:"0.1.0" ~doc ~man in
119
-
Cmd.v info term
120
-
121
-
let () = exit (Cmd.eval cmd)
+13
-3
dune-project
+13
-3
dune-project
···
9
9
10
10
(package
11
11
(name owntracks)
12
-
(synopsis "OwnTracks message types and JSON codecs")
13
-
(description "Types and codecs for parsing OwnTracks MQTT location messages using jsont")
12
+
(synopsis "OwnTracks message types, JSON codecs, and MQTT client")
13
+
(description "Types and codecs for parsing OwnTracks MQTT location messages using jsont, with an MQTT client for subscribing to location updates")
14
14
(depends
15
15
(ocaml (>= 5.1))
16
-
jsont))
16
+
jsont
17
+
geojson
18
+
requests
19
+
(mqtte (>= 0.1))
20
+
(eio (>= 1.0))
21
+
(eio_main (>= 1.0))
22
+
xdge
23
+
tomlt
24
+
(cmdliner (>= 1.2))
25
+
(logs (>= 0.7))
26
+
(fmt (>= 0.9))))
+108
-5
lib/owntracks.ml
+108
-5
lib/owntracks.ml
···
86
86
87
87
(** Location message codec. *)
88
88
let location_jsont : location Jsont.t =
89
-
let make tid tst lat lon alt acc vel cog batt bs conn t m poi inregions addr topic =
89
+
let make _type tid tst lat lon alt acc vel cog batt bs conn t m poi inregions addr topic =
90
+
ignore _type;
90
91
{ tid; tst; lat; lon; alt; acc; vel; cog; batt; bs; conn; t; m; poi;
91
92
inregions = Option.value ~default:[] inregions; addr; topic }
92
93
in
93
94
Jsont.Object.map ~kind:"location" make
95
+
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "location")
94
96
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun l -> l.tid)
95
97
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst)
96
98
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun l -> l.lat)
···
114
116
115
117
(** Transition message codec. *)
116
118
let transition_jsont : transition Jsont.t =
117
-
let make tid tst lat lon acc event desc wtst =
119
+
let make _type tid tst lat lon acc event desc wtst =
120
+
ignore _type;
118
121
{ t_tid = tid; t_tst = tst; t_lat = lat; t_lon = lon; t_acc = acc;
119
122
t_event = event; t_desc = desc; t_wtst = wtst }
120
123
in
121
124
Jsont.Object.map ~kind:"transition" make
125
+
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "transition")
122
126
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun t -> t.t_tid)
123
127
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun t -> t.t_tst)
124
128
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun t -> t.t_lat)
···
132
136
133
137
(** Waypoint message codec. *)
134
138
let waypoint_jsont : waypoint Jsont.t =
135
-
let make tst lat lon rad desc =
139
+
let make _type tst lat lon rad desc =
140
+
ignore _type;
136
141
{ w_tst = tst; w_lat = lat; w_lon = lon; w_rad = rad; w_desc = desc }
137
142
in
138
143
Jsont.Object.map ~kind:"waypoint" make
144
+
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "waypoint")
139
145
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun w -> w.w_tst)
140
146
|> Jsont.Object.mem "lat" Jsont.number ~enc:(fun w -> w.w_lat)
141
147
|> Jsont.Object.mem "lon" Jsont.number ~enc:(fun w -> w.w_lon)
···
146
152
147
153
(** Card message codec. *)
148
154
let card_jsont : card Jsont.t =
149
-
let make name face tid =
155
+
let make _type name face tid =
156
+
ignore _type;
150
157
{ c_name = name; c_face = face; c_tid = tid }
151
158
in
152
159
Jsont.Object.map ~kind:"card" make
160
+
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "card")
153
161
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.c_name)
154
162
|> Jsont.Object.opt_mem "face" Jsont.string ~enc:(fun c -> c.c_face)
155
163
|> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun c -> c.c_tid)
···
158
166
159
167
(** LWT message codec. *)
160
168
let lwt_jsont : lwt Jsont.t =
161
-
let make tst = { lwt_tst = tst } in
169
+
let make _type tst =
170
+
ignore _type;
171
+
{ lwt_tst = tst }
172
+
in
162
173
Jsont.Object.map ~kind:"lwt" make
174
+
|> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "lwt")
163
175
|> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.lwt_tst)
164
176
|> Jsont.Object.skip_unknown
165
177
|> Jsont.Object.finish
···
326
338
(format_timestamp l.lwt_tst)
327
339
| Unknown (typ, _) ->
328
340
Format.fprintf ppf "Unknown message type: %s" typ
341
+
342
+
(** {1:mqtt MQTT Integration} *)
343
+
344
+
(** MQTT integration for OwnTracks messages.
345
+
346
+
This module provides helpers for parsing MQTT messages into OwnTracks
347
+
types and constructing topic patterns for subscriptions. *)
348
+
module Mqtt = struct
349
+
350
+
(** {2:types Types} *)
351
+
352
+
(** An MQTT message received from a broker. *)
353
+
type mqtt_message = {
354
+
topic : string;
355
+
payload : string;
356
+
qos : [ `At_most_once | `At_least_once | `Exactly_once ];
357
+
retain : bool;
358
+
}
359
+
360
+
(** An OwnTracks message with its source topic and parsed user/device. *)
361
+
type t = {
362
+
topic : string;
363
+
user : string option;
364
+
device : string option;
365
+
message : message;
366
+
}
367
+
368
+
(** {2:parsing Parsing} *)
369
+
370
+
(** Parse an MQTT message into an OwnTracks message.
371
+
372
+
This function:
373
+
- Extracts user/device from the topic if it follows OwnTracks conventions
374
+
- Injects the topic into the JSON payload for location messages
375
+
- Decodes the JSON payload into the appropriate OwnTracks message type
376
+
377
+
Returns [Error] if the payload cannot be parsed as valid OwnTracks JSON. *)
378
+
let of_mqtt_message (msg : mqtt_message) : (t, string) result =
379
+
let user, device =
380
+
match parse_topic msg.topic with
381
+
| Some (u, d) -> (Some u, Some d)
382
+
| None -> (None, None)
383
+
in
384
+
let payload_with_topic =
385
+
let payload = msg.payload in
386
+
if String.length payload > 0 && payload.[0] = '{' then
387
+
let topic_json = Printf.sprintf "{\"topic\":%S," msg.topic in
388
+
topic_json ^ String.sub payload 1 (String.length payload - 1)
389
+
else
390
+
payload
391
+
in
392
+
match decode_message payload_with_topic with
393
+
| Ok message -> Ok { topic = msg.topic; user; device; message }
394
+
| Error e -> Error e
395
+
396
+
(** Parse a raw MQTT message (topic + payload) into an OwnTracks message.
397
+
398
+
Convenience function that creates an [mqtt_message] with default QoS
399
+
and retain settings. *)
400
+
let of_mqtt ~topic ~payload : (t, string) result =
401
+
of_mqtt_message { topic; payload; qos = `At_least_once; retain = false }
402
+
403
+
(** {2:topics Topic Helpers} *)
404
+
405
+
(** Default OwnTracks wildcard topic that matches all users and devices. *)
406
+
let default_topic = "owntracks/#"
407
+
408
+
(** Create a topic pattern for a specific user's devices.
409
+
410
+
Returns [owntracks/user/#] to match all devices for that user. *)
411
+
let user_topic user = Printf.sprintf "owntracks/%s/#" user
412
+
413
+
(** Create a topic pattern for a specific user and device.
414
+
415
+
Returns [owntracks/user/device] for exact matching. *)
416
+
let device_topic ~user ~device = Printf.sprintf "owntracks/%s/%s" user device
417
+
418
+
(** {2:pretty_printing Pretty Printing} *)
419
+
420
+
(** Pretty-print an OwnTracks MQTT message. *)
421
+
let pp ppf msg =
422
+
Format.fprintf ppf "@[<v 0>";
423
+
begin match msg.user, msg.device with
424
+
| Some user, Some device ->
425
+
Format.fprintf ppf "User: %s / Device: %s@," user device
426
+
| _ ->
427
+
Format.fprintf ppf "Topic: %s@," msg.topic
428
+
end;
429
+
pp_message ppf msg.message;
430
+
Format.fprintf ppf "@]"
431
+
end
+12
-2
owntracks.opam
+12
-2
owntracks.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
-
synopsis: "OwnTracks message types and JSON codecs"
3
+
synopsis: "OwnTracks message types, JSON codecs, and MQTT client"
4
4
description:
5
-
"Types and codecs for parsing OwnTracks MQTT location messages using jsont"
5
+
"Types and codecs for parsing OwnTracks MQTT location messages using jsont, with an MQTT client for subscribing to location updates"
6
6
maintainer: ["anil@recoil.org"]
7
7
authors: ["Anil Madhavapeddy"]
8
8
license: "ISC"
···
10
10
"dune" {>= "3.20"}
11
11
"ocaml" {>= "5.1"}
12
12
"jsont"
13
+
"geojson"
14
+
"requests"
15
+
"mqtte" {>= "0.1"}
16
+
"eio" {>= "1.0"}
17
+
"eio_main" {>= "1.0"}
18
+
"xdge"
19
+
"tomlt"
20
+
"cmdliner" {>= "1.2"}
21
+
"logs" {>= "0.7"}
22
+
"fmt" {>= "0.9"}
13
23
"odoc" {with-doc}
14
24
]
15
25
build: [