Owntracks location tracking with MQTT and HTTPS (recorder) support

mli+meta

+1395 -1057
+1 -1
bin/dune
··· 1 1 (executable 2 2 (name main) 3 3 (public_name owntracks) 4 - (package owntracks) 4 + (package owntracks-cli) 5 5 (libraries 6 6 mqtte 7 7 mqtte.eio
+45 -29
bin/main.ml
··· 160 160 let open Mqtte_eio.Client in 161 161 match Owntracks.Mqtt.of_mqtt ~topic:msg.topic ~payload:msg.payload with 162 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 163 + match Owntracks.Mqtt.message ot_msg with 164 + | Owntracks.Message.Location loc -> 165 + let user = Option.value ~default:"unknown" (Owntracks.Mqtt.user ot_msg) in 166 + let device = Option.value ~default:"unknown" (Owntracks.Mqtt.device ot_msg) in 167 167 let device_name = Config.resolve_device_name config device in 168 168 Format.printf "@[<v 0>-------------------------------------------@,"; 169 169 Format.printf " Device: %s" device_name; 170 170 if device_name <> device then Format.printf " (%s)" device; 171 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; 172 + Format.printf " Time: %s@," (Owntracks.Location.format_timestamp (Owntracks.Location.tst loc)); 173 + Format.printf " Location: %.6f, %.6f@," (Owntracks.Location.lat loc) (Owntracks.Location.lon loc); 174 + Option.iter (fun v -> Format.printf " Altitude: %.1f m@," v) (Owntracks.Location.alt loc); 175 + Option.iter (fun v -> Format.printf " Accuracy: +/- %.0f m@," v) (Owntracks.Location.acc loc); 176 + Option.iter (fun v -> Format.printf " Speed: %.1f km/h@," v) (Owntracks.Location.vel loc); 177 + Option.iter (fun v -> Format.printf " Battery: %d%%@," v) (Owntracks.Location.batt loc); 178 178 Format.printf "-------------------------------------------@]@." 179 - | Owntracks.Transition tr -> 180 - let device = Option.value ~default:"unknown" ot_msg.device in 179 + | Owntracks.Message.Transition tr -> 180 + let device = Option.value ~default:"unknown" (Owntracks.Mqtt.device ot_msg) in 181 181 let device_name = Config.resolve_device_name config device in 182 182 Format.printf "[%s] %s region: %s@." device_name 183 - (String.uppercase_ascii tr.t_event) 184 - (Option.value ~default:"unknown" tr.t_desc) 183 + (String.uppercase_ascii (Owntracks.Transition.event tr)) 184 + (Option.value ~default:"unknown" (Owntracks.Transition.desc tr)) 185 185 | _ -> ()) 186 186 | Error err -> Logs.debug (fun m -> m "Failed to parse: %s" err) 187 187 ··· 303 303 (** {1 OwnTracks Recorder HTTP API} *) 304 304 305 305 module Recorder = struct 306 - (** HTTP client for the OwnTracks Recorder API. 306 + (** HTTP client for the OwnTracks Recorder API. *) 307 307 308 - Uses the parsing functions from Owntracks.Recorder. *) 308 + (** Decode string list, trying results wrapper first then plain array. *) 309 + let decode_string_list body = 310 + match Jsont_bytesrw.decode_string Owntracks.Recorder.string_list_results_jsont body with 311 + | Ok items -> items 312 + | Error _ -> 313 + match Jsont_bytesrw.decode_string Owntracks.Recorder.string_list_jsont body with 314 + | Ok items -> items 315 + | Error _ -> [] 316 + 317 + (** Decode locations, trying array first then data wrapper. *) 318 + let decode_locations body = 319 + match Jsont_bytesrw.decode_string Owntracks.Recorder.locations_jsont body with 320 + | Ok locs -> locs 321 + | Error _ -> 322 + match Jsont_bytesrw.decode_string Owntracks.Recorder.locations_data_jsont body with 323 + | Ok locs -> locs 324 + | Error _ -> [] 309 325 310 326 let list_users ~sw env ~verbose_http ~recorder_url ?auth () : string list = 311 327 let url = Printf.sprintf "%s/api/0/list" recorder_url in ··· 322 338 let response = Requests.get ~headers session url in 323 339 if Requests.Response.ok response then begin 324 340 let body = Requests.Response.body response |> Eio.Flow.read_all in 325 - Owntracks.Recorder.parse_string_list body 341 + decode_string_list body 326 342 end else begin 327 343 Format.eprintf "HTTP error: %d@." (Requests.Response.status_code response); 328 344 [] ··· 343 359 let response = Requests.get ~headers session url in 344 360 if Requests.Response.ok response then begin 345 361 let body = Requests.Response.body response |> Eio.Flow.read_all in 346 - Owntracks.Recorder.parse_string_list body 362 + decode_string_list body 347 363 end else begin 348 364 Format.eprintf "HTTP error: %d@." (Requests.Response.status_code response); 349 365 [] 350 366 end 351 367 352 - let fetch_locations ~sw env ~verbose_http ~recorder_url ~user ~device ~from_date ~to_date ?auth () : Owntracks.location list = 368 + let fetch_locations ~sw env ~verbose_http ~recorder_url ~user ~device ~from_date ~to_date ?auth () : Owntracks.Location.t list = 353 369 let url = Printf.sprintf "%s/api/0/locations?user=%s&device=%s&from=%s&to=%s" 354 370 recorder_url 355 371 (Uri.pct_encode user) ··· 372 388 let response = Requests.get ~headers session url in 373 389 if Requests.Response.ok response then begin 374 390 let body = Requests.Response.body response |> Eio.Flow.read_all in 375 - Owntracks.Recorder.parse_locations_json body 391 + decode_locations body 376 392 end else begin 377 393 Format.eprintf "HTTP error: %d@." (Requests.Response.status_code response); 378 394 [] ··· 427 443 1 428 444 | locs -> 429 445 let device_name = Config.resolve_device_name config device in 430 - let json = Owntracks.Geojson_output.linestring_feature ~device_name locs in 431 - print_endline (Owntracks.Geojson_output.to_string json); 446 + let json = Owntracks.Geojson.linestring_feature ~device_name locs in 447 + print_endline (Owntracks.Geojson.to_string json); 432 448 0) 433 449 | None -> 434 450 (* Use MQTT for real-time data *) ··· 452 468 let open Mqtte_eio.Client in 453 469 match Owntracks.Mqtt.of_mqtt ~topic:msg.topic ~payload:msg.payload with 454 470 | Ok ot_msg -> ( 455 - match ot_msg.Owntracks.Mqtt.message with 456 - | Owntracks.Location loc -> 457 - let msg_device = Option.value ~default:"unknown" ot_msg.device in 471 + match Owntracks.Mqtt.message ot_msg with 472 + | Owntracks.Message.Location loc -> 473 + let msg_device = Option.value ~default:"unknown" (Owntracks.Mqtt.device ot_msg) in 458 474 let matches = match device with 459 475 | None -> true 460 476 | Some d -> d = msg_device || d = Config.resolve_device_name config msg_device ··· 465 481 track_device_name := device_name; 466 482 track_points := loc :: !track_points 467 483 end else if Option.is_none !result then 468 - result := Some (Owntracks.Geojson_output.point_feature ~device_name loc) 484 + result := Some (Owntracks.Geojson.point_feature ~device_name loc) 469 485 end 470 486 | _ -> ()) 471 487 | Error _ -> () ··· 498 514 Format.eprintf "No locations received within %.0f seconds@." duration; 499 515 1 500 516 | points -> 501 - let json = Owntracks.Geojson_output.linestring_feature ~device_name:!track_device_name points in 502 - print_endline (Owntracks.Geojson_output.to_string json); 517 + let json = Owntracks.Geojson.linestring_feature ~device_name:!track_device_name points in 518 + print_endline (Owntracks.Geojson.to_string json); 503 519 0 504 520 end else begin 505 521 (* Single point mode: wait for first location then exit immediately *) ··· 510 526 Mqtte_eio.Client.disconnect client; 511 527 match !result with 512 528 | Some json -> 513 - print_endline (Owntracks.Geojson_output.to_string json); 529 + print_endline (Owntracks.Geojson.to_string json); 514 530 0 515 531 | None -> 516 532 Format.eprintf "No location received within %.0f seconds@." duration;
+29 -7
dune-project
··· 4 4 (generate_opam_files true) 5 5 6 6 (license ISC) 7 - (authors "Anil Madhavapeddy") 8 - (maintainers "anil@recoil.org") 7 + (authors "Anil Madhavapeddy <anil@recoil.org>") 8 + (maintainers "Anil Madhavapeddy <anil@recoil.org>") 9 + (source (github avsm/ocaml-owntracks)) 10 + (homepage "https://github.com/avsm/ocaml-owntracks") 11 + (bug_reports "https://github.com/avsm/ocaml-owntracks/issues") 9 12 10 13 (package 11 14 (name owntracks) 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") 15 + (synopsis "OwnTracks message types and JSON codecs") 16 + (description 17 + "Types and jsont codecs for parsing OwnTracks MQTT location messages. 18 + OwnTracks is an open-source location tracking application that publishes 19 + GPS coordinates, accuracy, speed, battery, and other device state over MQTT. 20 + This library provides type-safe parsing and serialization of all OwnTracks 21 + message types including locations, transitions, waypoints, and cards.") 14 22 (depends 15 23 (ocaml (>= 5.1)) 16 - jsont 17 - requests 24 + (jsont (>= 0.1.0)) 25 + (odoc :with-doc))) 26 + 27 + (package 28 + (name owntracks-cli) 29 + (synopsis "OwnTracks MQTT client and CLI tools") 30 + (description 31 + "Command-line tools for subscribing to OwnTracks location updates over MQTT. 32 + Includes commands for real-time monitoring, GeoJSON export, and querying 33 + the OwnTracks Recorder HTTP API for historical data.") 34 + (depends 35 + (ocaml (>= 5.1)) 36 + (owntracks (= :version)) 18 37 (mqtte (>= 0.1)) 19 38 (eio (>= 1.0)) 20 39 (eio_main (>= 1.0)) ··· 22 41 tomlt 23 42 (cmdliner (>= 1.2)) 24 43 (logs (>= 0.7)) 25 - (fmt (>= 0.9)))) 44 + (fmt (>= 0.9)) 45 + mirage-crypto-rng 46 + requests 47 + (odoc :with-doc)))
+1 -1
lib/dune
··· 1 1 (library 2 2 (name owntracks) 3 3 (public_name owntracks) 4 - (libraries jsont jsont.bytesrw unix)) 4 + (libraries jsont jsont.bytesrw geojson unix))
+13 -598
lib/owntracks.ml
··· 1 - (** OwnTracks message types and JSON codecs using jsont. 2 - 3 - This module provides types and codecs for parsing OwnTracks MQTT messages. 4 - OwnTracks is an open-source location tracking app that publishes location 5 - data over MQTT. 6 - 7 - Message types include: 8 - - Location updates with coordinates, altitude, speed, etc. 9 - - Transition events for entering/leaving regions 10 - - Waypoint definitions 11 - - Cards with user information 12 - 13 - See {{:https://owntracks.org/booklet/tech/json/}OwnTracks JSON format} 14 - and the vendored recorder in vendor/git/recorder for reference. *) 15 - 16 - (** {1:types Message Types} *) 17 - 18 - (** Location message - the primary OwnTracks message type. 19 - 20 - Published when the device reports its location. Contains GPS coordinates, 21 - accuracy, altitude, speed, heading, and various device state information. *) 22 - type location = { 23 - tid : string option; (** Tracker ID (2 chars, configurable) *) 24 - tst : int; (** Timestamp (Unix epoch) *) 25 - lat : float; (** Latitude *) 26 - lon : float; (** Longitude *) 27 - alt : float option; (** Altitude in meters *) 28 - acc : float option; (** Horizontal accuracy in meters *) 29 - vel : float option; (** Velocity in km/h *) 30 - cog : float option; (** Course over ground (heading) in degrees *) 31 - batt : int option; (** Battery level percentage (0-100) *) 32 - bs : int option; (** Battery status: 0=unknown, 1=unplugged, 2=charging, 3=full *) 33 - conn : string option; (** Connection type: w=wifi, m=mobile, o=offline *) 34 - t : string option; (** Trigger: p=ping, c=circular region, b=beacon, r=response, u=manual, t=timer, v=monitoring *) 35 - m : int option; (** Monitoring mode: 0=quiet, 1=manual, 2=significant, 3=move *) 36 - poi : string option; (** Point of Interest name if at a defined waypoint *) 37 - inregions : string list; (** List of regions the device is currently in *) 38 - addr : string option; (** Reverse-geocoded address (added by recorder) *) 39 - topic : string option; (** MQTT topic (added by recorder) *) 40 - } 41 - 42 - (** Transition event - published when entering or leaving a region. *) 43 - type transition = { 44 - t_tid : string option; (** Tracker ID *) 45 - t_tst : int; (** Timestamp *) 46 - t_lat : float; (** Latitude *) 47 - t_lon : float; (** Longitude *) 48 - t_acc : float option; (** Accuracy *) 49 - t_event : string; (** "enter" or "leave" *) 50 - t_desc : string option; (** Region description *) 51 - t_wtst : int option; (** Waypoint timestamp *) 52 - } 53 - 54 - (** Waypoint definition - describes a monitored region. *) 55 - type waypoint = { 56 - w_tst : int; (** Timestamp *) 57 - w_lat : float; (** Latitude of center *) 58 - w_lon : float; (** Longitude of center *) 59 - w_rad : int; (** Radius in meters *) 60 - w_desc : string; (** Description/name *) 61 - } 62 - 63 - (** Card message - provides user information for display. *) 64 - type card = { 65 - c_name : string option; (** Full name *) 66 - c_face : string option; (** Base64-encoded image *) 67 - c_tid : string option; (** Tracker ID (must match location tid) *) 68 - } 69 - 70 - (** LWT (Last Will and Testament) message - published when client disconnects. *) 71 - type lwt = { 72 - lwt_tst : int; (** Timestamp *) 73 - } 74 - 75 - (** All OwnTracks message types. *) 76 - type message = 77 - | Location of location 78 - | Transition of transition 79 - | Waypoint of waypoint 80 - | Card of card 81 - | Lwt of lwt 82 - | Unknown of string * Jsont.json 83 - (** Unknown message type with the _type value and raw JSON *) 84 - 85 - (** {1:codecs JSON Codecs} *) 86 - 87 - (** Location message codec. *) 88 - let location_jsont : location Jsont.t = 89 - let make _type tid tst lat lon alt acc vel cog batt bs conn t m poi inregions addr topic = 90 - ignore _type; 91 - { tid; tst; lat; lon; alt; acc; vel; cog; batt; bs; conn; t; m; poi; 92 - inregions = Option.value ~default:[] inregions; addr; topic } 93 - in 94 - Jsont.Object.map ~kind:"location" make 95 - |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "location") 96 - |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun l -> l.tid) 97 - |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst) 98 - |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun l -> l.lat) 99 - |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun l -> l.lon) 100 - |> Jsont.Object.opt_mem "alt" Jsont.number ~enc:(fun l -> l.alt) 101 - |> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun l -> l.acc) 102 - |> Jsont.Object.opt_mem "vel" Jsont.number ~enc:(fun l -> l.vel) 103 - |> Jsont.Object.opt_mem "cog" Jsont.number ~enc:(fun l -> l.cog) 104 - |> Jsont.Object.opt_mem "batt" Jsont.int ~enc:(fun l -> l.batt) 105 - |> Jsont.Object.opt_mem "bs" Jsont.int ~enc:(fun l -> l.bs) 106 - |> Jsont.Object.opt_mem "conn" Jsont.string ~enc:(fun l -> l.conn) 107 - |> Jsont.Object.opt_mem "t" Jsont.string ~enc:(fun l -> l.t) 108 - |> Jsont.Object.opt_mem "m" Jsont.int ~enc:(fun l -> l.m) 109 - |> Jsont.Object.opt_mem "poi" Jsont.string ~enc:(fun l -> l.poi) 110 - |> Jsont.Object.opt_mem "inregions" (Jsont.list Jsont.string) 111 - ~enc:(fun l -> match l.inregions with [] -> None | xs -> Some xs) 112 - |> Jsont.Object.opt_mem "addr" Jsont.string ~enc:(fun l -> l.addr) 113 - |> Jsont.Object.opt_mem "topic" Jsont.string ~enc:(fun l -> l.topic) 114 - |> Jsont.Object.skip_unknown 115 - |> Jsont.Object.finish 116 - 117 - (** Transition message codec. *) 118 - let transition_jsont : transition Jsont.t = 119 - let make _type tid tst lat lon acc event desc wtst = 120 - ignore _type; 121 - { t_tid = tid; t_tst = tst; t_lat = lat; t_lon = lon; t_acc = acc; 122 - t_event = event; t_desc = desc; t_wtst = wtst } 123 - in 124 - Jsont.Object.map ~kind:"transition" make 125 - |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "transition") 126 - |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun t -> t.t_tid) 127 - |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun t -> t.t_tst) 128 - |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun t -> t.t_lat) 129 - |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun t -> t.t_lon) 130 - |> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun t -> t.t_acc) 131 - |> Jsont.Object.mem "event" Jsont.string ~enc:(fun t -> t.t_event) 132 - |> Jsont.Object.opt_mem "desc" Jsont.string ~enc:(fun t -> t.t_desc) 133 - |> Jsont.Object.opt_mem "wtst" Jsont.int ~enc:(fun t -> t.t_wtst) 134 - |> Jsont.Object.skip_unknown 135 - |> Jsont.Object.finish 136 - 137 - (** Waypoint message codec. *) 138 - let waypoint_jsont : waypoint Jsont.t = 139 - let make _type tst lat lon rad desc = 140 - ignore _type; 141 - { w_tst = tst; w_lat = lat; w_lon = lon; w_rad = rad; w_desc = desc } 142 - in 143 - Jsont.Object.map ~kind:"waypoint" make 144 - |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "waypoint") 145 - |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun w -> w.w_tst) 146 - |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun w -> w.w_lat) 147 - |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun w -> w.w_lon) 148 - |> Jsont.Object.mem "rad" Jsont.int ~enc:(fun w -> w.w_rad) 149 - |> Jsont.Object.mem "desc" Jsont.string ~enc:(fun w -> w.w_desc) 150 - |> Jsont.Object.skip_unknown 151 - |> Jsont.Object.finish 152 - 153 - (** Card message codec. *) 154 - let card_jsont : card Jsont.t = 155 - let make _type name face tid = 156 - ignore _type; 157 - { c_name = name; c_face = face; c_tid = tid } 158 - in 159 - Jsont.Object.map ~kind:"card" make 160 - |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "card") 161 - |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.c_name) 162 - |> Jsont.Object.opt_mem "face" Jsont.string ~enc:(fun c -> c.c_face) 163 - |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun c -> c.c_tid) 164 - |> Jsont.Object.skip_unknown 165 - |> Jsont.Object.finish 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 166 5 167 - (** LWT message codec. *) 168 - let lwt_jsont : lwt Jsont.t = 169 - let make _type tst = 170 - ignore _type; 171 - { lwt_tst = tst } 172 - in 173 - Jsont.Object.map ~kind:"lwt" make 174 - |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "lwt") 175 - |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.lwt_tst) 176 - |> Jsont.Object.skip_unknown 177 - |> Jsont.Object.finish 178 - 179 - (** {1:decoding Decoding} *) 180 - 181 - (** Extract the _type field from a generic JSON object. *) 182 - let extract_type = function 183 - | Jsont.Object (members, _) -> 184 - List.find_map (fun ((name, _), value) -> 185 - if name = "_type" then 186 - match value with Jsont.String (s, _) -> Some s | _ -> None 187 - else None 188 - ) members 189 - | _ -> None 190 - 191 - (** Decode an OwnTracks JSON message from a string. 192 - 193 - Returns the appropriate message type based on the "_type" field. 194 - Unknown message types are returned as [Unknown (type_name, json)]. *) 195 - let decode_message (json_str : string) : (message, string) result = 196 - let ( let* ) = Result.bind in 197 - let decode_as jsont wrap = 198 - Result.map wrap (Jsont_bytesrw.decode_string jsont json_str) 199 - in 200 - try 201 - let* json = Jsont_bytesrw.decode_string Jsont.json json_str in 202 - match extract_type json with 203 - | Some "location" -> decode_as location_jsont (fun l -> Location l) 204 - | Some "transition" -> decode_as transition_jsont (fun t -> Transition t) 205 - | Some "waypoint" | Some "waypoints" -> decode_as waypoint_jsont (fun w -> Waypoint w) 206 - | Some "card" -> decode_as card_jsont (fun c -> Card c) 207 - | Some "lwt" -> decode_as lwt_jsont (fun l -> Lwt l) 208 - | Some other -> Ok (Unknown (other, json)) 209 - | None -> Ok (Unknown ("", json)) 210 - with exn -> 211 - Error (Printexc.to_string exn) 212 - 213 - (** {1:formatting Pretty Printing} *) 214 - 215 - (** Format a code string using a lookup table. *) 216 - let pp_code_map ~unknown codes ppf = function 217 - | Some s -> 218 - let display = List.assoc_opt s codes |> Option.value ~default:s in 219 - Format.pp_print_string ppf display 220 - | None -> Format.pp_print_string ppf unknown 221 - 222 - (** Format connection type as human-readable string. *) 223 - let pp_conn = 224 - pp_code_map ~unknown:"Unknown" 225 - ["w", "WiFi"; "m", "Mobile"; "o", "Offline"] 226 - 227 - (** Format trigger type as human-readable string. *) 228 - let pp_trigger = 229 - pp_code_map ~unknown:"Unknown" 230 - ["p", "Ping"; "c", "Circular region"; "b", "Beacon"; "r", "Response"; 231 - "u", "Manual"; "t", "Timer"; "v", "Monitoring"] 232 - 233 - (** Format timestamp as ISO 8601 string. *) 234 - let format_timestamp tst = 235 - let t = Unix.gmtime (float_of_int tst) in 236 - Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC" 237 - (t.Unix.tm_year + 1900) (t.Unix.tm_mon + 1) t.Unix.tm_mday 238 - t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec 239 - 240 - (** Parse user and device from OwnTracks topic. 241 - Topic format: owntracks/user/device *) 242 - let parse_topic topic = 243 - match String.split_on_char '/' topic with 244 - | _ :: user :: device :: _ -> Some (user, device) 245 - | _ -> None 246 - 247 - (** Pretty-print a location message. *) 248 - let pp_location ppf (loc : location) = 249 - Format.fprintf ppf "@[<v 0>"; 250 - Format.fprintf ppf "-------------------------------------------@,"; 251 - 252 - (* User/device from topic *) 253 - begin match loc.topic with 254 - | Some topic -> 255 - begin match parse_topic topic with 256 - | Some (user, device) -> 257 - Format.fprintf ppf " User: %s / %s" user device; 258 - Option.iter (fun tid -> Format.fprintf ppf " [%s]" tid) loc.tid; 259 - Format.fprintf ppf "@," 260 - | None -> 261 - Format.fprintf ppf " Topic: %s@," topic 262 - end 263 - | None -> 264 - Option.iter (fun tid -> 265 - Format.fprintf ppf " Tracker: %s@," tid 266 - ) loc.tid 267 - end; 268 - 269 - Format.fprintf ppf " Time: %s@," (format_timestamp loc.tst); 270 - Format.fprintf ppf " Location: %.6f, %.6f@," loc.lat loc.lon; 271 - 272 - Option.iter (fun alt -> 273 - Format.fprintf ppf " Altitude: %.1f m@," alt 274 - ) loc.alt; 275 - 276 - Option.iter (fun acc -> 277 - Format.fprintf ppf " Accuracy: +/- %.0f m@," acc 278 - ) loc.acc; 279 - 280 - Option.iter (fun vel -> 281 - Format.fprintf ppf " Speed: %.1f km/h@," vel 282 - ) loc.vel; 283 - 284 - Option.iter (fun cog -> 285 - Format.fprintf ppf " Heading: %.0f deg@," cog 286 - ) loc.cog; 287 - 288 - Option.iter (fun batt -> 289 - Format.fprintf ppf " Battery: %d%%@," batt 290 - ) loc.batt; 291 - 292 - Format.fprintf ppf " Conn: %a@," pp_conn loc.conn; 293 - 294 - Option.iter (fun _ -> 295 - Format.fprintf ppf " Trigger: %a@," pp_trigger loc.t 296 - ) loc.t; 297 - 298 - Option.iter (fun poi -> 299 - Format.fprintf ppf " POI: %s@," poi 300 - ) loc.poi; 301 - 302 - if loc.inregions <> [] then 303 - Format.fprintf ppf " Regions: %s@," (String.concat ", " loc.inregions); 304 - 305 - Option.iter (fun addr -> 306 - Format.fprintf ppf " Address: %s@," addr 307 - ) loc.addr; 308 - 309 - Format.fprintf ppf "-------------------------------------------@]" 310 - 311 - (** Pretty-print a transition message. *) 312 - let pp_transition ppf (tr : transition) = 313 - Format.fprintf ppf "@[<v 0>"; 314 - Format.fprintf ppf "-------------------------------------------@,"; 315 - Format.fprintf ppf " Event: %s@," (String.uppercase_ascii tr.t_event); 316 - Option.iter (fun desc -> 317 - Format.fprintf ppf " Region: %s@," desc 318 - ) tr.t_desc; 319 - Option.iter (fun tid -> 320 - Format.fprintf ppf " Tracker: %s@," tid 321 - ) tr.t_tid; 322 - Format.fprintf ppf " Time: %s@," (format_timestamp tr.t_tst); 323 - Format.fprintf ppf " Location: %.6f, %.6f@," tr.t_lat tr.t_lon; 324 - Format.fprintf ppf "-------------------------------------------@]" 325 - 326 - (** Pretty-print any OwnTracks message. *) 327 - let pp_message ppf = function 328 - | Location loc -> pp_location ppf loc 329 - | Transition tr -> pp_transition ppf tr 330 - | Waypoint wp -> 331 - Format.fprintf ppf "Waypoint: %s at (%.6f, %.6f) radius %dm" 332 - wp.w_desc wp.w_lat wp.w_lon wp.w_rad 333 - | Card c -> 334 - Format.fprintf ppf "Card: %s" 335 - (Option.value ~default:"(no name)" c.c_name) 336 - | Lwt l -> 337 - Format.fprintf ppf "LWT: client disconnected at %s" 338 - (format_timestamp l.lwt_tst) 339 - | Unknown (typ, _) -> 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 432 - 433 - (** {1:recorder OwnTracks Recorder HTTP API} *) 434 - 435 - (** Query the OwnTracks Recorder HTTP API for historical locations. 436 - 437 - The OwnTracks Recorder provides an HTTP API for querying historical 438 - location data. This module provides functions to list users, list 439 - devices for a user, and fetch historical locations. 440 - 441 - API endpoints: 442 - - [GET /api/0/list] - List all users 443 - - [GET /api/0/list?user=USER] - List devices for a user 444 - - [GET /api/0/locations?user=USER&device=DEVICE&from=YYYY-MM-DD&to=YYYY-MM-DD] - Fetch locations *) 445 - module Recorder = struct 446 - 447 - (** {2:types Types} *) 448 - 449 - (** Authentication credentials for HTTP Basic Auth. *) 450 - type auth = { username : string; password : string } 451 - 452 - (** {2:parsing JSON Parsing} *) 453 - 454 - (** Parse a location from a JSON object. *) 455 - let location_of_json (json : Jsont.json) : location option = 456 - let get_float key = 457 - match json with 458 - | Jsont.Object (mems, _) -> 459 - List.find_map (fun ((k, _), v) -> 460 - if k = key then 461 - match v with 462 - | Jsont.Number (f, _) -> Some f 463 - | _ -> None 464 - else None) mems 465 - | _ -> None 466 - in 467 - let get_int key = Option.map int_of_float (get_float key) in 468 - let get_string key = 469 - match json with 470 - | Jsont.Object (mems, _) -> 471 - List.find_map (fun ((k, _), v) -> 472 - if k = key then 473 - match v with 474 - | Jsont.String (s, _) -> Some s 475 - | _ -> None 476 - else None) mems 477 - | _ -> None 478 - in 479 - match (get_float "lat", get_float "lon", get_int "tst") with 480 - | (Some lat, Some lon, Some tst) -> 481 - Some { 482 - lat; lon; tst; 483 - tid = get_string "tid"; 484 - alt = get_float "alt"; 485 - acc = get_float "acc"; 486 - vel = get_float "vel"; 487 - cog = get_float "cog"; 488 - batt = get_int "batt"; 489 - bs = get_int "bs"; 490 - conn = get_string "conn"; 491 - t = get_string "t"; 492 - m = get_int "m"; 493 - poi = get_string "poi"; 494 - inregions = []; 495 - addr = get_string "addr"; 496 - topic = get_string "topic"; 497 - } 498 - | _ -> None 499 - 500 - (** Parse a list of locations from a JSON string. 501 - 502 - Handles both array format and object with "data" key. *) 503 - let parse_locations_json json_str : location list = 504 - match Jsont_bytesrw.decode_string Jsont.json json_str with 505 - | Error _ -> [] 506 - | Ok json -> 507 - match json with 508 - | Jsont.Array (items, _) -> 509 - List.filter_map location_of_json items 510 - | Jsont.Object (mems, _) -> 511 - (* Sometimes the API returns { "data": [...] } *) 512 - (match List.find_opt (fun ((k, _), _) -> k = "data") mems with 513 - | Some (_, Jsont.Array (items, _)) -> List.filter_map location_of_json items 514 - | _ -> []) 515 - | _ -> [] 516 - 517 - (** Parse a list of strings from a JSON response. 518 - 519 - Handles both array format and object with "results" key. *) 520 - let parse_string_list json_str : string list = 521 - match Jsont_bytesrw.decode_string Jsont.json json_str with 522 - | Error _ -> [] 523 - | Ok json -> 524 - match json with 525 - | Jsont.Object (mems, _) -> 526 - (* API returns { "results": ["user1", "user2", ...] } *) 527 - (match List.find_opt (fun ((k, _), _) -> k = "results") mems with 528 - | Some (_, Jsont.Array (items, _)) -> 529 - List.filter_map (function 530 - | Jsont.String (s, _) -> Some s 531 - | _ -> None) items 532 - | _ -> []) 533 - | Jsont.Array (items, _) -> 534 - List.filter_map (function 535 - | Jsont.String (s, _) -> Some s 536 - | _ -> None) items 537 - | _ -> [] 538 - end 539 - 540 - (** {1:geojson_output GeoJSON Output} *) 541 - 542 - (** Convert OwnTracks locations to GeoJSON format. 543 - 544 - This module provides functions to convert location data into GeoJSON 545 - Point and LineString features for use in mapping applications. *) 546 - module Geojson_output = struct 547 - open Geojson 548 - 549 - (** Convert a location to a GeoJSON position. *) 550 - let pos_of_loc (loc : location) = 551 - Geometry.Position.v ?altitude:loc.alt ~lng:loc.lon ~lat:loc.lat () 552 - 553 - (** Create GeoJSON properties object for a location. *) 554 - let props ~device_name ~timestamp ~time ?accuracy ?speed ?battery ?tracker_id () = 555 - let open Jsont.Json in 556 - let add n f opt acc = match opt with Some v -> (n, f v) :: acc | None -> acc in 557 - [ 558 - ("name", string device_name); 559 - ("timestamp", int timestamp); 560 - ("time", string time) 561 - ] 562 - |> add "accuracy" number accuracy 563 - |> add "speed" number speed 564 - |> add "battery" int battery 565 - |> add "tracker_id" string tracker_id 566 - |> fun mems -> Jsont.Json.object' (List.map (fun (n, v) -> Jsont.Json.mem (Jsont.Json.name n) v) mems) 567 - 568 - (** Convert a location to a GeoJSON Feature with Point geometry. *) 569 - let point_feature ~device_name (loc : location) : Geojson.t = 570 - let point = Geometry.Point.v (pos_of_loc loc) in 571 - let geom : Geojson.geometry = `Point point in 572 - let properties = Some (props ~device_name ~timestamp:loc.tst 573 - ~time:(format_timestamp loc.tst) 574 - ?accuracy:loc.acc ?speed:loc.vel ?battery:loc.batt ?tracker_id:loc.tid ()) in 575 - let feature = Geojson.Feature.v ?properties geom in 576 - `Feature feature 577 - 578 - (** Convert a list of locations to a GeoJSON Feature with LineString geometry. 579 - 580 - Locations are sorted by timestamp before creating the linestring. *) 581 - let linestring_feature ~device_name (locs : location list) : Geojson.t = 582 - let sorted = List.sort (fun a b -> Int.compare a.tst b.tst) locs in 583 - let positions = Array.of_list (List.map pos_of_loc sorted) in 584 - let line = Geometry.LineString.v positions in 585 - let geom : Geojson.geometry = `Line_string line in 586 - let start_time = match sorted with [] -> 0 | h :: _ -> h.tst in 587 - let end_time = match List.rev sorted with [] -> 0 | h :: _ -> h.tst in 588 - let properties = Some (Jsont.Json.object' [ 589 - Jsont.Json.mem (Jsont.Json.name "name") (Jsont.Json.string device_name); 590 - Jsont.Json.mem (Jsont.Json.name "points") (Jsont.Json.int (List.length sorted)); 591 - Jsont.Json.mem (Jsont.Json.name "start_time") (Jsont.Json.string (format_timestamp start_time)); 592 - Jsont.Json.mem (Jsont.Json.name "end_time") (Jsont.Json.string (format_timestamp end_time)); 593 - ]) in 594 - let feature = Geojson.Feature.v ?properties geom in 595 - `Feature feature 596 - 597 - (** Encode a GeoJSON value to a JSON string. *) 598 - let to_string = Geojson.to_string 599 - end 6 + module Location = Owntracks_location 7 + module Transition = Owntracks_transition 8 + module Waypoint = Owntracks_waypoint 9 + module Card = Owntracks_card 10 + module Lwt = Owntracks_lwt 11 + module Message = Owntracks_message 12 + module Mqtt = Owntracks_mqtt 13 + module Recorder = Owntracks_recorder 14 + module Geojson = Owntracks_geojson_output
+41 -406
lib/owntracks.mli
··· 13 13 {1:overview Overview} 14 14 15 15 OwnTracks publishes several message types: 16 - - {!location} - GPS coordinates, accuracy, speed, battery, etc. 17 - - {!transition} - Region entry/exit events 18 - - {!waypoint} - Monitored region definitions 19 - - {!card} - User information for display 20 - - {!lwt} - Last Will and Testament (disconnect notification) 16 + - {!Location} - GPS coordinates, accuracy, speed, battery, etc. 17 + - {!Transition} - Region entry/exit events 18 + - {!Waypoint} - Monitored region definitions 19 + - {!Card} - User information for display 20 + - {!Lwt} - Last Will and Testament (disconnect notification) 21 21 22 22 Messages are published to MQTT topics in the format [owntracks/user/device]. 23 23 24 24 {1:example Example} 25 25 26 - Decoding a location message: 26 + Decoding a location message using jsont_bytesrw: 27 27 {[ 28 28 let json = {|{"_type":"location","lat":51.5,"lon":-0.1,"tst":1234567890}|} in 29 - match Owntracks.decode_message json with 29 + match Jsont_bytesrw.decode_string Owntracks.Message.jsont json with 30 30 | Ok (Location loc) -> 31 - Printf.printf "Location: %.4f, %.4f\n" loc.lat loc.lon 31 + Printf.printf "Location: %.4f, %.4f\n" 32 + (Owntracks.Location.lat loc) (Owntracks.Location.lon loc) 32 33 | Ok _ -> print_endline "Other message type" 33 34 | Error e -> Printf.printf "Error: %s\n" e 34 35 ]} 35 36 36 37 See {{:https://owntracks.org/booklet/tech/json/}OwnTracks JSON format} 37 - for the complete specification. *) 38 - 39 - (** {1:types Message Types} *) 40 - 41 - (** Location message - the primary OwnTracks message type. 42 - 43 - Published when the device reports its location. Contains GPS coordinates, 44 - accuracy, altitude, speed, heading, and various device state information. 45 - 46 - Required fields are [lat], [lon], and [tst]. All other fields are optional 47 - and may not be present depending on device capabilities and settings. *) 48 - type location = { 49 - tid : string option; 50 - (** Tracker ID - a short identifier (typically 2 characters) configured 51 - in the app. Used to identify the device in a compact way. *) 52 - 53 - tst : int; 54 - (** Timestamp as Unix epoch (seconds since 1970-01-01 00:00:00 UTC). 55 - This is when the location was recorded by the device. *) 56 - 57 - lat : float; 58 - (** Latitude in decimal degrees. Range: -90 to +90. *) 59 - 60 - lon : float; 61 - (** Longitude in decimal degrees. Range: -180 to +180. *) 62 - 63 - alt : float option; 64 - (** Altitude above sea level in meters. May be negative for locations 65 - below sea level. *) 66 - 67 - acc : float option; 68 - (** Horizontal accuracy (radius) in meters. Indicates the confidence 69 - interval for the reported position. *) 70 - 71 - vel : float option; 72 - (** Velocity (speed) in km/h. Only present when the device is moving. *) 73 - 74 - cog : float option; 75 - (** Course over ground (heading) in degrees from true north (0-360). 76 - Indicates the direction of travel. *) 77 - 78 - batt : int option; 79 - (** Battery level as percentage (0-100). *) 80 - 81 - bs : int option; 82 - (** Battery status: 83 - - [0] = unknown 84 - - [1] = unplugged 85 - - [2] = charging 86 - - [3] = full *) 87 - 88 - conn : string option; 89 - (** Connection type: 90 - - ["w"] = WiFi 91 - - ["m"] = Mobile/cellular 92 - - ["o"] = Offline *) 93 - 94 - t : string option; 95 - (** Trigger - what caused this location report: 96 - - ["p"] = Ping (response to request) 97 - - ["c"] = Circular region event 98 - - ["b"] = Beacon event 99 - - ["r"] = Response to reportLocation 100 - - ["u"] = Manual/user-initiated 101 - - ["t"] = Timer-based 102 - - ["v"] = Monitoring mode change *) 103 - 104 - m : int option; 105 - (** Monitoring mode: 106 - - [0] = Quiet (no location reporting) 107 - - [1] = Manual (only when requested) 108 - - [2] = Significant changes only 109 - - [3] = Move mode (frequent updates) *) 110 - 111 - poi : string option; 112 - (** Point of Interest - name of a waypoint if the device is currently 113 - at a defined location. *) 114 - 115 - inregions : string list; 116 - (** List of region names the device is currently inside. May be empty 117 - if not inside any monitored regions. *) 118 - 119 - addr : string option; 120 - (** Reverse-geocoded address. This is typically added by the OwnTracks 121 - Recorder server, not the device itself. *) 122 - 123 - topic : string option; 124 - (** MQTT topic this message was published to. Added during parsing, 125 - not present in the original JSON. *) 126 - } 127 - 128 - (** Transition event - published when entering or leaving a monitored region. 129 - 130 - Transitions are triggered by geofences (circular regions) or beacons 131 - configured in the OwnTracks app. *) 132 - type transition = { 133 - t_tid : string option; 134 - (** Tracker ID of the device. *) 135 - 136 - t_tst : int; 137 - (** Timestamp when the transition occurred. *) 138 - 139 - t_lat : float; 140 - (** Latitude where the transition was detected. *) 141 - 142 - t_lon : float; 143 - (** Longitude where the transition was detected. *) 144 - 145 - t_acc : float option; 146 - (** Accuracy of the position in meters. *) 147 - 148 - t_event : string; 149 - (** Event type: ["enter"] when entering a region, ["leave"] when leaving. *) 150 - 151 - t_desc : string option; 152 - (** Description/name of the region. *) 153 - 154 - t_wtst : int option; 155 - (** Timestamp of the waypoint definition that triggered this transition. *) 156 - } 157 - 158 - (** Waypoint definition - describes a monitored circular region. 38 + for the complete specification. 159 39 160 - Waypoints define geofences that trigger {!transition} events when 161 - the device enters or leaves them. *) 162 - type waypoint = { 163 - w_tst : int; 164 - (** Timestamp when the waypoint was created or last modified. *) 40 + {1:modules Module Structure} 165 41 166 - w_lat : float; 167 - (** Latitude of the region center. *) 42 + Each message type is defined in its own module with an abstract [type t]: 168 43 169 - w_lon : float; 170 - (** Longitude of the region center. *) 44 + - {!Location} - Location messages with GPS coordinates 45 + - {!Transition} - Region entry/exit events 46 + - {!Waypoint} - Waypoint/geofence definitions 47 + - {!Card} - User information cards 48 + - {!Lwt} - Last Will and Testament messages 49 + - {!Message} - Variant type encompassing all message types 171 50 172 - w_rad : int; 173 - (** Radius of the circular region in meters. *) 51 + Additional modules for integration: 174 52 175 - w_desc : string; 176 - (** Description/name of the waypoint. *) 177 - } 53 + - {!Mqtt} - MQTT message parsing and topic helpers 54 + - {!Recorder} - OwnTracks Recorder HTTP API parsing 55 + - {!Geojson} - Convert locations to GeoJSON format *) 178 56 179 - (** Card message - provides user information for display. 57 + (** {1:types Message Types} *) 180 58 181 - Cards allow users to share their name and photo with others tracking 182 - their location. The tracker ID must match the location message's [tid] 183 - to associate the card with the correct user. *) 184 - type card = { 185 - c_name : string option; 186 - (** Full name of the user. *) 59 + (** Location message - the primary OwnTracks message type. *) 60 + module Location = Owntracks_location 187 61 188 - c_face : string option; 189 - (** Base64-encoded image (typically JPEG or PNG). *) 62 + (** Transition event - region entry/exit. *) 63 + module Transition = Owntracks_transition 190 64 191 - c_tid : string option; 192 - (** Tracker ID that this card belongs to. Must match the [tid] in 193 - location messages to be associated correctly. *) 194 - } 65 + (** Waypoint definition - monitored circular region. *) 66 + module Waypoint = Owntracks_waypoint 195 67 196 - (** LWT (Last Will and Testament) message. 68 + (** Card message - user information for display. *) 69 + module Card = Owntracks_card 197 70 198 - Published automatically by the MQTT broker when a client disconnects 199 - unexpectedly. This allows subscribers to know when a device has gone 200 - offline. *) 201 - type lwt = { 202 - lwt_tst : int; 203 - (** Timestamp of the disconnection. *) 204 - } 71 + (** LWT (Last Will and Testament) message. *) 72 + module Lwt = Owntracks_lwt 205 73 206 74 (** All OwnTracks message types as a variant. *) 207 - type message = 208 - | Location of location 209 - (** A location update from the device. *) 210 - | Transition of transition 211 - (** A region entry/exit event. *) 212 - | Waypoint of waypoint 213 - (** A waypoint/region definition. *) 214 - | Card of card 215 - (** User information card. *) 216 - | Lwt of lwt 217 - (** Client disconnection notification. *) 218 - | Unknown of string * Jsont.json 219 - (** Unknown message type. Contains the [_type] value and raw JSON 220 - for messages that don't match known types. *) 75 + module Message = Owntracks_message 221 76 222 - (** {1:codecs JSON Codecs} 77 + (** {1:integration Integration Modules} *) 223 78 224 - These codecs can be used with jsont for encoding and decoding individual 225 - message types. For most use cases, {!decode_message} is more convenient. *) 79 + (** MQTT integration for OwnTracks messages. *) 80 + module Mqtt = Owntracks_mqtt 226 81 227 - val location_jsont : location Jsont.t 228 - (** JSON codec for location messages. *) 82 + (** OwnTracks Recorder HTTP API codecs. *) 83 + module Recorder = Owntracks_recorder 229 84 230 - val transition_jsont : transition Jsont.t 231 - (** JSON codec for transition messages. *) 232 - 233 - val waypoint_jsont : waypoint Jsont.t 234 - (** JSON codec for waypoint messages. *) 235 - 236 - val card_jsont : card Jsont.t 237 - (** JSON codec for card messages. *) 238 - 239 - val lwt_jsont : lwt Jsont.t 240 - (** JSON codec for LWT messages. *) 241 - 242 - (** {1:decoding Decoding} *) 243 - 244 - val decode_message : string -> (message, string) result 245 - (** [decode_message json_str] decodes a JSON string into an OwnTracks message. 246 - 247 - The message type is determined by the ["_type"] field in the JSON: 248 - - ["location"] -> {!Location} 249 - - ["transition"] -> {!Transition} 250 - - ["waypoint"] or ["waypoints"] -> {!Waypoint} 251 - - ["card"] -> {!Card} 252 - - ["lwt"] -> {!Lwt} 253 - - Other values -> {!Unknown} 254 - 255 - Returns [Error] with an error message if the JSON is malformed or 256 - missing required fields. *) 257 - 258 - (** {1:formatting Formatting and Display} *) 259 - 260 - val format_timestamp : int -> string 261 - (** [format_timestamp tst] formats a Unix timestamp as an ISO 8601 string 262 - in UTC timezone. 263 - 264 - Example: [format_timestamp 1234567890] returns ["2009-02-13 23:31:30 UTC"]. *) 265 - 266 - val parse_topic : string -> (string * string) option 267 - (** [parse_topic topic] extracts the user and device from an OwnTracks topic. 268 - 269 - OwnTracks topics follow the pattern [owntracks/user/device]. 270 - 271 - Returns [Some (user, device)] if the topic matches, [None] otherwise. *) 272 - 273 - val pp_location : Format.formatter -> location -> unit 274 - (** [pp_location ppf loc] pretty-prints a location message. *) 275 - 276 - val pp_transition : Format.formatter -> transition -> unit 277 - (** [pp_transition ppf tr] pretty-prints a transition message. *) 278 - 279 - val pp_message : Format.formatter -> message -> unit 280 - (** [pp_message ppf msg] pretty-prints any OwnTracks message. *) 281 - 282 - (** {1:mqtt MQTT Integration} *) 283 - 284 - (** MQTT integration for OwnTracks messages. 285 - 286 - This module provides helpers for parsing MQTT messages into OwnTracks 287 - types and constructing MQTT topic patterns for subscriptions. 288 - 289 - {2 Topic Format} 290 - 291 - OwnTracks uses the topic pattern [owntracks/{user}/{device}] where: 292 - - [{user}] is typically a username or identifier 293 - - [{device}] identifies the specific device (phone, tablet, etc.) 294 - 295 - Use {!Mqtt.default_topic} to subscribe to all OwnTracks messages, or 296 - {!Mqtt.user_topic} / {!Mqtt.device_topic} for filtered subscriptions. *) 297 - module Mqtt : sig 298 - 299 - (** {1:types Types} *) 300 - 301 - type mqtt_message = { 302 - topic : string; 303 - payload : string; 304 - qos : [ `At_most_once | `At_least_once | `Exactly_once ]; 305 - retain : bool; 306 - } 307 - (** Raw MQTT message with topic, payload, QoS level, and retain flag. *) 308 - 309 - type t = { 310 - topic : string; 311 - user : string option; 312 - device : string option; 313 - message : message; 314 - } 315 - (** Parsed OwnTracks message with extracted user/device information. *) 316 - 317 - (** {1:parsing Parsing} *) 318 - 319 - val of_mqtt_message : mqtt_message -> (t, string) result 320 - (** [of_mqtt_message msg] parses an MQTT message into an OwnTracks message. 321 - 322 - Extracts user and device from the topic if it follows the OwnTracks 323 - convention ([owntracks/user/device]). The topic is also injected into 324 - the message payload for location messages. 325 - 326 - Returns [Error] if the payload is not valid OwnTracks JSON. *) 327 - 328 - val of_mqtt : topic:string -> payload:string -> (t, string) result 329 - (** [of_mqtt ~topic ~payload] is a convenience function for parsing 330 - MQTT messages without constructing an {!mqtt_message} record. 331 - 332 - Equivalent to calling {!of_mqtt_message} with default QoS and 333 - retain settings. *) 334 - 335 - (** {1:topics Topic Helpers} *) 85 + (** Convert OwnTracks locations to GeoJSON format. *) 86 + module Geojson = Owntracks_geojson_output 336 87 337 - val default_topic : string 338 - (** [default_topic] is ["owntracks/#"], a wildcard topic that matches 339 - all OwnTracks messages from all users and devices. *) 340 - 341 - val user_topic : string -> string 342 - (** [user_topic user] returns ["owntracks/{user}/#"], matching all 343 - devices for a specific user. *) 344 - 345 - val device_topic : user:string -> device:string -> string 346 - (** [device_topic ~user ~device] returns ["owntracks/{user}/{device}"], 347 - matching a specific device. *) 348 - 349 - (** {1:formatting Pretty Printing} *) 350 - 351 - val pp : Format.formatter -> t -> unit 352 - (** [pp ppf msg] pretty-prints an OwnTracks MQTT message with user/device 353 - information. *) 354 - end 355 - 356 - (** {1:recorder OwnTracks Recorder API} *) 357 - 358 - (** JSON parsing for the OwnTracks Recorder HTTP API. 359 - 360 - The {{:https://github.com/owntracks/recorder}OwnTracks Recorder} is a 361 - server that stores location history and provides an HTTP API for 362 - querying it. 363 - 364 - This module provides functions to parse JSON responses from the 365 - Recorder API. The actual HTTP client implementation is left to the 366 - application. 367 - 368 - {2 API Endpoints} 369 - 370 - The Recorder provides these endpoints: 371 - - [GET /api/0/list] - List all users 372 - - [GET /api/0/list?user=USER] - List devices for a user 373 - - [GET /api/0/locations?user=USER&device=DEVICE&from=DATE&to=DATE] - 374 - Fetch location history *) 375 - module Recorder : sig 376 - 377 - (** {1:types Types} *) 378 - 379 - type auth = { 380 - username : string; 381 - password : string; 382 - } 383 - (** HTTP Basic Authentication credentials. *) 384 - 385 - (** {1:parsing JSON Parsing} *) 386 - 387 - val location_of_json : Jsont.json -> location option 388 - (** [location_of_json json] attempts to parse a JSON object as a location. 389 - 390 - Returns [Some location] if the JSON contains at least [lat], [lon], 391 - and [tst] fields; [None] otherwise. *) 392 - 393 - val parse_locations_json : string -> location list 394 - (** [parse_locations_json json_str] parses a JSON response containing 395 - location data. 396 - 397 - Handles two response formats: 398 - - Array format: [\[{...}, {...}, ...\]] 399 - - Object format: [{"data": \[{...}, {...}, ...\]}] 400 - 401 - Returns an empty list if parsing fails or no valid locations found. *) 402 - 403 - val parse_string_list : string -> string list 404 - (** [parse_string_list json_str] parses a JSON response containing a 405 - list of strings (e.g., usernames or device names). 406 - 407 - Handles two response formats: 408 - - Array format: [\["a", "b", ...\]] 409 - - Object format: [{"results": \["a", "b", ...\]}] 410 - 411 - Returns an empty list if parsing fails. *) 412 - end 413 - 414 - (** {1:geojson GeoJSON Output} *) 415 - 416 - (** Convert OwnTracks locations to GeoJSON format. 417 - 418 - This module provides functions to convert location data into 419 - {{:https://geojson.org/}GeoJSON} Point and LineString features 420 - for use in mapping applications. 421 - 422 - The output is compatible with tools like Leaflet, MapLibre, QGIS, 423 - and geojson.io. *) 424 - module Geojson_output : sig 425 - 426 - val point_feature : device_name:string -> location -> Geojson.Geojson.t 427 - (** [point_feature ~device_name loc] creates a GeoJSON Feature with 428 - Point geometry from a single location. 429 - 430 - The feature properties include: 431 - - [name]: the device name 432 - - [timestamp]: Unix timestamp 433 - - [time]: formatted timestamp string 434 - - [accuracy]: horizontal accuracy (if available) 435 - - [speed]: velocity in km/h (if available) 436 - - [battery]: battery percentage (if available) 437 - - [tracker_id]: tracker ID (if available) *) 438 - 439 - val linestring_feature : device_name:string -> location list -> Geojson.Geojson.t 440 - (** [linestring_feature ~device_name locs] creates a GeoJSON Feature 441 - with LineString geometry from a list of locations. 442 - 443 - Locations are sorted by timestamp before creating the line. The 444 - feature properties include: 445 - - [name]: the device name 446 - - [points]: number of positions in the line 447 - - [start_time]: formatted timestamp of first point 448 - - [end_time]: formatted timestamp of last point *) 449 - 450 - val to_string : Geojson.Geojson.t -> string 451 - (** [to_string geojson] encodes the GeoJSON value as a JSON string. *) 452 - end
+42
lib/owntracks_card.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + type t = { 7 + name : string option; 8 + face : string option; 9 + tid : string option; 10 + } 11 + 12 + let v ?name ?face ?tid () = { name; face; tid } 13 + 14 + let name t = t.name 15 + let face t = t.face 16 + let tid t = t.tid 17 + 18 + let jsont_bare : t Jsont.t = 19 + let make name face tid = { name; face; tid } in 20 + Jsont.Object.map ~kind:"card" make 21 + |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.name) 22 + |> Jsont.Object.opt_mem "face" Jsont.string ~enc:(fun c -> c.face) 23 + |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun c -> c.tid) 24 + |> Jsont.Object.skip_unknown 25 + |> Jsont.Object.finish 26 + 27 + let jsont : t Jsont.t = 28 + let make _type name face tid = 29 + ignore _type; 30 + { name; face; tid } 31 + in 32 + Jsont.Object.map ~kind:"card" make 33 + |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "card") 34 + |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun c -> c.name) 35 + |> Jsont.Object.opt_mem "face" Jsont.string ~enc:(fun c -> c.face) 36 + |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun c -> c.tid) 37 + |> Jsont.Object.skip_unknown 38 + |> Jsont.Object.finish 39 + 40 + let pp ppf card = 41 + Format.fprintf ppf "Card: %s" 42 + (Option.value ~default:"(no name)" card.name)
+53
lib/owntracks_card.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Card message type for OwnTracks. 7 + 8 + @canonical Owntracks.Card 9 + 10 + Provides user information for display. Cards allow users to share 11 + their name and photo with others tracking their location. The 12 + tracker ID must match the location message's tid to associate the 13 + card with the correct user. *) 14 + 15 + type t 16 + (** The type for card messages. *) 17 + 18 + (** {1 Constructors} *) 19 + 20 + val v : 21 + ?name:string -> 22 + ?face:string -> 23 + ?tid:string -> 24 + unit -> 25 + t 26 + (** [v ()] creates a card message with optional fields. *) 27 + 28 + (** {1 Accessors} *) 29 + 30 + val name : t -> string option 31 + (** [name card] returns the full name of the user, if present. *) 32 + 33 + val face : t -> string option 34 + (** [face card] returns the Base64-encoded image (typically JPEG or PNG), 35 + if present. *) 36 + 37 + val tid : t -> string option 38 + (** [tid card] returns the tracker ID that this card belongs to. Must 39 + match the tid in location messages to be associated correctly. *) 40 + 41 + (** {1 JSON Codec} *) 42 + 43 + val jsont : t Jsont.t 44 + (** [jsont] is a JSON codec for card messages. 45 + Expects the ["_type"] field to be ["card"]. *) 46 + 47 + val jsont_bare : t Jsont.t 48 + (** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *) 49 + 50 + (** {1 Pretty Printing} *) 51 + 52 + val pp : Format.formatter -> t -> unit 53 + (** [pp ppf card] pretty-prints a card message. *)
+59
lib/owntracks_geojson_output.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + open Geojson 7 + 8 + let pos_of_loc loc = 9 + Geometry.Position.v 10 + ?altitude:(Owntracks_location.alt loc) 11 + ~lng:(Owntracks_location.lon loc) 12 + ~lat:(Owntracks_location.lat loc) 13 + () 14 + 15 + let props ~device_name ~timestamp ~time ?accuracy ?speed ?battery ?tracker_id () = 16 + let open Jsont.Json in 17 + let add n f opt acc = match opt with Some v -> (n, f v) :: acc | None -> acc in 18 + [ 19 + ("name", string device_name); 20 + ("timestamp", int timestamp); 21 + ("time", string time) 22 + ] 23 + |> add "accuracy" number accuracy 24 + |> add "speed" number speed 25 + |> add "battery" int battery 26 + |> add "tracker_id" string tracker_id 27 + |> fun mems -> Jsont.Json.object' (List.map (fun (n, v) -> Jsont.Json.mem (Jsont.Json.name n) v) mems) 28 + 29 + let point_feature ~device_name loc : Geojson.t = 30 + let point = Geometry.Point.v (pos_of_loc loc) in 31 + let geom : Geojson.geometry = `Point point in 32 + let tst = Owntracks_location.tst loc in 33 + let properties = Some (props ~device_name ~timestamp:tst 34 + ~time:(Owntracks_location.format_timestamp tst) 35 + ?accuracy:(Owntracks_location.acc loc) 36 + ?speed:(Owntracks_location.vel loc) 37 + ?battery:(Owntracks_location.batt loc) 38 + ?tracker_id:(Owntracks_location.tid loc) ()) in 39 + let feature = Geojson.Feature.v ?properties geom in 40 + `Feature feature 41 + 42 + let linestring_feature ~device_name locs : Geojson.t = 43 + let sorted = List.sort (fun a b -> 44 + Int.compare (Owntracks_location.tst a) (Owntracks_location.tst b)) locs in 45 + let positions = Array.of_list (List.map pos_of_loc sorted) in 46 + let line = Geometry.LineString.v positions in 47 + let geom : Geojson.geometry = `Line_string line in 48 + let start_time = match sorted with [] -> 0 | h :: _ -> Owntracks_location.tst h in 49 + let end_time = match List.rev sorted with [] -> 0 | h :: _ -> Owntracks_location.tst h in 50 + let properties = Some (Jsont.Json.object' [ 51 + Jsont.Json.mem (Jsont.Json.name "name") (Jsont.Json.string device_name); 52 + Jsont.Json.mem (Jsont.Json.name "points") (Jsont.Json.int (List.length sorted)); 53 + Jsont.Json.mem (Jsont.Json.name "start_time") (Jsont.Json.string (Owntracks_location.format_timestamp start_time)); 54 + Jsont.Json.mem (Jsont.Json.name "end_time") (Jsont.Json.string (Owntracks_location.format_timestamp end_time)); 55 + ]) in 56 + let feature = Geojson.Feature.v ?properties geom in 57 + `Feature feature 58 + 59 + let to_string = Geojson.to_string
+42
lib/owntracks_geojson_output.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Convert OwnTracks locations to GeoJSON format. 7 + 8 + @canonical Owntracks.Geojson 9 + 10 + This module provides functions to convert location data into 11 + {{:https://geojson.org/}GeoJSON} Point and LineString features 12 + for use in mapping applications. 13 + 14 + The output is compatible with tools like Leaflet, MapLibre, QGIS, 15 + and geojson.io. *) 16 + 17 + val point_feature : device_name:string -> Owntracks_location.t -> Geojson.Geojson.t 18 + (** [point_feature ~device_name loc] creates a GeoJSON Feature with 19 + Point geometry from a single location. 20 + 21 + The feature properties include: 22 + - [name]: the device name 23 + - [timestamp]: Unix timestamp 24 + - [time]: formatted timestamp string 25 + - [accuracy]: horizontal accuracy (if available) 26 + - [speed]: velocity in km/h (if available) 27 + - [battery]: battery percentage (if available) 28 + - [tracker_id]: tracker ID (if available) *) 29 + 30 + val linestring_feature : device_name:string -> Owntracks_location.t list -> Geojson.Geojson.t 31 + (** [linestring_feature ~device_name locs] creates a GeoJSON Feature 32 + with LineString geometry from a list of locations. 33 + 34 + Locations are sorted by timestamp before creating the line. The 35 + feature properties include: 36 + - [name]: the device name 37 + - [points]: number of positions in the line 38 + - [start_time]: formatted timestamp of first point 39 + - [end_time]: formatted timestamp of last point *) 40 + 41 + val to_string : Geojson.Geojson.t -> string 42 + (** [to_string geojson] encodes the GeoJSON value as a JSON string. *)
+182
lib/owntracks_location.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + type t = { 7 + tid : string option; 8 + tst : int; 9 + lat : float; 10 + lon : float; 11 + alt : float option; 12 + acc : float option; 13 + vel : float option; 14 + cog : float option; 15 + batt : int option; 16 + bs : int option; 17 + conn : string option; 18 + t : string option; 19 + m : int option; 20 + poi : string option; 21 + inregions : string list; 22 + addr : string option; 23 + topic : string option; 24 + } 25 + 26 + let v ?tid ~tst ~lat ~lon ?alt ?acc ?vel ?cog ?batt ?bs ?conn ?t ?m ?poi 27 + ?(inregions = []) ?addr ?topic () = 28 + { tid; tst; lat; lon; alt; acc; vel; cog; batt; bs; conn; t; m; poi; 29 + inregions; addr; topic } 30 + 31 + let tid t = t.tid 32 + let tst t = t.tst 33 + let lat t = t.lat 34 + let lon t = t.lon 35 + let alt t = t.alt 36 + let acc t = t.acc 37 + let vel t = t.vel 38 + let cog t = t.cog 39 + let batt t = t.batt 40 + let bs t = t.bs 41 + let conn t = t.conn 42 + let trigger t = t.t 43 + let monitoring_mode t = t.m 44 + let poi t = t.poi 45 + let inregions t = t.inregions 46 + let addr t = t.addr 47 + let topic t = t.topic 48 + 49 + let with_topic topic t = { t with topic = Some topic } 50 + 51 + let jsont : t Jsont.t = 52 + let make _type tid tst lat lon alt acc vel cog batt bs conn t m poi 53 + inregions addr topic = 54 + ignore _type; 55 + { tid; tst; lat; lon; alt; acc; vel; cog; batt; bs; conn; t; m; poi; 56 + inregions = Option.value ~default:[] inregions; addr; topic } 57 + in 58 + Jsont.Object.map ~kind:"location" make 59 + |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "location") 60 + |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun l -> l.tid) 61 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst) 62 + |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun l -> l.lat) 63 + |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun l -> l.lon) 64 + |> Jsont.Object.opt_mem "alt" Jsont.number ~enc:(fun l -> l.alt) 65 + |> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun l -> l.acc) 66 + |> Jsont.Object.opt_mem "vel" Jsont.number ~enc:(fun l -> l.vel) 67 + |> Jsont.Object.opt_mem "cog" Jsont.number ~enc:(fun l -> l.cog) 68 + |> Jsont.Object.opt_mem "batt" Jsont.int ~enc:(fun l -> l.batt) 69 + |> Jsont.Object.opt_mem "bs" Jsont.int ~enc:(fun l -> l.bs) 70 + |> Jsont.Object.opt_mem "conn" Jsont.string ~enc:(fun l -> l.conn) 71 + |> Jsont.Object.opt_mem "t" Jsont.string ~enc:(fun l -> l.t) 72 + |> Jsont.Object.opt_mem "m" Jsont.int ~enc:(fun l -> l.m) 73 + |> Jsont.Object.opt_mem "poi" Jsont.string ~enc:(fun l -> l.poi) 74 + |> Jsont.Object.opt_mem "inregions" (Jsont.list Jsont.string) 75 + ~enc:(fun l -> match l.inregions with [] -> None | xs -> Some xs) 76 + |> Jsont.Object.opt_mem "addr" Jsont.string ~enc:(fun l -> l.addr) 77 + |> Jsont.Object.opt_mem "topic" Jsont.string ~enc:(fun l -> l.topic) 78 + |> Jsont.Object.skip_unknown 79 + |> Jsont.Object.finish 80 + 81 + let jsont_bare : t Jsont.t = 82 + let make tid tst lat lon alt acc vel cog batt bs conn t m poi 83 + inregions addr topic = 84 + { tid; tst; lat; lon; alt; acc; vel; cog; batt; bs; conn; t; m; poi; 85 + inregions = Option.value ~default:[] inregions; addr; topic } 86 + in 87 + Jsont.Object.map ~kind:"location" make 88 + |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun l -> l.tid) 89 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst) 90 + |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun l -> l.lat) 91 + |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun l -> l.lon) 92 + |> Jsont.Object.opt_mem "alt" Jsont.number ~enc:(fun l -> l.alt) 93 + |> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun l -> l.acc) 94 + |> Jsont.Object.opt_mem "vel" Jsont.number ~enc:(fun l -> l.vel) 95 + |> Jsont.Object.opt_mem "cog" Jsont.number ~enc:(fun l -> l.cog) 96 + |> Jsont.Object.opt_mem "batt" Jsont.int ~enc:(fun l -> l.batt) 97 + |> Jsont.Object.opt_mem "bs" Jsont.int ~enc:(fun l -> l.bs) 98 + |> Jsont.Object.opt_mem "conn" Jsont.string ~enc:(fun l -> l.conn) 99 + |> Jsont.Object.opt_mem "t" Jsont.string ~enc:(fun l -> l.t) 100 + |> Jsont.Object.opt_mem "m" Jsont.int ~enc:(fun l -> l.m) 101 + |> Jsont.Object.opt_mem "poi" Jsont.string ~enc:(fun l -> l.poi) 102 + |> Jsont.Object.opt_mem "inregions" (Jsont.list Jsont.string) 103 + ~enc:(fun l -> match l.inregions with [] -> None | xs -> Some xs) 104 + |> Jsont.Object.opt_mem "addr" Jsont.string ~enc:(fun l -> l.addr) 105 + |> Jsont.Object.opt_mem "topic" Jsont.string ~enc:(fun l -> l.topic) 106 + |> Jsont.Object.skip_unknown 107 + |> Jsont.Object.finish 108 + 109 + let format_timestamp tst = 110 + let t = Unix.gmtime (float_of_int tst) in 111 + Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC" 112 + (t.Unix.tm_year + 1900) (t.Unix.tm_mon + 1) t.Unix.tm_mday 113 + t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec 114 + 115 + let pp_code_map ~unknown codes ppf = function 116 + | Some s -> 117 + let display = List.assoc_opt s codes |> Option.value ~default:s in 118 + Format.pp_print_string ppf display 119 + | None -> Format.pp_print_string ppf unknown 120 + 121 + let pp_conn = 122 + pp_code_map ~unknown:"Unknown" 123 + ["w", "WiFi"; "m", "Mobile"; "o", "Offline"] 124 + 125 + let pp_trigger = 126 + pp_code_map ~unknown:"Unknown" 127 + ["p", "Ping"; "c", "Circular region"; "b", "Beacon"; "r", "Response"; 128 + "u", "Manual"; "t", "Timer"; "v", "Monitoring"] 129 + 130 + let parse_topic topic = 131 + match String.split_on_char '/' topic with 132 + | _ :: user :: device :: _ -> Some (user, device) 133 + | _ -> None 134 + 135 + let pp ppf loc = 136 + Format.fprintf ppf "@[<v 0>"; 137 + Format.fprintf ppf "-------------------------------------------@,"; 138 + begin match loc.topic with 139 + | Some topic -> 140 + begin match parse_topic topic with 141 + | Some (user, device) -> 142 + Format.fprintf ppf " User: %s / %s" user device; 143 + Option.iter (fun tid -> Format.fprintf ppf " [%s]" tid) loc.tid; 144 + Format.fprintf ppf "@," 145 + | None -> 146 + Format.fprintf ppf " Topic: %s@," topic 147 + end 148 + | None -> 149 + Option.iter (fun tid -> 150 + Format.fprintf ppf " Tracker: %s@," tid 151 + ) loc.tid 152 + end; 153 + Format.fprintf ppf " Time: %s@," (format_timestamp loc.tst); 154 + Format.fprintf ppf " Location: %.6f, %.6f@," loc.lat loc.lon; 155 + Option.iter (fun alt -> 156 + Format.fprintf ppf " Altitude: %.1f m@," alt 157 + ) loc.alt; 158 + Option.iter (fun acc -> 159 + Format.fprintf ppf " Accuracy: +/- %.0f m@," acc 160 + ) loc.acc; 161 + Option.iter (fun vel -> 162 + Format.fprintf ppf " Speed: %.1f km/h@," vel 163 + ) loc.vel; 164 + Option.iter (fun cog -> 165 + Format.fprintf ppf " Heading: %.0f deg@," cog 166 + ) loc.cog; 167 + Option.iter (fun batt -> 168 + Format.fprintf ppf " Battery: %d%%@," batt 169 + ) loc.batt; 170 + Format.fprintf ppf " Conn: %a@," pp_conn loc.conn; 171 + Option.iter (fun _ -> 172 + Format.fprintf ppf " Trigger: %a@," pp_trigger loc.t 173 + ) loc.t; 174 + Option.iter (fun poi -> 175 + Format.fprintf ppf " POI: %s@," poi 176 + ) loc.poi; 177 + if loc.inregions <> [] then 178 + Format.fprintf ppf " Regions: %s@," (String.concat ", " loc.inregions); 179 + Option.iter (fun addr -> 180 + Format.fprintf ppf " Address: %s@," addr 181 + ) loc.addr; 182 + Format.fprintf ppf "-------------------------------------------@]"
+146
lib/owntracks_location.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Location message type for OwnTracks. 7 + 8 + @canonical Owntracks.Location 9 + 10 + The primary OwnTracks message type, published when the device reports 11 + its location. Contains GPS coordinates, accuracy, altitude, speed, 12 + heading, and various device state information. 13 + 14 + Required fields are latitude, longitude, and timestamp. All other 15 + fields are optional and may not be present depending on device 16 + capabilities and settings. *) 17 + 18 + type t 19 + (** The type for location messages. *) 20 + 21 + (** {1 Constructors} *) 22 + 23 + val v : 24 + ?tid:string -> 25 + tst:int -> 26 + lat:float -> 27 + lon:float -> 28 + ?alt:float -> 29 + ?acc:float -> 30 + ?vel:float -> 31 + ?cog:float -> 32 + ?batt:int -> 33 + ?bs:int -> 34 + ?conn:string -> 35 + ?t:string -> 36 + ?m:int -> 37 + ?poi:string -> 38 + ?inregions:string list -> 39 + ?addr:string -> 40 + ?topic:string -> 41 + unit -> 42 + t 43 + (** [v ~tst ~lat ~lon ()] creates a location with the required fields. 44 + Optional fields can be provided as labeled arguments. *) 45 + 46 + (** {1 Accessors} *) 47 + 48 + val tid : t -> string option 49 + (** [tid loc] returns the tracker ID - a short identifier (typically 2 50 + characters) configured in the app. *) 51 + 52 + val tst : t -> int 53 + (** [tst loc] returns the timestamp as Unix epoch (seconds since 54 + 1970-01-01 00:00:00 UTC). *) 55 + 56 + val lat : t -> float 57 + (** [lat loc] returns the latitude in decimal degrees. Range: -90 to +90. *) 58 + 59 + val lon : t -> float 60 + (** [lon loc] returns the longitude in decimal degrees. Range: -180 to +180. *) 61 + 62 + val alt : t -> float option 63 + (** [alt loc] returns the altitude above sea level in meters, if present. *) 64 + 65 + val acc : t -> float option 66 + (** [acc loc] returns the horizontal accuracy (radius) in meters, if present. *) 67 + 68 + val vel : t -> float option 69 + (** [vel loc] returns the velocity (speed) in km/h, if present. *) 70 + 71 + val cog : t -> float option 72 + (** [cog loc] returns the course over ground (heading) in degrees from 73 + true north (0-360), if present. *) 74 + 75 + val batt : t -> int option 76 + (** [batt loc] returns the battery level as percentage (0-100), if present. *) 77 + 78 + val bs : t -> int option 79 + (** [bs loc] returns the battery status, if present: 80 + - [0] = unknown 81 + - [1] = unplugged 82 + - [2] = charging 83 + - [3] = full *) 84 + 85 + val conn : t -> string option 86 + (** [conn loc] returns the connection type, if present: 87 + - ["w"] = WiFi 88 + - ["m"] = Mobile/cellular 89 + - ["o"] = Offline *) 90 + 91 + val trigger : t -> string option 92 + (** [trigger loc] returns what caused this location report, if present: 93 + - ["p"] = Ping (response to request) 94 + - ["c"] = Circular region event 95 + - ["b"] = Beacon event 96 + - ["r"] = Response to reportLocation 97 + - ["u"] = Manual/user-initiated 98 + - ["t"] = Timer-based 99 + - ["v"] = Monitoring mode change *) 100 + 101 + val monitoring_mode : t -> int option 102 + (** [monitoring_mode loc] returns the monitoring mode, if present: 103 + - [0] = Quiet (no location reporting) 104 + - [1] = Manual (only when requested) 105 + - [2] = Significant changes only 106 + - [3] = Move mode (frequent updates) *) 107 + 108 + val poi : t -> string option 109 + (** [poi loc] returns the Point of Interest name if the device is 110 + currently at a defined location. *) 111 + 112 + val inregions : t -> string list 113 + (** [inregions loc] returns the list of region names the device is 114 + currently inside. May be empty. *) 115 + 116 + val addr : t -> string option 117 + (** [addr loc] returns the reverse-geocoded address, if present. 118 + Typically added by the OwnTracks Recorder server. *) 119 + 120 + val topic : t -> string option 121 + (** [topic loc] returns the MQTT topic this message was published to, 122 + if present. Added during parsing. *) 123 + 124 + (** {1 Modifiers} *) 125 + 126 + val with_topic : string -> t -> t 127 + (** [with_topic topic loc] returns a new location with the topic set. *) 128 + 129 + (** {1 JSON Codec} *) 130 + 131 + val jsont : t Jsont.t 132 + (** [jsont] is a JSON codec for location messages. 133 + Expects the ["_type"] field to be ["location"]. *) 134 + 135 + val jsont_bare : t Jsont.t 136 + (** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. 137 + Use this for parsing recorder API responses which omit the type field. *) 138 + 139 + (** {1 Pretty Printing} *) 140 + 141 + val pp : Format.formatter -> t -> unit 142 + (** [pp ppf loc] pretty-prints a location message. *) 143 + 144 + val format_timestamp : int -> string 145 + (** [format_timestamp tst] formats a Unix timestamp as an ISO 8601 string 146 + in UTC timezone. *)
+32
lib/owntracks_lwt.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + type t = { tst : int } 7 + 8 + let v ~tst = { tst } 9 + 10 + let tst t = t.tst 11 + 12 + let jsont_bare : t Jsont.t = 13 + let make tst = { tst } in 14 + Jsont.Object.map ~kind:"lwt" make 15 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst) 16 + |> Jsont.Object.skip_unknown 17 + |> Jsont.Object.finish 18 + 19 + let jsont : t Jsont.t = 20 + let make _type tst = 21 + ignore _type; 22 + { tst } 23 + in 24 + Jsont.Object.map ~kind:"lwt" make 25 + |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "lwt") 26 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun l -> l.tst) 27 + |> Jsont.Object.skip_unknown 28 + |> Jsont.Object.finish 29 + 30 + let pp ppf lwt = 31 + Format.fprintf ppf "LWT: client disconnected at %s" 32 + (Owntracks_location.format_timestamp lwt.tst)
+39
lib/owntracks_lwt.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** LWT (Last Will and Testament) message type for OwnTracks. 7 + 8 + @canonical Owntracks.Lwt 9 + 10 + Published automatically by the MQTT broker when a client disconnects 11 + unexpectedly. This allows subscribers to know when a device has gone 12 + offline. *) 13 + 14 + type t 15 + (** The type for LWT messages. *) 16 + 17 + (** {1 Constructors} *) 18 + 19 + val v : tst:int -> t 20 + (** [v ~tst] creates an LWT message with the given timestamp. *) 21 + 22 + (** {1 Accessors} *) 23 + 24 + val tst : t -> int 25 + (** [tst lwt] returns the timestamp of the disconnection. *) 26 + 27 + (** {1 JSON Codec} *) 28 + 29 + val jsont : t Jsont.t 30 + (** [jsont] is a JSON codec for LWT messages. 31 + Expects the ["_type"] field to be ["lwt"]. *) 32 + 33 + val jsont_bare : t Jsont.t 34 + (** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *) 35 + 36 + (** {1 Pretty Printing} *) 37 + 38 + val pp : Format.formatter -> t -> unit 39 + (** [pp ppf lwt] pretty-prints an LWT message. *)
+64
lib/owntracks_message.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + type t = 7 + | Location of Owntracks_location.t 8 + | Transition of Owntracks_transition.t 9 + | Waypoint of Owntracks_waypoint.t 10 + | Card of Owntracks_card.t 11 + | Lwt of Owntracks_lwt.t 12 + | Unknown of string 13 + 14 + let location l = Location l 15 + let transition t = Transition t 16 + let waypoint w = Waypoint w 17 + let card c = Card c 18 + let lwt l = Lwt l 19 + 20 + let jsont : t Jsont.t = 21 + let case_location = 22 + Jsont.Object.Case.map "location" Owntracks_location.jsont_bare ~dec:location 23 + in 24 + let case_transition = 25 + Jsont.Object.Case.map "transition" Owntracks_transition.jsont_bare ~dec:transition 26 + in 27 + let case_waypoint = 28 + Jsont.Object.Case.map "waypoint" Owntracks_waypoint.jsont_bare ~dec:waypoint 29 + in 30 + let case_waypoints = 31 + Jsont.Object.Case.map "waypoints" Owntracks_waypoint.jsont_bare ~dec:waypoint 32 + in 33 + let case_card = 34 + Jsont.Object.Case.map "card" Owntracks_card.jsont_bare ~dec:card 35 + in 36 + let case_lwt = 37 + Jsont.Object.Case.map "lwt" Owntracks_lwt.jsont_bare ~dec:lwt 38 + in 39 + let enc_case = function 40 + | Location l -> Jsont.Object.Case.value case_location l 41 + | Transition t -> Jsont.Object.Case.value case_transition t 42 + | Waypoint w -> Jsont.Object.Case.value case_waypoint w 43 + | Card c -> Jsont.Object.Case.value case_card c 44 + | Lwt l -> Jsont.Object.Case.value case_lwt l 45 + | Unknown _ -> assert false (* Cannot encode Unknown *) 46 + in 47 + let cases = Jsont.Object.Case.[ 48 + make case_location; make case_transition; 49 + make case_waypoint; make case_waypoints; 50 + make case_card; make case_lwt 51 + ] in 52 + Jsont.Object.map ~kind:"message" Fun.id 53 + |> Jsont.Object.case_mem "_type" Jsont.string ~enc:Fun.id ~enc_case cases 54 + |> Jsont.Object.skip_unknown 55 + |> Jsont.Object.finish 56 + 57 + let pp ppf = function 58 + | Location loc -> Owntracks_location.pp ppf loc 59 + | Transition tr -> Owntracks_transition.pp ppf tr 60 + | Waypoint wp -> Owntracks_waypoint.pp ppf wp 61 + | Card c -> Owntracks_card.pp ppf c 62 + | Lwt l -> Owntracks_lwt.pp ppf l 63 + | Unknown typ -> 64 + Format.fprintf ppf "Unknown message type: %s" typ
+45
lib/owntracks_message.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** OwnTracks message variant type. 7 + 8 + @canonical Owntracks.Message 9 + 10 + All OwnTracks message types as a single variant. Use {!jsont} with 11 + {{:https://erratique.ch/software/jsont}jsont_bytesrw} to decode 12 + messages from JSON strings. *) 13 + 14 + type t = 15 + | Location of Owntracks_location.t 16 + (** A location update from the device. *) 17 + | Transition of Owntracks_transition.t 18 + (** A region entry/exit event. *) 19 + | Waypoint of Owntracks_waypoint.t 20 + (** A waypoint/region definition. *) 21 + | Card of Owntracks_card.t 22 + (** User information card. *) 23 + | Lwt of Owntracks_lwt.t 24 + (** Client disconnection notification. *) 25 + | Unknown of string 26 + (** Unknown message type. Contains the ["_type"] value. *) 27 + (** The type for OwnTracks messages. *) 28 + 29 + (** {1 JSON Codec} *) 30 + 31 + val jsont : t Jsont.t 32 + (** [jsont] is a JSON codec for OwnTracks messages. 33 + 34 + The message type is determined by the ["_type"] field in the JSON: 35 + - ["location"] -> [Location] 36 + - ["transition"] -> [Transition] 37 + - ["waypoint"] or ["waypoints"] -> [Waypoint] 38 + - ["card"] -> [Card] 39 + - ["lwt"] -> [Lwt] 40 + - Other values -> [Unknown] *) 41 + 42 + (** {1 Pretty Printing} *) 43 + 44 + val pp : Format.formatter -> t -> unit 45 + (** [pp ppf msg] pretty-prints any OwnTracks message. *)
+68
lib/owntracks_mqtt.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + module Mqtt_message = struct 7 + type t = { 8 + topic : string; 9 + payload : string; 10 + qos : [ `At_most_once | `At_least_once | `Exactly_once ]; 11 + retain : bool; 12 + } 13 + end 14 + 15 + type t = { 16 + topic : string; 17 + user : string option; 18 + device : string option; 19 + message : Owntracks_message.t; 20 + } 21 + 22 + let topic t = t.topic 23 + let user t = t.user 24 + let device t = t.device 25 + let message t = t.message 26 + 27 + let parse_topic topic = 28 + match String.split_on_char '/' topic with 29 + | _ :: user :: device :: _ -> Some (user, device) 30 + | _ -> None 31 + 32 + let of_mqtt_message (msg : Mqtt_message.t) : (t, string) result = 33 + let user, device = 34 + match parse_topic msg.topic with 35 + | Some (u, d) -> (Some u, Some d) 36 + | None -> (None, None) 37 + in 38 + let payload_with_topic = 39 + let payload = msg.payload in 40 + if String.length payload > 0 && payload.[0] = '{' then 41 + let topic_json = Printf.sprintf "{\"topic\":%S," msg.topic in 42 + topic_json ^ String.sub payload 1 (String.length payload - 1) 43 + else 44 + payload 45 + in 46 + match Jsont_bytesrw.decode_string Owntracks_message.jsont payload_with_topic with 47 + | Ok message -> Ok { topic = msg.topic; user; device; message } 48 + | Error e -> Error e 49 + 50 + let of_mqtt ~topic ~payload : (t, string) result = 51 + of_mqtt_message { Mqtt_message.topic; payload; qos = `At_least_once; retain = false } 52 + 53 + let default_topic = "owntracks/#" 54 + 55 + let user_topic user = Printf.sprintf "owntracks/%s/#" user 56 + 57 + let device_topic ~user ~device = Printf.sprintf "owntracks/%s/%s" user device 58 + 59 + let pp ppf msg = 60 + Format.fprintf ppf "@[<v 0>"; 61 + begin match msg.user, msg.device with 62 + | Some user, Some device -> 63 + Format.fprintf ppf "User: %s / Device: %s@," user device 64 + | _ -> 65 + Format.fprintf ppf "Topic: %s@," msg.topic 66 + end; 67 + Owntracks_message.pp ppf msg.message; 68 + Format.fprintf ppf "@]"
+95
lib/owntracks_mqtt.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** MQTT integration for OwnTracks messages. 7 + 8 + @canonical Owntracks.Mqtt 9 + 10 + This module provides helpers for parsing MQTT messages into OwnTracks 11 + types and constructing MQTT topic patterns for subscriptions. 12 + 13 + {1 Topic Format} 14 + 15 + OwnTracks uses the topic pattern [owntracks/{user}/{device}] where: 16 + - [{user}] is typically a username or identifier 17 + - [{device}] identifies the specific device (phone, tablet, etc.) 18 + 19 + Use {!default_topic} to subscribe to all OwnTracks messages, or 20 + {!user_topic} / {!device_topic} for filtered subscriptions. *) 21 + 22 + (** {1 Types} *) 23 + 24 + (** Raw MQTT message type. *) 25 + module Mqtt_message : sig 26 + type t = { 27 + topic : string; 28 + payload : string; 29 + qos : [ `At_most_once | `At_least_once | `Exactly_once ]; 30 + retain : bool; 31 + } 32 + (** Raw MQTT message with topic, payload, QoS level, and retain flag. *) 33 + end 34 + 35 + type t 36 + (** Parsed OwnTracks message with extracted user/device information. *) 37 + 38 + (** {1 Accessors} *) 39 + 40 + val topic : t -> string 41 + (** [topic msg] returns the MQTT topic the message was published to. *) 42 + 43 + val user : t -> string option 44 + (** [user msg] returns the user extracted from the topic, if present. *) 45 + 46 + val device : t -> string option 47 + (** [device msg] returns the device extracted from the topic, if present. *) 48 + 49 + val message : t -> Owntracks_message.t 50 + (** [message msg] returns the parsed OwnTracks message. *) 51 + 52 + (** {1 Parsing} *) 53 + 54 + val of_mqtt_message : Mqtt_message.t -> (t, string) result 55 + (** [of_mqtt_message msg] parses an MQTT message into an OwnTracks message. 56 + 57 + Extracts user and device from the topic if it follows the OwnTracks 58 + convention ([owntracks/user/device]). The topic is also injected into 59 + the message payload for location messages. 60 + 61 + Returns [Error] if the payload is not valid OwnTracks JSON. *) 62 + 63 + val of_mqtt : topic:string -> payload:string -> (t, string) result 64 + (** [of_mqtt ~topic ~payload] is a convenience function for parsing 65 + MQTT messages without constructing an {!Mqtt_message.t} record. 66 + 67 + Equivalent to calling {!of_mqtt_message} with default QoS and 68 + retain settings. *) 69 + 70 + (** {1 Topic Helpers} *) 71 + 72 + val default_topic : string 73 + (** [default_topic] is ["owntracks/#"], a wildcard topic that matches 74 + all OwnTracks messages from all users and devices. *) 75 + 76 + val user_topic : string -> string 77 + (** [user_topic user] returns ["owntracks/{user}/#"], matching all 78 + devices for a specific user. *) 79 + 80 + val device_topic : user:string -> device:string -> string 81 + (** [device_topic ~user ~device] returns ["owntracks/{user}/{device}"], 82 + matching a specific device. *) 83 + 84 + val parse_topic : string -> (string * string) option 85 + (** [parse_topic topic] extracts the user and device from an OwnTracks topic. 86 + 87 + OwnTracks topics follow the pattern [owntracks/user/device]. 88 + 89 + Returns [Some (user, device)] if the topic matches, [None] otherwise. *) 90 + 91 + (** {1 Pretty Printing} *) 92 + 93 + val pp : Format.formatter -> t -> unit 94 + (** [pp ppf msg] pretty-prints an OwnTracks MQTT message with user/device 95 + information. *)
+32
lib/owntracks_recorder.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + module Auth = struct 7 + type t = { username : string; password : string } 8 + 9 + let v ~username ~password = { username; password } 10 + let username t = t.username 11 + let password t = t.password 12 + end 13 + 14 + let locations_jsont : Owntracks_location.t list Jsont.t = 15 + Jsont.list Owntracks_location.jsont_bare 16 + 17 + let locations_data_jsont : Owntracks_location.t list Jsont.t = 18 + let make data = data in 19 + Jsont.Object.map ~kind:"data_response" make 20 + |> Jsont.Object.mem "data" locations_jsont ~enc:Fun.id 21 + |> Jsont.Object.skip_unknown 22 + |> Jsont.Object.finish 23 + 24 + let string_list_jsont : string list Jsont.t = 25 + Jsont.list Jsont.string 26 + 27 + let string_list_results_jsont : string list Jsont.t = 28 + let make results = results in 29 + Jsont.Object.map ~kind:"results_response" make 30 + |> Jsont.Object.mem "results" string_list_jsont ~enc:Fun.id 31 + |> Jsont.Object.skip_unknown 32 + |> Jsont.Object.finish
+55
lib/owntracks_recorder.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** JSON codecs for OwnTracks Recorder HTTP API responses. 7 + 8 + @canonical Owntracks.Recorder 9 + 10 + The {{:https://github.com/owntracks/recorder}OwnTracks Recorder} is a 11 + server that stores location history and provides an HTTP API for 12 + querying it. 13 + 14 + This module provides codecs for parsing JSON responses from the 15 + Recorder API. Use these with jsont_bytesrw for decoding. 16 + 17 + {1 API Endpoints} 18 + 19 + The Recorder provides these endpoints: 20 + - [GET /api/0/list] - List all users 21 + - [GET /api/0/list?user=USER] - List devices for a user 22 + - [GET /api/0/locations?user=USER&device=DEVICE&from=DATE&to=DATE] - 23 + Fetch location history *) 24 + 25 + (** {1 Types} *) 26 + 27 + (** HTTP Basic Authentication credentials. *) 28 + module Auth : sig 29 + type t 30 + (** The type for authentication credentials. *) 31 + 32 + val v : username:string -> password:string -> t 33 + (** [v ~username ~password] creates authentication credentials. *) 34 + 35 + val username : t -> string 36 + (** [username auth] returns the username. *) 37 + 38 + val password : t -> string 39 + (** [password auth] returns the password. *) 40 + end 41 + 42 + (** {1 JSON Codecs} *) 43 + 44 + val locations_jsont : Owntracks_location.t list Jsont.t 45 + (** Codec for a JSON array of location objects (without ["_type"] field). 46 + Use with the [/api/0/locations] endpoint when it returns an array. *) 47 + 48 + val locations_data_jsont : Owntracks_location.t list Jsont.t 49 + (** Codec for [{data: [...]}] response format from some recorder endpoints. *) 50 + 51 + val string_list_jsont : string list Jsont.t 52 + (** Codec for a JSON array of strings (e.g., usernames or device names). *) 53 + 54 + val string_list_results_jsont : string list Jsont.t 55 + (** Codec for [{results: [...]}] response format from [/api/0/list]. *)
+75
lib/owntracks_transition.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + type t = { 7 + tid : string option; 8 + tst : int; 9 + lat : float; 10 + lon : float; 11 + acc : float option; 12 + event : string; 13 + desc : string option; 14 + wtst : int option; 15 + } 16 + 17 + let v ?tid ~tst ~lat ~lon ?acc ~event ?desc ?wtst () = 18 + { tid; tst; lat; lon; acc; event; desc; wtst } 19 + 20 + let tid t = t.tid 21 + let tst t = t.tst 22 + let lat t = t.lat 23 + let lon t = t.lon 24 + let acc t = t.acc 25 + let event t = t.event 26 + let desc t = t.desc 27 + let wtst t = t.wtst 28 + 29 + let jsont_bare : t Jsont.t = 30 + let make tid tst lat lon acc event desc wtst = 31 + { tid; tst; lat; lon; acc; event; desc; wtst } 32 + in 33 + Jsont.Object.map ~kind:"transition" make 34 + |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun t -> t.tid) 35 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun t -> t.tst) 36 + |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun t -> t.lat) 37 + |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun t -> t.lon) 38 + |> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun t -> t.acc) 39 + |> Jsont.Object.mem "event" Jsont.string ~enc:(fun t -> t.event) 40 + |> Jsont.Object.opt_mem "desc" Jsont.string ~enc:(fun t -> t.desc) 41 + |> Jsont.Object.opt_mem "wtst" Jsont.int ~enc:(fun t -> t.wtst) 42 + |> Jsont.Object.skip_unknown 43 + |> Jsont.Object.finish 44 + 45 + let jsont : t Jsont.t = 46 + let make _type tid tst lat lon acc event desc wtst = 47 + ignore _type; 48 + { tid; tst; lat; lon; acc; event; desc; wtst } 49 + in 50 + Jsont.Object.map ~kind:"transition" make 51 + |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "transition") 52 + |> Jsont.Object.opt_mem "tid" Jsont.string ~enc:(fun t -> t.tid) 53 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun t -> t.tst) 54 + |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun t -> t.lat) 55 + |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun t -> t.lon) 56 + |> Jsont.Object.opt_mem "acc" Jsont.number ~enc:(fun t -> t.acc) 57 + |> Jsont.Object.mem "event" Jsont.string ~enc:(fun t -> t.event) 58 + |> Jsont.Object.opt_mem "desc" Jsont.string ~enc:(fun t -> t.desc) 59 + |> Jsont.Object.opt_mem "wtst" Jsont.int ~enc:(fun t -> t.wtst) 60 + |> Jsont.Object.skip_unknown 61 + |> Jsont.Object.finish 62 + 63 + let pp ppf tr = 64 + Format.fprintf ppf "@[<v 0>"; 65 + Format.fprintf ppf "-------------------------------------------@,"; 66 + Format.fprintf ppf " Event: %s@," (String.uppercase_ascii tr.event); 67 + Option.iter (fun desc -> 68 + Format.fprintf ppf " Region: %s@," desc 69 + ) tr.desc; 70 + Option.iter (fun tid -> 71 + Format.fprintf ppf " Tracker: %s@," tid 72 + ) tr.tid; 73 + Format.fprintf ppf " Time: %s@," (Owntracks_location.format_timestamp tr.tst); 74 + Format.fprintf ppf " Location: %.6f, %.6f@," tr.lat tr.lon; 75 + Format.fprintf ppf "-------------------------------------------@]"
+72
lib/owntracks_transition.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Transition event type for OwnTracks. 7 + 8 + @canonical Owntracks.Transition 9 + 10 + Published when entering or leaving a monitored region. Transitions 11 + are triggered by geofences (circular regions) or beacons configured 12 + in the OwnTracks app. *) 13 + 14 + type t 15 + (** The type for transition events. *) 16 + 17 + (** {1 Constructors} *) 18 + 19 + val v : 20 + ?tid:string -> 21 + tst:int -> 22 + lat:float -> 23 + lon:float -> 24 + ?acc:float -> 25 + event:string -> 26 + ?desc:string -> 27 + ?wtst:int -> 28 + unit -> 29 + t 30 + (** [v ~tst ~lat ~lon ~event ()] creates a transition event. *) 31 + 32 + (** {1 Accessors} *) 33 + 34 + val tid : t -> string option 35 + (** [tid tr] returns the tracker ID of the device. *) 36 + 37 + val tst : t -> int 38 + (** [tst tr] returns the timestamp when the transition occurred. *) 39 + 40 + val lat : t -> float 41 + (** [lat tr] returns the latitude where the transition was detected. *) 42 + 43 + val lon : t -> float 44 + (** [lon tr] returns the longitude where the transition was detected. *) 45 + 46 + val acc : t -> float option 47 + (** [acc tr] returns the accuracy of the position in meters, if present. *) 48 + 49 + val event : t -> string 50 + (** [event tr] returns the event type: ["enter"] when entering a region, 51 + ["leave"] when leaving. *) 52 + 53 + val desc : t -> string option 54 + (** [desc tr] returns the description/name of the region, if present. *) 55 + 56 + val wtst : t -> int option 57 + (** [wtst tr] returns the timestamp of the waypoint definition that 58 + triggered this transition, if present. *) 59 + 60 + (** {1 JSON Codec} *) 61 + 62 + val jsont : t Jsont.t 63 + (** [jsont] is a JSON codec for transition messages. 64 + Expects the ["_type"] field to be ["transition"]. *) 65 + 66 + val jsont_bare : t Jsont.t 67 + (** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *) 68 + 69 + (** {1 Pretty Printing} *) 70 + 71 + val pp : Format.formatter -> t -> unit 72 + (** [pp ppf tr] pretty-prints a transition message. *)
+50
lib/owntracks_waypoint.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + type t = { 7 + tst : int; 8 + lat : float; 9 + lon : float; 10 + rad : int; 11 + desc : string; 12 + } 13 + 14 + let v ~tst ~lat ~lon ~rad ~desc = { tst; lat; lon; rad; desc } 15 + 16 + let tst t = t.tst 17 + let lat t = t.lat 18 + let lon t = t.lon 19 + let rad t = t.rad 20 + let desc t = t.desc 21 + 22 + let jsont_bare : t Jsont.t = 23 + let make tst lat lon rad desc = { tst; lat; lon; rad; desc } in 24 + Jsont.Object.map ~kind:"waypoint" make 25 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun w -> w.tst) 26 + |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun w -> w.lat) 27 + |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun w -> w.lon) 28 + |> Jsont.Object.mem "rad" Jsont.int ~enc:(fun w -> w.rad) 29 + |> Jsont.Object.mem "desc" Jsont.string ~enc:(fun w -> w.desc) 30 + |> Jsont.Object.skip_unknown 31 + |> Jsont.Object.finish 32 + 33 + let jsont : t Jsont.t = 34 + let make _type tst lat lon rad desc = 35 + ignore _type; 36 + { tst; lat; lon; rad; desc } 37 + in 38 + Jsont.Object.map ~kind:"waypoint" make 39 + |> Jsont.Object.mem "_type" Jsont.string ~enc:(fun _ -> "waypoint") 40 + |> Jsont.Object.mem "tst" Jsont.int ~enc:(fun w -> w.tst) 41 + |> Jsont.Object.mem "lat" Jsont.number ~enc:(fun w -> w.lat) 42 + |> Jsont.Object.mem "lon" Jsont.number ~enc:(fun w -> w.lon) 43 + |> Jsont.Object.mem "rad" Jsont.int ~enc:(fun w -> w.rad) 44 + |> Jsont.Object.mem "desc" Jsont.string ~enc:(fun w -> w.desc) 45 + |> Jsont.Object.skip_unknown 46 + |> Jsont.Object.finish 47 + 48 + let pp ppf wp = 49 + Format.fprintf ppf "Waypoint: %s at (%.6f, %.6f) radius %dm" 50 + wp.desc wp.lat wp.lon wp.rad
+57
lib/owntracks_waypoint.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Waypoint definition type for OwnTracks. 7 + 8 + @canonical Owntracks.Waypoint 9 + 10 + Describes a monitored circular region. Waypoints define geofences 11 + that trigger transition events when the device enters or leaves them. *) 12 + 13 + type t 14 + (** The type for waypoint definitions. *) 15 + 16 + (** {1 Constructors} *) 17 + 18 + val v : 19 + tst:int -> 20 + lat:float -> 21 + lon:float -> 22 + rad:int -> 23 + desc:string -> 24 + t 25 + (** [v ~tst ~lat ~lon ~rad ~desc] creates a waypoint definition. *) 26 + 27 + (** {1 Accessors} *) 28 + 29 + val tst : t -> int 30 + (** [tst wp] returns the timestamp when the waypoint was created or 31 + last modified. *) 32 + 33 + val lat : t -> float 34 + (** [lat wp] returns the latitude of the region center. *) 35 + 36 + val lon : t -> float 37 + (** [lon wp] returns the longitude of the region center. *) 38 + 39 + val rad : t -> int 40 + (** [rad wp] returns the radius of the circular region in meters. *) 41 + 42 + val desc : t -> string 43 + (** [desc wp] returns the description/name of the waypoint. *) 44 + 45 + (** {1 JSON Codec} *) 46 + 47 + val jsont : t Jsont.t 48 + (** [jsont] is a JSON codec for waypoint messages. 49 + Expects the ["_type"] field to be ["waypoint"]. *) 50 + 51 + val jsont_bare : t Jsont.t 52 + (** [jsont_bare] is a JSON codec that doesn't require the ["_type"] field. *) 53 + 54 + (** {1 Pretty Printing} *) 55 + 56 + val pp : Format.formatter -> t -> unit 57 + (** [pp ppf wp] pretty-prints a waypoint. *)
+44
owntracks-cli.opam
··· 1 + # This file is generated by dune, edit dune-project instead 2 + opam-version: "2.0" 3 + synopsis: "OwnTracks MQTT client and CLI tools" 4 + description: """ 5 + Command-line tools for subscribing to OwnTracks location updates over MQTT. 6 + Includes commands for real-time monitoring, GeoJSON export, and querying 7 + the OwnTracks Recorder HTTP API for historical data.""" 8 + maintainer: ["Anil Madhavapeddy <anil@recoil.org>"] 9 + authors: ["Anil Madhavapeddy <anil@recoil.org>"] 10 + license: "ISC" 11 + homepage: "https://github.com/avsm/ocaml-owntracks" 12 + bug-reports: "https://github.com/avsm/ocaml-owntracks/issues" 13 + depends: [ 14 + "dune" {>= "3.20"} 15 + "ocaml" {>= "5.1"} 16 + "owntracks" {= version} 17 + "mqtte" {>= "0.1"} 18 + "eio" {>= "1.0"} 19 + "eio_main" {>= "1.0"} 20 + "xdge" 21 + "tomlt" 22 + "cmdliner" {>= "1.2"} 23 + "logs" {>= "0.7"} 24 + "fmt" {>= "0.9"} 25 + "mirage-crypto-rng" 26 + "requests" 27 + "odoc" {with-doc} 28 + ] 29 + build: [ 30 + ["dune" "subst"] {dev} 31 + [ 32 + "dune" 33 + "build" 34 + "-p" 35 + name 36 + "-j" 37 + jobs 38 + "@install" 39 + "@runtest" {with-test} 40 + "@doc" {with-doc} 41 + ] 42 + ] 43 + dev-repo: "git+https://github.com/avsm/ocaml-owntracks.git" 44 + x-maintenance-intent: ["(latest)"]
+13 -15
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, JSON codecs, and MQTT client" 4 - description: 5 - "Types and codecs for parsing OwnTracks MQTT location messages using jsont, with an MQTT client for subscribing to location updates" 6 - maintainer: ["anil@recoil.org"] 7 - authors: ["Anil Madhavapeddy"] 3 + synopsis: "OwnTracks message types and JSON codecs" 4 + description: """ 5 + Types and jsont codecs for parsing OwnTracks MQTT location messages. 6 + OwnTracks is an open-source location tracking application that publishes 7 + GPS coordinates, accuracy, speed, battery, and other device state over MQTT. 8 + This library provides type-safe parsing and serialization of all OwnTracks 9 + message types including locations, transitions, waypoints, and cards.""" 10 + maintainer: ["Anil Madhavapeddy <anil@recoil.org>"] 11 + authors: ["Anil Madhavapeddy <anil@recoil.org>"] 8 12 license: "ISC" 13 + homepage: "https://github.com/avsm/ocaml-owntracks" 14 + bug-reports: "https://github.com/avsm/ocaml-owntracks/issues" 9 15 depends: [ 10 16 "dune" {>= "3.20"} 11 17 "ocaml" {>= "5.1"} 12 - "jsont" 13 - "requests" 14 - "mqtte" {>= "0.1"} 15 - "eio" {>= "1.0"} 16 - "eio_main" {>= "1.0"} 17 - "xdge" 18 - "tomlt" 19 - "cmdliner" {>= "1.2"} 20 - "logs" {>= "0.7"} 21 - "fmt" {>= "0.9"} 18 + "jsont" {>= "0.1.0"} 22 19 "odoc" {with-doc} 23 20 ] 24 21 build: [ ··· 35 32 "@doc" {with-doc} 36 33 ] 37 34 ] 35 + dev-repo: "git+https://github.com/avsm/ocaml-owntracks.git" 38 36 x-maintenance-intent: ["(latest)"]