+34 -32

bin/matter_cli.ml

reviewed

··· 94 94 & opt device_filter_conv Operational 95 95 & info [ "f"; "filter" ] ~docv:"FILTER" ~doc) 96 96 in 97 97 - let run () timeout filter = 98 98 - Eio_main.run @@ fun env -> 99 99 - Eio.Switch.run @@ fun sw -> 100 100 - let net = Eio.Stdenv.net env in 101 101 - let clock = Eio.Stdenv.clock env in 97 97 + let discover ~sw ~net ~clock ~timeout filter = 102 98 let devices = 103 99 match filter with 104 100 | Operational -> ··· 112 108 exit exit_error 113 109 end 114 110 else Fmt.pr "%a@." Matter.Discovery.pp devices 111 111 + in 112 112 + let run () timeout filter = 113 113 + Eio_main.run @@ fun env -> 114 114 + Eio.Switch.run @@ fun sw -> 115 115 + let net = Eio.Stdenv.net env in 116 116 + let clock = Eio.Stdenv.clock env in 117 117 + discover ~sw ~net ~clock ~timeout filter 115 118 in 116 119 Cmd.v info Term.(const run $ Vlog.setup "matter" $ timeout_arg $ filter_arg) 117 120 ··· 165 168 Cmd.v info 166 169 Term.(const run $ Vlog.setup "matter" $ ip_arg $ port_arg $ passcode_arg) 167 170 168 168 - (* Control command - unified on/off/toggle *) 171 171 + let run_control () action ip port passcode endpoint = 172 172 + Eio_main.run @@ fun env -> 173 173 + Eio.Switch.run @@ fun sw -> 174 174 + let net = Eio.Stdenv.net env in 175 175 + let clock = Eio.Stdenv.clock env in 176 176 + match Matter.Session.establish_pase ~net ~sw ~clock ~ip ~port ~passcode with 177 177 + | Error (`Msg e) -> 178 178 + Logs.err (fun m -> m "PASE error: %s" e); 179 179 + exit exit_error 180 180 + | Ok conn -> ( 181 181 + let cmd_fn = 182 182 + match action with 183 183 + | On -> Matter.Session.turn_on 184 184 + | Off -> Matter.Session.turn_off 185 185 + | Toggle -> Matter.Session.toggle 186 186 + in 187 187 + let action_str = 188 188 + match action with On -> "on" | Off -> "off" | Toggle -> "toggled" 189 189 + in 190 190 + match cmd_fn ~clock conn ~endpoint_id:endpoint with 191 191 + | Ok _ -> Logs.info (fun m -> m "Device turned %s." action_str) 192 192 + | Error `Timeout -> 193 193 + Logs.err (fun m -> m "Error: timeout waiting for response."); 194 194 + exit exit_error) 195 195 + 169 196 let control_cmd = 170 197 let doc = "Control power state of a Matter device" in 171 198 let man = ··· 207 234 let doc = "Endpoint ID for the on/off cluster." in 208 235 Arg.(value & opt int 1 & info [ "e"; "endpoint" ] ~docv:"ID" ~doc) 209 236 in 210 210 - let run () action ip port passcode endpoint = 211 211 - Eio_main.run @@ fun env -> 212 212 - Eio.Switch.run @@ fun sw -> 213 213 - let net = Eio.Stdenv.net env in 214 214 - let clock = Eio.Stdenv.clock env in 215 215 - match Matter.Session.establish_pase ~net ~sw ~clock ~ip ~port ~passcode with 216 216 - | Error (`Msg e) -> 217 217 - Logs.err (fun m -> m "PASE error: %s" e); 218 218 - exit exit_error 219 219 - | Ok conn -> ( 220 220 - let cmd_fn = 221 221 - match action with 222 222 - | On -> Matter.Session.turn_on 223 223 - | Off -> Matter.Session.turn_off 224 224 - | Toggle -> Matter.Session.toggle 225 225 - in 226 226 - let action_str = 227 227 - match action with On -> "on" | Off -> "off" | Toggle -> "toggled" 228 228 - in 229 229 - match cmd_fn ~clock conn ~endpoint_id:endpoint with 230 230 - | Ok _ -> Logs.info (fun m -> m "Device turned %s." action_str) 231 231 - | Error `Timeout -> 232 232 - Logs.err (fun m -> m "Error: timeout waiting for response."); 233 233 - exit exit_error) 234 234 - in 235 237 Cmd.v info 236 238 Term.( 237 237 - const run $ Vlog.setup "matter" $ action_arg $ ip_arg $ port_arg 239 239 + const run_control $ Vlog.setup "matter" $ action_arg $ ip_arg $ port_arg 238 240 $ passcode_arg $ endpoint_arg) 239 241 240 242 (* Main command group *)

