+13 -13

lib/discovery.ml

reviewed

··· 48 48 | _ -> None) 49 49 txt 50 50 51 51 - let get_txt key txt = List.assoc_opt key txt 51 51 + let txt key records = List.assoc_opt key records 52 52 53 53 - let get_txt_int key txt = 54 54 - Option.bind (get_txt key txt) (fun v -> 53 53 + let txt_int key records = 54 54 + Option.bind (txt key records) (fun v -> 55 55 try Some (int_of_string v) with Failure _ -> None) 56 56 57 57 - let parse_vendor_product txt = 58 58 - Option.bind (get_txt "VP" txt) (fun vp -> 57 57 + let parse_vendor_product records = 58 58 + Option.bind (txt "VP" records) (fun vp -> 59 59 match String.split_on_char '+' vp with 60 60 | [ vid; pid ] -> ( 61 61 try ··· 95 95 | None -> ("", 5540) 96 96 in 97 97 (* Find TXT record *) 98 98 - let txt = 98 98 + let records = 99 99 match 100 100 List.find_map 101 101 (fun (n, t) -> ··· 114 114 else None) 115 115 r.Mdns.addrs 116 116 in 117 117 - let vp = parse_vendor_product txt in 117 117 + let vp = parse_vendor_product records in 118 118 let device = 119 119 if service_type = "_matterc._udp" then 120 120 Commissionable ··· 124 124 port; 125 125 ip; 126 126 vendor_product = vp; 127 127 - discriminator = get_txt_int "D" txt; 128 128 - commissioning_mode = get_txt_int "CM" txt; 129 129 - device_type = get_txt_int "DT" txt; 130 130 - pairing_hint = get_txt_int "PH" txt; 131 131 - pairing_instruction = get_txt "PI" txt; 127 127 + discriminator = txt_int "D" records; 128 128 + commissioning_mode = txt_int "CM" records; 129 129 + device_type = txt_int "DT" records; 130 130 + pairing_hint = txt_int "PH" records; 131 131 + pairing_instruction = txt "PI" records; 132 132 } 133 133 else 134 134 let fabric_id, node_id = ··· 145 145 port; 146 146 ip; 147 147 vendor_product = vp; 148 148 - compressed_fabric_id = get_txt "ICD" txt; 148 148 + compressed_fabric_id = txt "ICD" records; 149 149 } 150 150 in 151 151 if

+5

lib/discovery.mli

reviewed

··· 76 76 (** {1:pp Pretty printing} *) 77 77 78 78 val pp_vendor : vendor_product Fmt.t 79 79 + (** [pp_vendor] formats a vendor/product identifier. *) 80 80 + 79 81 val pp_device : device Fmt.t 82 82 + (** [pp_device] formats a discovered device. *) 83 83 + 80 84 val pp : device list Fmt.t 85 85 + (** [pp] formats a list of discovered devices. *)

+35 -35

lib/msg.ml

reviewed

··· 194 194 195 195 (** {1 Decoding} *) 196 196 197 197 - let get_byte data offset = 197 197 + let byte data offset = 198 198 if offset >= String.length data then Error "Unexpected end of data" 199 199 else Ok (Char.code data.[offset], offset + 1) 200 200 201 201 - let get_uint16_le data offset = 201 201 + let uint16_le data offset = 202 202 if offset + 2 > String.length data then Error "Unexpected end of data" 203 203 else 204 204 let b0 = Char.code data.[offset] in 205 205 let b1 = Char.code data.[offset + 1] in 206 206 Ok (b0 lor (b1 lsl 8), offset + 2) 207 207 208 208 - let get_uint32_le data offset = 208 208 + let uint32_le data offset = 209 209 if offset + 4 > String.length data then Error "Unexpected end of data" 210 210 else 211 211 let b0 = Int32.of_int (Char.code data.[offset]) in ··· 219 219 (add (shift_left b2 16) (shift_left b3 24))), 220 220 offset + 4 ) 221 221 222 222 - let get_uint64_le data offset = 222 222 + let uint64_le data offset = 223 223 if offset + 8 > String.length data then Error "Unexpected end of data" 224 224 else 225 225 let v = ref 0L in ··· 231 231 Ok (!v, offset + 8) 232 232 233 233 let decode_message_header data = 234 234 - let* flags_byte, offset = get_byte data 0 in 234 234 + let* flags_byte, offset = byte data 0 in 235 235 let flags = 236 236 { 237 237 version = flags_byte land 0x0f; ··· 241 241 } 242 242 in 243 243 244 244 - let* session_id, offset = get_uint16_le data offset in 244 244 + let* session_id, offset = uint16_le data offset in 245 245 246 246 - let* sec_flags_byte, offset = get_byte data offset in 246 246 + let* sec_flags_byte, offset = byte data offset in 247 247 let security_flags = 248 248 { 249 249 privacy = sec_flags_byte land 0x01 <> 0; ··· 254 254 } 255 255 in 256 256 257 257 - let* message_counter, offset = get_uint32_le data offset in 257 257 + let* message_counter, offset = uint32_le data offset in 258 258 259 259 let* source_node_id, offset = 260 260 if flags.source_present then 261 261 - let* id, off = get_uint64_le data offset in 261 261 + let* id, off = uint64_le data offset in 262 262 Ok (Some id, off) 263 263 else Ok (None, offset) 264 264 in ··· 267 267 match flags.dsiz with 268 268 | 0 -> Ok (No_destination, offset) 269 269 | 1 -> 270 270 - let* id, off = get_uint64_le data offset in 270 270 + let* id, off = uint64_le data offset in 271 271 Ok (Node_id id, off) 272 272 | 2 -> 273 273 - let* id, off = get_uint16_le data offset in 273 273 + let* id, off = uint16_le data offset in 274 274 Ok (Group_id id, off) 275 275 | _ -> Error "Invalid DSIZ value" 276 276 in ··· 287 287 offset ) 288 288 289 289 let decode_protocol_header data offset = 290 290 - let* flags_byte, offset = get_byte data offset in 290 290 + let* flags_byte, offset = byte data offset in 291 291 let exchange_flags = 292 292 { 293 293 initiator = flags_byte land 0x01 <> 0; ··· 299 299 in 300 300 let has_ack = flags_byte land 0x20 <> 0 in 301 301 302 302 - let* protocol_opcode, offset = get_byte data offset in 303 303 - let* exchange_id, offset = get_uint16_le data offset in 304 304 - let* protocol_id, offset = get_uint16_le data offset in 302 302 + let* protocol_opcode, offset = byte data offset in 303 303 + let* exchange_id, offset = uint16_le data offset in 304 304 + let* protocol_id, offset = uint16_le data offset in 305 305 306 306 let* vendor_id, offset = 307 307 if exchange_flags.vendor_present then 308 308 - let* v, off = get_uint16_le data offset in 308 308 + let* v, off = uint16_le data offset in 309 309 Ok (Some v, off) 310 310 else Ok (None, offset) 311 311 in 312 312 313 313 let* ack_counter, offset = 314 314 if has_ack then 315 315 - let* c, off = get_uint32_le data offset in 315 315 + let* c, off = uint32_le data offset in 316 316 Ok (Some c, off) 317 317 else Ok (None, offset) 318 318 in ··· 342 342 reserved2 = 0; 343 343 } 344 344 345 345 - let make_unsecured_header ~message_counter = 345 345 + let unsecured_header ~message_counter = 346 346 { 347 347 flags = default_message_flags; 348 348 session_id = 0; ··· 353 353 destination = No_destination; 354 354 } 355 355 356 356 - let make_exchange_flags ?(initiator = true) ?(ack_requested = true) 356 356 + let exchange_flags ?(initiator = true) ?(ack_requested = true) 357 357 ?(reliability = true) () = 358 358 { 359 359 initiator; ··· 363 363 vendor_present = false; 364 364 } 365 365 366 366 - let make_protocol_header ~exchange_id ~protocol_id ~opcode 367 367 - ?(exchange_flags = make_exchange_flags ()) () = 366 366 + let protocol_header ~exchange_id ~protocol_id ~opcode 367 367 + ?(exchange_flags = exchange_flags ()) () = 368 368 { 369 369 exchange_flags; 370 370 protocol_opcode = opcode; ··· 377 377 (** Encode a complete unsecured message *) 378 378 let encode_unsecured_message ~message_counter ~exchange_id ~protocol_id ~opcode 379 379 ~payload = 380 380 - let msg_hdr = make_unsecured_header ~message_counter in 381 381 - let proto_hdr = make_protocol_header ~exchange_id ~protocol_id ~opcode () in 380 380 + let msg_hdr = unsecured_header ~message_counter in 381 381 + let proto_hdr = protocol_header ~exchange_id ~protocol_id ~opcode () in 382 382 let buf = Buffer.create 256 in 383 383 encode_message_header buf msg_hdr; 384 384 encode_protocol_header buf proto_hdr; ··· 388 388 (** {1 PASE Messages} *) 389 389 390 390 (** Build PBKDFParamRequest message for PASE *) 391 391 - let make_pbkdf_param_request ~initiator_random ~initiator_session_id 392 392 - ~passcode_id ~has_pbkdf_params = 391 391 + let pbkdf_param_request ~initiator_random ~initiator_session_id ~passcode_id 392 392 + ~has_pbkdf_params = 393 393 let open Tlv in 394 394 encode_one 395 395 (structure ··· 402 402 ]) 403 403 404 404 (** Build PAKE1 message *) 405 405 - let make_pase_pake1 ~pa = 405 405 + let pase_pake1 ~pa = 406 406 let open Tlv in 407 407 encode_one (structure [ ctx_bytes 1 pa (* pA = X coordinate of PAKE key *) ]) 408 408 409 409 (** Build PAKE3 message *) 410 410 - let make_pase_pake3 ~ca = 410 410 + let pase_pake3 ~ca = 411 411 let open Tlv in 412 412 encode_one (structure [ ctx_bytes 1 ca (* cA = HMAC proof *) ]) 413 413 414 414 (** {1 Interaction Model Messages} *) 415 415 416 416 (** Build InvokeRequest for a cluster command *) 417 417 - let make_invoke_request ~endpoint_id ~cluster_id ~command_id ~command_data = 417 417 + let invoke_request ~endpoint_id ~cluster_id ~command_id ~command_data = 418 418 let open Tlv in 419 419 let invoke_request = 420 420 structure ··· 451 451 let toggle_command = 0x02 452 452 453 453 let make_off ~endpoint_id = 454 454 - make_invoke_request ~endpoint_id ~cluster_id ~command_id:off_command 454 454 + invoke_request ~endpoint_id ~cluster_id ~command_id:off_command 455 455 ~command_data:[] 456 456 457 457 let make_on ~endpoint_id = 458 458 - make_invoke_request ~endpoint_id ~cluster_id ~command_id:on_command 458 458 + invoke_request ~endpoint_id ~cluster_id ~command_id:on_command 459 459 ~command_data:[] 460 460 461 461 let make_toggle ~endpoint_id = 462 462 - make_invoke_request ~endpoint_id ~cluster_id ~command_id:toggle_command 462 462 + invoke_request ~endpoint_id ~cluster_id ~command_id:toggle_command 463 463 ~command_data:[] 464 464 end 465 465 ··· 481 481 timeout is in seconds (valid range: 180-900) *) 482 482 let make_open_basic ~timeout = 483 483 let open Tlv in 484 484 - make_invoke_request ~endpoint_id ~cluster_id 484 484 + invoke_request ~endpoint_id ~cluster_id 485 485 ~command_id:open_basic_commissioning_window 486 486 ~command_data:[ ctx_uint 0 timeout (* CommissioningTimeout *) ] 487 487 ··· 489 489 when you want to specify your own passcode. *) 490 490 let make_open_enhanced ~timeout ~verifier ~discriminator ~iterations ~salt = 491 491 let open Tlv in 492 492 - make_invoke_request ~endpoint_id ~cluster_id 492 492 + invoke_request ~endpoint_id ~cluster_id 493 493 ~command_id:open_commissioning_window 494 494 ~command_data: 495 495 [ ··· 502 502 ] 503 503 504 504 let make_revoke () = 505 505 - make_invoke_request ~endpoint_id ~cluster_id 506 506 - ~command_id:revoke_commissioning ~command_data:[] 505 505 + invoke_request ~endpoint_id ~cluster_id ~command_id:revoke_commissioning 506 506 + ~command_data:[] 507 507 end 508 508 509 509 (** {1 Pretty Printing} *)