+114 -126

lib/case.ml

reviewed

··· 405 405 Log.debug (fun m -> m "CASE initiator: generated Sigma1"); 406 406 (state, sigma1) 407 407 408 408 - let initiator_finish state sigma2 = 409 409 - Log.debug (fun m -> m "CASE initiator: processing Sigma2"); 408 408 + let decode_noc_and_icac ~label noc_der icac_der_opt = 409 409 + let* noc = 410 410 + match X509.Certificate.decode_der noc_der with 411 411 + | Ok c -> Ok c 412 412 + | Error (`Msg e) -> Error ("Failed to parse " ^ label ^ " NOC: " ^ e) 413 413 + in 414 414 + let* icac = 415 415 + match icac_der_opt with 416 416 + | None -> Ok None 417 417 + | Some der -> ( 418 418 + match X509.Certificate.decode_der der with 419 419 + | Ok c -> Ok (Some c) 420 420 + | Error (`Msg e) -> Error ("Failed to parse " ^ label ^ " ICAC: " ^ e)) 421 421 + in 422 422 + Ok (noc, icac) 410 423 411 411 - (* Compute shared secret *) 424 424 + let initiator_decrypt_sigma2 state sigma2 = 412 425 let* shared_secret = 413 426 ecdh_shared_secret state.i_eph_priv sigma2.responder_eph_pub_key 414 427 in 415 415 - 416 416 - (* Derive key for decrypting Sigma2 *) 417 428 let salt = state.i_random ^ sigma2.responder_random in 418 429 let s2k = derive_sigma_key ~shared_secret ~salt ~info:sigma2_info in 419 419 - 420 420 - (* Decrypt TBS2 *) 421 430 let* tbs2_inner = 422 431 aes_ccm_decrypt ~key:s2k ~nonce ~adata:"" sigma2.encrypted2 423 432 in 424 424 - 425 425 - (* Parse TBS2 inner structure *) 426 433 let* noc_der, icac_der_opt, signature = decode_tbs2_inner tbs2_inner in 427 427 - 428 428 - (* Parse certificates *) 429 429 - let* responder_noc = 430 430 - match X509.Certificate.decode_der noc_der with 431 431 - | Ok c -> Ok c 432 432 - | Error (`Msg e) -> Error ("Failed to parse responder NOC: " ^ e) 434 434 + let* noc, icac = 435 435 + decode_noc_and_icac ~label:"responder" noc_der icac_der_opt 433 436 in 434 434 - let* responder_icac = 435 435 - match icac_der_opt with 436 436 - | None -> Ok None 437 437 - | Some der -> ( 438 438 - match X509.Certificate.decode_der der with 439 439 - | Ok c -> Ok (Some c) 440 440 - | Error (`Msg e) -> Error ("Failed to parse responder ICAC: " ^ e)) 441 441 - in 437 437 + Ok (shared_secret, salt, noc, icac, signature) 442 438 443 443 - (* Extract responder public key and verify signature *) 439 439 + let initiator_verify_sigma2 state sigma2 ~responder_noc ~responder_icac 440 440 + ~signature = 444 441 let* responder_pub_key = cert_public_key responder_noc in 445 442 let tbs2 = 446 443 build_sigma2_tbs ~responder_noc ~responder_icac ··· 450 447 in 451 448 if not (ecdsa_verify ~key:responder_pub_key ~signature tbs2) then 452 449 Error "Sigma2 signature verification failed" 453 453 - else begin 454 454 - Log.debug (fun m -> m "CASE initiator: Sigma2 signature verified"); 450 450 + else Ok () 455 451 456 456 - (* Build Sigma3 *) 457 457 - let tbs3 = 458 458 - build_sigma3_tbs ~initiator_noc:state.i_credentials.noc 459 459 - ~initiator_icac:state.i_credentials.icac 460 460 - ~initiator_eph_pub:state.i_eph_pub 461 461 - ~responder_eph_pub:sigma2.responder_eph_pub_key 462 462 - ~initiator_random:state.i_random 463 463 - ~responder_random:sigma2.responder_random 464 464 - in 465 465 - let signature3 = ecdsa_sign ~key:state.i_credentials.private_key tbs3 in 466 466 - 467 467 - (* Encode TBS3 inner *) 468 468 - let tbs3_inner = 469 469 - encode_tbs2_inner ~noc:state.i_credentials.noc 470 470 - ~icac:state.i_credentials.icac ~signature:signature3 471 471 - in 452 452 + let initiator_build_sigma3 state sigma2 ~shared_secret ~salt = 453 453 + let tbs3 = 454 454 + build_sigma3_tbs ~initiator_noc:state.i_credentials.noc 455 455 + ~initiator_icac:state.i_credentials.icac 456 456 + ~initiator_eph_pub:state.i_eph_pub 457 457 + ~responder_eph_pub:sigma2.responder_eph_pub_key 458 458 + ~initiator_random:state.i_random ~responder_random:sigma2.responder_random 459 459 + in 460 460 + let signature3 = ecdsa_sign ~key:state.i_credentials.private_key tbs3 in 461 461 + let tbs3_inner = 462 462 + encode_tbs2_inner ~noc:state.i_credentials.noc 463 463 + ~icac:state.i_credentials.icac ~signature:signature3 464 464 + in 465 465 + let s3k = derive_sigma_key ~shared_secret ~salt ~info:sigma3_info in 466 466 + let encrypted3 = aes_ccm_encrypt ~key:s3k ~nonce ~adata:"" tbs3_inner in 467 467 + let session_keys = 468 468 + derive_session_keys ~shared_secret ~initiator_random:state.i_random 469 469 + ~responder_random:sigma2.responder_random ~initiator_pub:state.i_eph_pub 470 470 + ~responder_pub:sigma2.responder_eph_pub_key 471 471 + in 472 472 + (session_keys, { encrypted3 }) 472 473 473 473 - (* Encrypt TBS3 *) 474 474 - let s3k = derive_sigma_key ~shared_secret ~salt ~info:sigma3_info in 475 475 - let encrypted3 = aes_ccm_encrypt ~key:s3k ~nonce ~adata:"" tbs3_inner in 474 474 + let initiator_finish state sigma2 = 475 475 + Log.debug (fun m -> m "CASE initiator: processing Sigma2"); 476 476 + let* shared_secret, salt, responder_noc, responder_icac, signature = 477 477 + initiator_decrypt_sigma2 state sigma2 478 478 + in 479 479 + let* () = 480 480 + initiator_verify_sigma2 state sigma2 ~responder_noc ~responder_icac 481 481 + ~signature 482 482 + in 483 483 + Log.debug (fun m -> m "CASE initiator: Sigma2 signature verified"); 484 484 + let session_keys, sigma3 = 485 485 + initiator_build_sigma3 state sigma2 ~shared_secret ~salt 486 486 + in 487 487 + Log.debug (fun m -> m "CASE initiator: generated Sigma3"); 488 488 + Ok (session_keys, sigma3) 476 489 477 477 - (* Derive session keys *) 478 478 - let session_keys = 479 479 - derive_session_keys ~shared_secret ~initiator_random:state.i_random 480 480 - ~responder_random:sigma2.responder_random ~initiator_pub:state.i_eph_pub 481 481 - ~responder_pub:sigma2.responder_eph_pub_key 482 482 - in 490 490 + let responder_sign_and_encrypt ~credentials ~(sigma1 : sigma1) ~random ~eph_pub 491 491 + ~shared_secret = 492 492 + let tbs2 = 493 493 + build_sigma2_tbs ~responder_noc:credentials.noc 494 494 + ~responder_icac:credentials.icac ~responder_eph_pub:eph_pub 495 495 + ~initiator_eph_pub:sigma1.initiator_eph_pub_key 496 496 + ~initiator_random:sigma1.initiator_random ~responder_random:random 497 497 + in 498 498 + let signature2 = ecdsa_sign ~key:credentials.private_key tbs2 in 499 499 + let tbs2_inner = 500 500 + encode_tbs2_inner ~noc:credentials.noc ~icac:credentials.icac 501 501 + ~signature:signature2 502 502 + in 503 503 + let salt = sigma1.initiator_random ^ random in 504 504 + let s2k = derive_sigma_key ~shared_secret ~salt ~info:sigma2_info in 505 505 + aes_ccm_encrypt ~key:s2k ~nonce ~adata:"" tbs2_inner 483 506 484 484 - Log.debug (fun m -> m "CASE initiator: generated Sigma3"); 485 485 - Ok (session_keys, { encrypted3 }) 486 486 - end 507 507 + let responder_build_state ~credentials ~(sigma1 : sigma1) ~responder_session_id 508 508 + ~random ~eph_priv ~eph_pub ~shared_secret = 509 509 + { 510 510 + r_credentials = credentials; 511 511 + r_session_id = responder_session_id; 512 512 + r_random = random; 513 513 + r_eph_priv = eph_priv; 514 514 + r_eph_pub = eph_pub; 515 515 + r_peer_eph_pub = sigma1.initiator_eph_pub_key; 516 516 + r_peer_session_id = sigma1.initiator_session_id; 517 517 + r_peer_random = sigma1.initiator_random; 518 518 + r_shared_secret = shared_secret; 519 519 + } 487 520 488 521 let responder_start ~credentials ~(sigma1 : sigma1) ~responder_session_id = 489 522 Log.debug (fun m -> m "CASE responder: processing Sigma1"); 490 490 - 491 491 - (* Verify destination_id matches our fabric *) 492 523 let expected_dest_id = 493 524 compute_destination_id ~fabric:credentials.fabric 494 525 ~initiator_random:sigma1.initiator_random ··· 498 529 else begin 499 530 let random = Crypto_rng.generate 32 in 500 531 let eph_priv, eph_pub = generate_ephemeral_keypair () in 501 501 - 502 502 - (* Compute shared secret *) 503 532 let* shared_secret = 504 533 ecdh_shared_secret eph_priv sigma1.initiator_eph_pub_key 505 534 in 506 506 - 507 507 - (* Build TBS2 for signature *) 508 508 - let tbs2 = 509 509 - build_sigma2_tbs ~responder_noc:credentials.noc 510 510 - ~responder_icac:credentials.icac ~responder_eph_pub:eph_pub 511 511 - ~initiator_eph_pub:sigma1.initiator_eph_pub_key 512 512 - ~initiator_random:sigma1.initiator_random ~responder_random:random 535 535 + let encrypted2 = 536 536 + responder_sign_and_encrypt ~credentials ~sigma1 ~random ~eph_pub 537 537 + ~shared_secret 513 538 in 514 514 - let signature2 = ecdsa_sign ~key:credentials.private_key tbs2 in 515 515 - 516 516 - (* Encode TBS2 inner structure *) 517 517 - let tbs2_inner = 518 518 - encode_tbs2_inner ~noc:credentials.noc ~icac:credentials.icac 519 519 - ~signature:signature2 520 520 - in 521 521 - 522 522 - (* Encrypt TBS2 *) 523 523 - let salt = sigma1.initiator_random ^ random in 524 524 - let s2k = derive_sigma_key ~shared_secret ~salt ~info:sigma2_info in 525 525 - let encrypted2 = aes_ccm_encrypt ~key:s2k ~nonce ~adata:"" tbs2_inner in 526 526 - 527 539 let state = 528 528 - { 529 529 - r_credentials = credentials; 530 530 - r_session_id = responder_session_id; 531 531 - r_random = random; 532 532 - r_eph_priv = eph_priv; 533 533 - r_eph_pub = eph_pub; 534 534 - r_peer_eph_pub = sigma1.initiator_eph_pub_key; 535 535 - r_peer_session_id = sigma1.initiator_session_id; 536 536 - r_peer_random = sigma1.initiator_random; 537 537 - r_shared_secret = shared_secret; 538 538 - } 540 540 + responder_build_state ~credentials ~sigma1 ~responder_session_id ~random 541 541 + ~eph_priv ~eph_pub ~shared_secret 539 542 in 540 540 - 541 543 let sigma2 = 542 544 { 543 545 responder_random = random; ··· 547 549 responder_session_params = None; 548 550 } 549 551 in 550 550 - 551 552 Log.debug (fun m -> m "CASE responder: generated Sigma2"); 552 553 Ok (state, sigma2) 553 554 end 554 555 555 555 - let responder_finish state sigma3 = 556 556 - Log.debug (fun m -> m "CASE responder: processing Sigma3"); 557 557 - 558 558 - (* Derive key for decrypting Sigma3 *) 556 556 + let responder_decrypt_sigma3 state sigma3 = 559 557 let salt = state.r_peer_random ^ state.r_random in 560 558 let s3k = 561 559 derive_sigma_key ~shared_secret:state.r_shared_secret ~salt 562 560 ~info:sigma3_info 563 561 in 564 564 - 565 565 - (* Decrypt TBS3 *) 566 562 let* tbs3_inner = 567 563 aes_ccm_decrypt ~key:s3k ~nonce ~adata:"" sigma3.encrypted3 568 564 in 569 569 - 570 570 - (* Parse TBS3 inner structure *) 571 565 let* noc_der, icac_der_opt, signature = decode_tbs2_inner tbs3_inner in 572 572 - 573 573 - (* Parse certificates *) 574 574 - let* initiator_noc = 575 575 - match X509.Certificate.decode_der noc_der with 576 576 - | Ok c -> Ok c 577 577 - | Error (`Msg e) -> Error ("Failed to parse initiator NOC: " ^ e) 566 566 + let* noc, icac = 567 567 + decode_noc_and_icac ~label:"initiator" noc_der icac_der_opt 578 568 in 579 579 - let* initiator_icac = 580 580 - match icac_der_opt with 581 581 - | None -> Ok None 582 582 - | Some der -> ( 583 583 - match X509.Certificate.decode_der der with 584 584 - | Ok c -> Ok (Some c) 585 585 - | Error (`Msg e) -> Error ("Failed to parse initiator ICAC: " ^ e)) 586 586 - in 569 569 + Ok (noc, icac, signature) 587 570 588 588 - (* Extract initiator public key and verify signature *) 571 571 + let responder_verify_and_derive state ~initiator_noc ~initiator_icac ~signature 572 572 + = 589 573 let* initiator_pub_key = cert_public_key initiator_noc in 590 574 let tbs3 = 591 575 build_sigma3_tbs ~initiator_noc ~initiator_icac ··· 594 578 in 595 579 if not (ecdsa_verify ~key:initiator_pub_key ~signature tbs3) then 596 580 Error "Sigma3 signature verification failed" 597 597 - else begin 598 598 - Log.debug (fun m -> m "CASE responder: Sigma3 signature verified"); 599 599 - 600 600 - (* Derive session keys *) 601 601 - let session_keys = 602 602 - derive_session_keys ~shared_secret:state.r_shared_secret 603 603 - ~initiator_random:state.r_peer_random ~responder_random:state.r_random 604 604 - ~initiator_pub:state.r_peer_eph_pub ~responder_pub:state.r_eph_pub 605 605 - in 581 581 + else 582 582 + Ok 583 583 + (derive_session_keys ~shared_secret:state.r_shared_secret 584 584 + ~initiator_random:state.r_peer_random ~responder_random:state.r_random 585 585 + ~initiator_pub:state.r_peer_eph_pub ~responder_pub:state.r_eph_pub) 606 586 607 607 - Log.debug (fun m -> m "CASE responder: session established"); 608 608 - Ok session_keys 609 609 - end 587 587 + let responder_finish state sigma3 = 588 588 + Log.debug (fun m -> m "CASE responder: processing Sigma3"); 589 589 + let* initiator_noc, initiator_icac, signature = 590 590 + responder_decrypt_sigma3 state sigma3 591 591 + in 592 592 + let* session_keys = 593 593 + responder_verify_and_derive state ~initiator_noc ~initiator_icac ~signature 594 594 + in 595 595 + Log.debug (fun m -> m "CASE responder: Sigma3 signature verified"); 596 596 + Log.debug (fun m -> m "CASE responder: session established"); 597 597 + Ok session_keys

+74 -77

lib/discovery.ml

reviewed

··· 71 71 72 72 (** {1 Discovery Functions} *) 73 73 74 74 + let srv instance srvs = 75 75 + match List.find_opt (fun (n, _, _) -> Domain_name.equal n instance) srvs with 76 76 + | Some (_, p, t) -> (Domain_name.to_string t, p) 77 77 + | None -> ("", 5540) 78 78 + 79 79 + let txt_records instance txts = 80 80 + match 81 81 + List.find_map 82 82 + (fun (n, t) -> if Domain_name.equal n instance then Some t else None) 83 83 + txts 84 84 + with 85 85 + | Some t -> parse_txt_records t 86 86 + | None -> [] 87 87 + 88 88 + let ip hostname addrs = 89 89 + List.find_map 90 90 + (fun (n, addr) -> 91 91 + if Domain_name.to_string n = hostname then Some (Ipaddr.V4.to_string addr) 92 92 + else None) 93 93 + addrs 94 94 + 95 95 + let device ~service_type ~name ~hostname ~port ~ip ~records = 96 96 + let vp = parse_vendor_product records in 97 97 + if service_type = "_matterc._udp" then 98 98 + Commissionable 99 99 + { 100 100 + instance_name = name; 101 101 + hostname; 102 102 + port; 103 103 + ip; 104 104 + vendor_product = vp; 105 105 + discriminator = txt_int "D" records; 106 106 + commissioning_mode = txt_int "CM" records; 107 107 + device_type = txt_int "DT" records; 108 108 + pairing_hint = txt_int "PH" records; 109 109 + pairing_instruction = txt "PI" records; 110 110 + } 111 111 + else 112 112 + let fabric_id, node_id = 113 113 + match parse_instance_name name with 114 114 + | Some (f, n) -> (f, n) 115 115 + | None -> ("", name) 116 116 + in 117 117 + Operational 118 118 + { 119 119 + instance_name = name; 120 120 + fabric_id; 121 121 + node_id; 122 122 + hostname; 123 123 + port; 124 124 + ip; 125 125 + vendor_product = vp; 126 126 + compressed_fabric_id = txt "ICD" records; 127 127 + } 128 128 + 129 129 + let device_name d = 130 130 + match d with 131 131 + | Commissionable a -> a.instance_name 132 132 + | Operational a -> a.instance_name 133 133 + 134 134 + let is_duplicate device devices = 135 135 + List.exists 136 136 + (fun d -> 137 137 + match (d, device) with 138 138 + | Commissionable _, Commissionable _ | Operational _, Operational _ -> 139 139 + device_name d = device_name device 140 140 + | _ -> false) 141 141 + devices 142 142 + 74 143 let discover_matter ~sw ~net ~clock ~timeout service_type = 75 144 let service_name = Domain_name.of_string_exn (service_type ^ ".local") in 76 145 let r = Mdns.merge (Mdns.query ~sw ~net ~clock ~timeout service_name) in 77 146 let devices = ref [] in 78 78 - (* Process PTR records *) 79 147 List.iter 80 148 (fun (_, instance) -> 81 149 let instance_str = Domain_name.to_string instance in ··· 84 152 | Ok n -> n 85 153 | Error _ -> instance_str 86 154 in 87 87 - (* Find SRV record *) 88 88 - let hostname, port = 89 89 - match 90 90 - List.find_opt 91 91 - (fun (n, _, _) -> Domain_name.equal n instance) 92 92 - r.Mdns.srvs 93 93 - with 94 94 - | Some (_, p, t) -> (Domain_name.to_string t, p) 95 95 - | None -> ("", 5540) 96 96 - in 97 97 - (* Find TXT record *) 98 98 - let records = 99 99 - match 100 100 - List.find_map 101 101 - (fun (n, t) -> 102 102 - if Domain_name.equal n instance then Some t else None) 103 103 - r.Mdns.txts 104 104 - with 105 105 - | Some t -> parse_txt_records t 106 106 - | None -> [] 107 107 - in 108 108 - (* Find IP address *) 109 109 - let ip = 110 110 - List.find_map 111 111 - (fun (n, addr) -> 112 112 - if Domain_name.to_string n = hostname then 113 113 - Some (Ipaddr.V4.to_string addr) 114 114 - else None) 115 115 - r.Mdns.addrs 116 116 - 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 121 121 - { 122 122 - instance_name = name; 123 123 - hostname; 124 124 - port; 125 125 - ip; 126 126 - vendor_product = vp; 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 = 135 135 - match parse_instance_name name with 136 136 - | Some (f, n) -> (f, n) 137 137 - | None -> ("", name) 138 138 - in 139 139 - Operational 140 140 - { 141 141 - instance_name = name; 142 142 - fabric_id; 143 143 - node_id; 144 144 - hostname; 145 145 - port; 146 146 - ip; 147 147 - vendor_product = vp; 148 148 - compressed_fabric_id = txt "ICD" records; 149 149 - } 150 150 - in 151 151 - if 152 152 - not 153 153 - (List.exists 154 154 - (fun d -> 155 155 - match (d, device) with 156 156 - | Commissionable a, Commissionable b -> 157 157 - a.instance_name = b.instance_name 158 158 - | Operational a, Operational b -> 159 159 - a.instance_name = b.instance_name 160 160 - | _ -> false) 161 161 - !devices) 162 162 - then devices := device :: !devices) 155 155 + let hostname, port = srv instance r.Mdns.srvs in 156 156 + let records = txt_records instance r.Mdns.txts in 157 157 + let ip = ip hostname r.Mdns.addrs in 158 158 + let device = device ~service_type ~name ~hostname ~port ~ip ~records in 159 159 + if not (is_duplicate device !devices) then devices := device :: !devices) 163 160 r.Mdns.ptrs; 164 161 !devices 165 162