+95 -4

lib/msg.mli

reviewed

··· 59 59 60 60 module Protocol : sig 61 61 val secure_channel : int 62 62 + (** Secure Channel protocol ID (0x0000). *) 63 63 + 62 64 val interaction_model : int 65 65 + (** Interaction Model protocol ID (0x0001). *) 66 66 + 63 67 val bdx : int 68 68 + (** Bulk Data Exchange protocol ID (0x0002). *) 69 69 + 64 70 val user_directed_commissioning : int 71 71 + (** User Directed Commissioning protocol ID (0x0003). *) 65 72 end 66 73 67 74 (** {1:secure_channel Secure Channel opcodes} *) 68 75 69 76 module Secure_channel : sig 70 77 val msg_counter_sync_req : int 78 78 + (** MsgCounterSyncReq opcode (0x00). *) 79 79 + 71 80 val msg_counter_sync_rsp : int 81 81 + (** MsgCounterSyncRsp opcode (0x01). *) 82 82 + 72 83 val mrp_standalone_ack : int 84 84 + (** MRP Standalone Acknowledgement opcode (0x10). *) 85 85 + 73 86 val pbkdf_param_request : int 87 87 + (** PBKDFParamRequest opcode (0x20). *) 88 88 + 74 89 val pbkdf_param_response : int 90 90 + (** PBKDFParamResponse opcode (0x21). *) 91 91 + 75 92 val pase_pake1 : int 93 93 + (** PASE-Pake1 opcode (0x22). *) 94 94 + 76 95 val pase_pake2 : int 96 96 + (** PASE-Pake2 opcode (0x23). *) 97 97 + 77 98 val pase_pake3 : int 99 99 + (** PASE-Pake3 opcode (0x24). *) 100 100 + 78 101 val case_sigma1 : int 102 102 + (** CASE Sigma1 opcode (0x30). *) 103 103 + 79 104 val case_sigma2 : int 105 105 + (** CASE Sigma2 opcode (0x31). *) 106 106 + 80 107 val case_sigma3 : int 108 108 + (** CASE Sigma3 opcode (0x32). *) 109 109 + 81 110 val case_sigma2_resume : int 111 111 + (** CASE Sigma2-Resume opcode (0x33). *) 112 112 + 82 113 val status_report : int 114 114 + (** StatusReport opcode (0x40). *) 83 115 end 84 116 85 117 (** {1:interaction Interaction Model opcodes} *) 86 118 87 119 module Interaction : sig 88 120 val status_response : int 121 121 + (** StatusResponse opcode (0x01). *) 122 122 + 89 123 val read_request : int 124 124 + (** ReadRequest opcode (0x02). *) 125 125 + 90 126 val subscribe_request : int 127 127 + (** SubscribeRequest opcode (0x03). *) 128 128 + 91 129 val subscribe_response : int 130 130 + (** SubscribeResponse opcode (0x04). *) 131 131 + 92 132 val report_data : int 133 133 + (** ReportData opcode (0x05). *) 134 134 + 93 135 val write_request : int 136 136 + (** WriteRequest opcode (0x06). *) 137 137 + 94 138 val write_response : int 139 139 + (** WriteResponse opcode (0x07). *) 140 140 + 95 141 val invoke_request : int 142 142 + (** InvokeRequest opcode (0x08). *) 143 143 + 96 144 val invoke_response : int 145 145 + (** InvokeResponse opcode (0x09). *) 146 146 + 97 147 val timed_request : int 148 148 + (** TimedRequest opcode (0x0a). *) 98 149 end 99 150 100 151 (** {1:encoding Encoding and Decoding} *) 101 152 102 153 val encode_message_header : Buffer.t -> message_header -> unit 154 154 + (** [encode_message_header buf hdr] writes [hdr] into [buf]. *) 155 155 + 103 156 val encode_protocol_header : Buffer.t -> protocol_header -> unit 157 157 + (** [encode_protocol_header buf hdr] writes [hdr] into [buf]. *) 158 158 + 104 159 val decode_message_header : string -> (message_header * int, string) result 160 160 + (** [decode_message_header data] parses a message header from [data]. Returns 161 161 + the header and the offset past the header. *) 105 162 106 163 val decode_protocol_header : 107 164 string -> int -> (protocol_header * int, string) result 165 165 + (** [decode_protocol_header data off] parses a protocol header from [data] 166 166 + starting at offset [off]. Returns the header and the offset past it. *) 108 167 109 168 val encode_unsecured_message : 110 169 message_counter:int32 -> ··· 113 172 opcode:int -> 114 173 payload:string -> 115 174 string 175 175 + (** [encode_unsecured_message ~message_counter ~exchange_id ~protocol_id ~opcode 176 176 + ~payload] builds a complete unsecured message. *) 116 177 117 178 (** {1:pase PASE message builders} *) 118 179 119 119 - val make_pbkdf_param_request : 180 180 + val pbkdf_param_request : 120 181 initiator_random:string -> 121 182 initiator_session_id:int -> 122 183 passcode_id:int -> 123 184 has_pbkdf_params:bool -> 124 185 string 186 186 + (** [pbkdf_param_request ~initiator_random ~initiator_session_id ~passcode_id 187 187 + ~has_pbkdf_params] builds a PBKDFParamRequest TLV payload. *) 125 188 126 126 - val make_pase_pake1 : pa:string -> string 127 127 - val make_pase_pake3 : ca:string -> string 189 189 + val pase_pake1 : pa:string -> string 190 190 + (** [pase_pake1 ~pa] builds a PASE-Pake1 TLV payload with public value [pa]. *) 191 191 + 192 192 + val pase_pake3 : ca:string -> string 193 193 + (** [pase_pake3 ~ca] builds a PASE-Pake3 TLV payload with confirmation [ca]. *) 128 194 129 195 (** {1:im Interaction Model builders} *) 130 196 131 131 - val make_invoke_request : 197 197 + val invoke_request : 132 198 endpoint_id:int -> 133 199 cluster_id:int -> 134 200 command_id:int -> 135 201 command_data:Tlv.element list -> 136 202 string 203 203 + (** [invoke_request ~endpoint_id ~cluster_id ~command_id ~command_data] builds 204 204 + an InvokeRequest TLV payload. *) 137 205 138 206 (** {1:clusters Cluster helpers} *) 139 207 140 208 module OnOff : sig 141 209 val cluster_id : int 210 210 + (** OnOff cluster identifier (0x0006). *) 211 211 + 142 212 val off_command : int 213 213 + (** Off command identifier (0x00). *) 214 214 + 143 215 val on_command : int 216 216 + (** On command identifier (0x01). *) 217 217 + 144 218 val toggle_command : int 219 219 + (** Toggle command identifier (0x02). *) 220 220 + 145 221 val make_on : endpoint_id:int -> string 222 222 + (** [make_on ~endpoint_id] builds an On command payload. *) 223 223 + 146 224 val make_off : endpoint_id:int -> string 225 225 + (** [make_off ~endpoint_id] builds an Off command payload. *) 226 226 + 147 227 val make_toggle : endpoint_id:int -> string 228 228 + (** [make_toggle ~endpoint_id] builds a Toggle command payload. *) 148 229 end 149 230 150 231 module AdministratorCommissioning : sig 151 232 val cluster_id : int 233 233 + (** AdministratorCommissioning cluster identifier (0x003C). *) 234 234 + 152 235 val make_open_basic : timeout:int -> string 236 236 + (** [make_open_basic ~timeout] builds an OpenBasicCommissioningWindow command 237 237 + payload. *) 153 238 154 239 val make_open_enhanced : 155 240 timeout:int -> ··· 158 243 iterations:int -> 159 244 salt:string -> 160 245 string 246 246 + (** [make_open_enhanced ~timeout ~verifier ~discriminator ~iterations ~salt] 247 247 + builds an OpenCommissioningWindow command payload. *) 161 248 162 249 val make_revoke : unit -> string 250 250 + (** [make_revoke ()] builds a RevokeCommissioning command payload. *) 163 251 end 164 252 165 253 (** {1:pp Pretty printing} *) 166 254 167 255 val pp_message_header : message_header Fmt.t 256 256 + (** [pp_message_header] formats a message header. *) 257 257 + 168 258 val pp_protocol_header : protocol_header Fmt.t 259 259 + (** [pp_protocol_header] formats a protocol header. *)

+1 -1

lib/pase.ml

reviewed

··· 16 16 (** {1 PASE Context} *) 17 17 18 18 (** Build PASE context from session parameters *) 19 19 - let make_context ~initiator_random ~responder_random ~pbkdf_params_responder = 19 19 + let context ~initiator_random ~responder_random ~pbkdf_params_responder = 20 20 (* Context includes the session establishment exchange information *) 21 21 initiator_random ^ responder_random ^ pbkdf_params_responder 22 22

+10 -4

lib/pase.mli

reviewed

··· 11 11 12 12 (** {1:context Context} *) 13 13 14 14 - val make_context : 14 14 + val context : 15 15 initiator_random:string -> 16 16 responder_random:string -> 17 17 pbkdf_params_responder:string -> 18 18 string 19 19 - (** [make_context ~initiator_random ~responder_random ~pbkdf_params_responder] 20 20 - builds the PASE context for SPAKE2+ transcript. *) 19 19 + (** [context ~initiator_random ~responder_random ~pbkdf_params_responder] builds 20 20 + the PASE context for SPAKE2+ transcript. *) 21 21 22 22 (** {1:prover Prover (Commissioner) Operations} *) 23 23 ··· 33 33 @param passcode The device passcode (typically 8 digits like 20202021) 34 34 @param salt The salt from PBKDF params response 35 35 @param iterations The iteration count from PBKDF params response 36 36 - @param context The PASE context from {!make_context} 36 36 + @param context The PASE context from {!context} 37 37 @return [(state, pA)] where [pA] is sent to the device. *) 38 38 39 39 val prover_finish : ··· 92 92 (** {1:crypto Cryptographic Helpers} *) 93 93 94 94 val sha256 : string -> string 95 95 + (** [sha256 data] is the SHA-256 digest of [data]. *) 96 96 + 95 97 val hmac_sha256 : key:string -> string -> string 98 98 + (** [hmac_sha256 ~key data] is the HMAC-SHA256 of [data] using [key]. *) 99 99 + 96 100 val hkdf : salt:string -> ikm:string -> info:string -> length:int -> string 101 101 + (** [hkdf ~salt ~ikm ~info ~length] derives a key of [length] bytes using 102 102 + HKDF-SHA256. *)