+12 -11

lib/msg.ml

reviewed

··· 230 230 done; 231 231 Ok (!v, offset + 8) 232 232 233 233 + let decode_destination data offset dsiz = 234 234 + match dsiz with 235 235 + | 0 -> Ok (No_destination, offset) 236 236 + | 1 -> 237 237 + let* id, off = uint64_le data offset in 238 238 + Ok (Node_id id, off) 239 239 + | 2 -> 240 240 + let* id, off = uint16_le data offset in 241 241 + Ok (Group_id id, off) 242 242 + | _ -> Error "Invalid DSIZ value" 243 243 + 233 244 let decode_message_header data = 234 245 let* flags_byte, offset = byte data 0 in 235 246 let flags = ··· 263 274 else Ok (None, offset) 264 275 in 265 276 266 266 - let* destination, offset = 267 267 - match flags.dsiz with 268 268 - | 0 -> Ok (No_destination, offset) 269 269 - | 1 -> 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 = uint16_le data offset in 274 274 - Ok (Group_id id, off) 275 275 - | _ -> Error "Invalid DSIZ value" 276 276 - in 277 277 + let* destination, offset = decode_destination data offset flags.dsiz in 277 278 278 279 Ok 279 280 ( {

+13 -12

lib/session.ml

reviewed

··· 200 200 (Printf.sprintf "Expected StatusReport, got opcode %d" 201 201 proto_hdr.protocol_opcode)))) 202 202 203 203 + let install_session_keys conn ke = 204 204 + let session_keys = 205 205 + Pase.hkdf ~salt:"" ~ikm:ke ~info:"SessionKeys" ~length:48 206 206 + in 207 207 + let i2r_key = String.sub session_keys 0 16 in 208 208 + let r2i_key = String.sub session_keys 16 16 in 209 209 + let attestation_challenge = String.sub session_keys 32 16 in 210 210 + conn.session.state <- Authenticated; 211 211 + conn.session.i2r_key <- Some i2r_key; 212 212 + conn.session.r2i_key <- Some r2i_key; 213 213 + conn.session.attestation_challenge <- Some attestation_challenge 214 214 + 203 215 let establish_pase ~net ~sw ~clock ~ip ~port ~passcode = 204 216 let conn = connect ~net ~sw ~ip ~port in 205 217 ··· 247 259 let* () = pase_pake3_exchange ~clock conn ~exchange_id ~ca in 248 260 Log.info (fun m -> m "PASE completed successfully!"); 249 261 250 250 - let session_keys = 251 251 - Pase.hkdf ~salt:"" ~ikm:ke ~info:"SessionKeys" ~length:48 252 252 - in 253 253 - let i2r_key = String.sub session_keys 0 16 in 254 254 - let r2i_key = String.sub session_keys 16 16 in 255 255 - let attestation_challenge = String.sub session_keys 32 16 in 256 256 - 257 257 - conn.session.state <- Authenticated; 258 258 - conn.session.i2r_key <- Some i2r_key; 259 259 - conn.session.r2i_key <- Some r2i_key; 260 260 - conn.session.attestation_challenge <- Some attestation_challenge; 261 261 - 262 262 + install_session_keys conn ke; 262 263 Ok conn 263 264 end 264 265