+8 -8

lib/session.ml

reviewed

··· 39 39 40 40 (** {1 Session Management} *) 41 41 42 42 - let create_session ~ip ~port = 42 42 + let session ~ip ~port = 43 43 { 44 44 state = Unauthenticated; 45 45 session_id = 0; ··· 73 73 Eio.Net.Ipaddr.of_raw (Ipaddr.V4.to_octets (Ipaddr.V4.of_string_exn ip)) 74 74 in 75 75 let remote_addr = `Udp (eio_ip, port) in 76 76 - let session = create_session ~ip ~port in 76 76 + let session = session ~ip ~port in 77 77 { session; sock; remote_addr } 78 78 79 79 let send_message conn data = ··· 113 113 let exchange_id = next_exchange_id () in 114 114 115 115 let payload = 116 116 - Msg.make_pbkdf_param_request ~initiator_random 117 117 - ~initiator_session_id:session_id ~passcode_id:0 ~has_pbkdf_params:false 116 116 + Msg.pbkdf_param_request ~initiator_random ~initiator_session_id:session_id 117 117 + ~passcode_id:0 ~has_pbkdf_params:false 118 118 in 119 119 120 120 let msg = ··· 149 149 | Ok v -> Ok v))) 150 150 151 151 let pase_pake1_exchange ~clock conn ~exchange_id ~pa = 152 152 - let payload = Msg.make_pase_pake1 ~pa in 152 152 + let payload = Msg.pase_pake1 ~pa in 153 153 let msg = 154 154 build_unsecured_message ~session:conn.session ~exchange_id 155 155 ~protocol_id:Msg.Protocol.secure_channel ··· 180 180 | Ok (pb, cb) -> Ok (pb, cb)))) 181 181 182 182 let pase_pake3_exchange ~clock conn ~exchange_id ~ca = 183 183 - let payload = Msg.make_pase_pake3 ~ca in 183 183 + let payload = Msg.pase_pake3 ~ca in 184 184 let msg = 185 185 build_unsecured_message ~session:conn.session ~exchange_id 186 186 ~protocol_id:Msg.Protocol.secure_channel ··· 228 228 conn.session.peer_session_id <- peer_session_id; 229 229 230 230 let context = 231 231 - Pase.make_context ~initiator_random ~responder_random 231 231 + Pase.context ~initiator_random ~responder_random 232 232 ~pbkdf_params_responder:salt 233 233 in 234 234 ··· 273 273 let exchange_id = next_exchange_id () in 274 274 275 275 let payload = 276 276 - Msg.make_invoke_request ~endpoint_id ~cluster_id ~command_id ~command_data 276 276 + Msg.invoke_request ~endpoint_id ~cluster_id ~command_id ~command_data 277 277 in 278 278 279 279 let msg =

+17 -1

lib/session.mli

reviewed

··· 37 37 38 38 (** {1:session Session management} *) 39 39 40 40 - val create_session : ip:string -> port:int -> session 40 40 + val session : ip:string -> port:int -> session 41 41 + (** [session ~ip ~port] creates an unauthenticated session. *) 42 42 + 41 43 val next_message_counter : session -> int32 44 44 + (** [next_message_counter session] increments and returns the message counter. 45 45 + *) 46 46 + 42 47 val next_exchange_id : unit -> int 48 48 + (** [next_exchange_id ()] returns a fresh exchange identifier. *) 43 49 44 50 (** {1:transport UDP transport} *) 45 51 ··· 49 55 ip:string -> 50 56 port:int -> 51 57 'a Eio.Net.datagram_socket_ty connection 58 58 + (** [connect ~net ~sw ~ip ~port] opens a UDP connection to the device. *) 52 59 53 60 val send_message : _ connection -> string -> unit 61 61 + (** [send_message conn data] sends [data] over [conn]. *) 54 62 55 63 val receive_message : 56 64 clock:_ Eio.Time.clock -> 57 65 _ connection -> 58 66 timeout:float -> 59 67 (string, [> `Timeout ]) result 68 68 + (** [receive_message ~clock conn ~timeout] waits for a message on [conn]. 69 69 + Returns [`Timeout] if no message arrives within [timeout] seconds. *) 60 70 61 71 (** {1:pase PASE authentication} *) 62 72 ··· 80 90 _ connection -> 81 91 endpoint_id:int -> 82 92 (string, [> `Timeout ]) result 93 93 + (** [turn_on ~clock conn ~endpoint_id] sends an OnOff/On command. *) 83 94 84 95 val turn_off : 85 96 clock:_ Eio.Time.clock -> 86 97 _ connection -> 87 98 endpoint_id:int -> 88 99 (string, [> `Timeout ]) result 100 100 + (** [turn_off ~clock conn ~endpoint_id] sends an OnOff/Off command. *) 89 101 90 102 val toggle : 91 103 clock:_ Eio.Time.clock -> 92 104 _ connection -> 93 105 endpoint_id:int -> 94 106 (string, [> `Timeout ]) result 107 107 + (** [toggle ~clock conn ~endpoint_id] sends an OnOff/Toggle command. *) 95 108 96 109 (** {1:pp Pretty printing} *) 97 110 98 111 val pp_session_state : session_state Fmt.t 112 112 + (** [pp_session_state] formats a session state. *) 113 113 + 99 114 val pp_session : session Fmt.t 115 115 + (** [pp_session] formats a session. *)

+24 -24

lib/tlv.ml

reviewed

··· 178 178 179 179 (** {1 Decoding} *) 180 180 181 181 - let get_byte data offset = 181 181 + let byte data offset = 182 182 if offset >= String.length data then Error "Unexpected end of data" 183 183 else Ok (Char.code data.[offset], offset + 1) 184 184 185 185 - let get_uint16_le data offset = 185 185 + let uint16_le data offset = 186 186 if offset + 2 > String.length data then Error "Unexpected end of data" 187 187 else 188 188 let b0 = Char.code data.[offset] in 189 189 let b1 = Char.code data.[offset + 1] in 190 190 Ok (b0 lor (b1 lsl 8), offset + 2) 191 191 192 192 - let get_uint32_le data offset = 192 192 + let uint32_le data offset = 193 193 if offset + 4 > String.length data then Error "Unexpected end of data" 194 194 else 195 195 let b0 = Int32.of_int (Char.code data.[offset]) in ··· 203 203 (add (shift_left b2 16) (shift_left b3 24))), 204 204 offset + 4 ) 205 205 206 206 - let get_uint64_le data offset = 206 206 + let uint64_le data offset = 207 207 if offset + 8 > String.length data then Error "Unexpected end of data" 208 208 else 209 209 let get_byte i = Int64.of_int (Char.code data.[offset + i]) in ··· 216 216 let get_int data offset size_code = 217 217 match size_code with 218 218 | 0 -> 219 219 - let* b, off = get_byte data offset in 219 219 + let* b, off = byte data offset in 220 220 let v = if b >= 128 then b - 256 else b in 221 221 Ok (Int64.of_int v, off) 222 222 | 1 -> 223 223 - let* v, off = get_uint16_le data offset in 223 223 + let* v, off = uint16_le data offset in 224 224 let v = if v >= 32768 then v - 65536 else v in 225 225 Ok (Int64.of_int v, off) 226 226 | 2 -> 227 227 - let* v, off = get_uint32_le data offset in 227 227 + let* v, off = uint32_le data offset in 228 228 Ok (Int64.of_int32 v, off) 229 229 - | 3 -> get_uint64_le data offset 229 229 + | 3 -> uint64_le data offset 230 230 | _ -> Error "Invalid size code" 231 231 232 232 let get_uint data offset size_code = 233 233 match size_code with 234 234 | 0 -> 235 235 - let* b, off = get_byte data offset in 235 235 + let* b, off = byte data offset in 236 236 Ok (Int64.of_int b, off) 237 237 | 1 -> 238 238 - let* v, off = get_uint16_le data offset in 238 238 + let* v, off = uint16_le data offset in 239 239 Ok (Int64.of_int v, off) 240 240 | 2 -> 241 241 - let* v, off = get_uint32_le data offset in 241 241 + let* v, off = uint32_le data offset in 242 242 Ok (Int64.of_int32 v |> Int64.logand 0xFFFFFFFFL, off) 243 243 - | 3 -> get_uint64_le data offset 243 243 + | 3 -> uint64_le data offset 244 244 | _ -> Error "Invalid size code" 245 245 246 246 let get_bytes data offset len = ··· 252 252 match tag_form_code with 253 253 | 0 -> Ok (Anonymous, offset) 254 254 | 1 -> 255 255 - let* t, off = get_byte data offset in 255 255 + let* t, off = byte data offset in 256 256 Ok (Context_specific t, off) 257 257 | 2 -> 258 258 - let* t, off = get_uint16_le data offset in 258 258 + let* t, off = uint16_le data offset in 259 259 Ok (Common_profile_2 t, off) 260 260 | 3 -> 261 261 - let* t, off = get_uint32_le data offset in 261 261 + let* t, off = uint32_le data offset in 262 262 Ok (Common_profile_4 t, off) 263 263 | 4 -> 264 264 - let* t, off = get_uint16_le data offset in 264 264 + let* t, off = uint16_le data offset in 265 265 Ok (Implicit_profile_2 t, off) 266 266 | 5 -> 267 267 - let* t, off = get_uint32_le data offset in 267 267 + let* t, off = uint32_le data offset in 268 268 Ok (Implicit_profile_4 t, off) 269 269 | 6 -> 270 270 - let* v, off = get_uint32_le data offset in 271 271 - let* t, off = get_uint16_le data off in 270 270 + let* v, off = uint32_le data offset in 271 271 + let* t, off = uint16_le data off in 272 272 Ok (Fully_qualified_6 (v, t), off) 273 273 | 7 -> 274 274 - let* v, off = get_uint32_le data offset in 275 275 - let* t, off = get_uint32_le data off in 274 274 + let* v, off = uint32_le data offset in 275 275 + let* t, off = uint32_le data off in 276 276 Ok (Fully_qualified_8 (v, t), off) 277 277 | _ -> Error "Invalid tag form" 278 278 279 279 let rec decode_element data offset = 280 280 - let* control, offset = get_byte data offset in 280 280 + let* control, offset = byte data offset in 281 281 let type_code = control land 0x1f in 282 282 let tag_form_code = (control lsr 5) land 0x7 in 283 283 if type_code = 24 then (* End of container *) ··· 303 303 | 9 -> Ok (Bool true, offset) 304 304 | 10 -> 305 305 (* Float32 *) 306 306 - let* bits, off = get_uint32_le data offset in 306 306 + let* bits, off = uint32_le data offset in 307 307 Ok (Float32 (Int32.float_of_bits bits), off) 308 308 | 11 -> 309 309 (* Float64 *) 310 310 - let* bits, off = get_uint64_le data offset in 310 310 + let* bits, off = uint64_le data offset in 311 311 Ok (Float64 (Int64.float_of_bits bits), off) 312 312 | 12 | 13 | 14 | 15 -> 313 313 (* UTF8 string *)