+8 -3

.beads/issues.jsonl

··· 1 1 {"id":"swim-294","title":"Implement test generators (test/generators.ml)","description":"Create QCheck generators for property-based testing.\n\n## Generators to implement\n\n### Basic types\n- `gen_node_id : node_id QCheck.Gen.t`\n- `gen_incarnation : incarnation QCheck.Gen.t`\n- `gen_member_state : member_state QCheck.Gen.t`\n\n### Node types\n- `gen_node_info : node_info QCheck.Gen.t`\n - Generate valid addresses\n - Random metadata strings\n\n### Protocol messages\n- `gen_ping : protocol_msg QCheck.Gen.t`\n- `gen_ping_req : protocol_msg QCheck.Gen.t`\n- `gen_ack : protocol_msg QCheck.Gen.t`\n- `gen_alive : protocol_msg QCheck.Gen.t`\n- `gen_suspect : protocol_msg QCheck.Gen.t`\n- `gen_dead : protocol_msg QCheck.Gen.t`\n- `gen_user_msg : protocol_msg QCheck.Gen.t`\n- `gen_protocol_msg : protocol_msg QCheck.Gen.t` (uniform choice)\n\n### Packets\n- `gen_packet : packet QCheck.Gen.t`\n - Valid cluster names\n - Primary + piggyback messages\n\n### Binary data\n- `gen_cstruct : Cstruct.t QCheck.Gen.t`\n - Various sizes\n\n### Arbitrary instances\n- `arb_*` wrappers with shrinkers where useful\n\n## Design constraints\n- Use QCheck.Gen combinators\n- Generate valid data by construction\n- Include edge cases (empty strings, max values)","acceptance_criteria":"- All message types have generators\n- Generators produce valid data\n- Good distribution of test cases","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-08T18:49:22.04090675+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T20:00:13.745057699+01:00","closed_at":"2026-01-08T20:00:13.745057699+01:00","close_reason":"Implemented all QCheck generators for SWIM types","labels":["qcheck","test"],"dependencies":[{"issue_id":"swim-294","depends_on_id":"swim-td8","type":"blocks","created_at":"2026-01-08T18:49:22.044472866+01:00","created_by":"gdiazlo"},{"issue_id":"swim-294","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:49:26.910584411+01:00","created_by":"gdiazlo"}]} 2 2 {"id":"swim-461","title":"Implement crypto tests (test/test_crypto.ml)","description":"Property-based and unit tests for crypto module.\n\n## Property tests\n\n### Roundtrip\n- `test_crypto_roundtrip` - encrypt then decrypt equals original\n- Test with various data sizes\n\n### Key validation\n- `test_invalid_key_length_rejected`\n- Test 31, 32, 33 byte keys\n\n## Unit tests\n\n### Encryption\n- Test output size = input size + overhead (28 bytes)\n- Test nonce is prepended\n- Test different plaintexts produce different ciphertexts\n\n### Decryption\n- Test successful decryption\n- Test tampered ciphertext fails\n- Test truncated data fails\n- Test wrong key fails\n\n### Key initialization\n- Test valid 32-byte key\n- Test invalid lengths rejected\n\n## Security tests\n- Verify nonces are unique (probabilistic)\n- Verify ciphertext differs from plaintext\n\n## Design constraints\n- Use QCheck for property tests\n- Test all error paths\n- Don't expose key material in errors","acceptance_criteria":"- All property tests pass\n- All unit tests pass\n- Security properties verified\n- Error handling tested","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-08T18:49:51.401236876+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T20:05:13.159541271+01:00","closed_at":"2026-01-08T20:05:13.159541271+01:00","close_reason":"Implemented crypto property and unit tests - all 13 tests passing","labels":["crypto","security","test"],"dependencies":[{"issue_id":"swim-461","depends_on_id":"swim-hc9","type":"blocks","created_at":"2026-01-08T18:49:51.404483911+01:00","created_by":"gdiazlo"},{"issue_id":"swim-461","depends_on_id":"swim-294","type":"blocks","created_at":"2026-01-08T18:49:51.405793127+01:00","created_by":"gdiazlo"},{"issue_id":"swim-461","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:49:56.45969199+01:00","created_by":"gdiazlo"}]} 3 3 + {"id":"swim-5lw","title":"Add LZW compression support for memberlist interop","description":"Memberlist uses LZW compression (compress/lzw in Go) by default for TCP pushPull messages.\n\nCurrent state: We disabled compression in Go interop test to work around this.\n\nRequirements:\n1. Implement LZW decompression (LSB order, litWidth=8)\n2. Implement LZW compression for responses\n3. Handle Compress_msg (type 9) with Algo=0 (lzwAlgo)\n\nWire format:\n- Message type: 9 (Compress_msg)\n- Msgpack: {Algo: 0, Buf: \u003clzw-compressed-data\u003e}\n- Inner data after decompression: pushPull message\n\nOptions:\nA) Pure OCaml LZW implementation (~200-300 lines)\nB) OCaml bindings to a C LZW library\nC) Use camlimages or similar that might have LZW\n\nReference: Go compress/lzw package, hashicorp/memberlist util.go","status":"closed","priority":2,"issue_type":"feature","created_at":"2026-01-08T22:47:55.621647179+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T22:56:55.982995722+01:00","closed_at":"2026-01-08T22:56:55.982995722+01:00","close_reason":"Implemented pure OCaml LZW decompression for memberlist compression support"} 4 4 + {"id":"swim-6ea","title":"Refactor codec to use Cstruct/Bigstringaf instead of string","description":"Current codec uses string for protocol buffers which causes unnecessary memory copies. Should use Cstruct or Bigstringaf buffers directly for zero-copy encoding/decoding. Key areas: encode_internal_msg, decode_internal_msg, Wire type conversions.","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-08T21:39:36.33328134+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T21:59:49.335638629+01:00","closed_at":"2026-01-08T21:59:49.335638629+01:00","close_reason":"Refactored codec to use Cstruct for zero-copy operations. All tests pass."} 5 5 + {"id":"swim-7wx","title":"Make wire protocol compatible with HashiCorp memberlist","notes":"Final Status:\n\nCOMPLETED:\n- Unencrypted UDP ping/ack: WORKS\n- Encrypted UDP ping/ack (version 1 format): WORKS \n- Decryption of both v0 (PKCS7) and v1 messages: WORKS\n\nLIMITATION:\n- TCP Join() not supported (memberlist uses TCP for initial pushPull sync)\n- Nodes can still interoperate if seeded manually via add_member()\n\nFor full Serf/Consul compatibility, need to implement TCP listener.\nSee swim-tcp for TCP support tracking.","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-08T20:51:59.802585513+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T22:21:57.699683907+01:00","closed_at":"2026-01-08T22:21:57.699683907+01:00","close_reason":"Wire protocol compatibility achieved for UDP gossip (encrypted and unencrypted). TCP Join support tracked separately in swim-ffw."} 3 6 {"id":"swim-90e","title":"Implement transport.ml - Eio UDP/TCP networking","description":"Implement network transport layer using Eio.\n\n## UDP Transport\n\n### Functions\n- `create_udp_socket : Eio.Net.t -\u003e addr:string -\u003e port:int -\u003e Eio.Net.datagram_socket`\n- `send_udp : Eio.Net.datagram_socket -\u003e Eio.Net.Sockaddr.datagram -\u003e Cstruct.t -\u003e unit`\n- `recv_udp : Eio.Net.datagram_socket -\u003e Cstruct.t -\u003e (int * Eio.Net.Sockaddr.datagram)`\n\n## TCP Transport (for large payloads)\n\n### Functions\n- `create_tcp_listener : Eio.Net.t -\u003e addr:string -\u003e port:int -\u003e Eio.Net.listening_socket`\n- `connect_tcp : Eio.Net.t -\u003e addr:Eio.Net.Sockaddr.stream -\u003e timeout:float -\u003e clock:Eio.Time.clock -\u003e (Eio.Net.stream_socket, send_error) result`\n- `send_tcp : Eio.Net.stream_socket -\u003e Cstruct.t -\u003e (unit, send_error) result`\n- `recv_tcp : Eio.Net.stream_socket -\u003e Cstruct.t -\u003e (int, [`Connection_reset]) result`\n\n## Address parsing\n- `parse_addr : string -\u003e (Eio.Net.Sockaddr.datagram, [`Invalid_addr]) result`\n - Parse \"host:port\" format\n\n## Design constraints\n- Use Eio.Net for all I/O\n- No blocking except Eio primitives\n- Proper error handling via Result\n- Support for IPv4 and IPv6","acceptance_criteria":"- UDP send/recv works\n- TCP connect/send/recv works\n- Proper error handling\n- Address parsing robust","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:48:09.296035344+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:39:34.082898832+01:00","closed_at":"2026-01-08T19:39:34.082898832+01:00","close_reason":"Implemented UDP and TCP transport with Eio.Net, plus address parsing (mli skipped due to complex Eio row types)","labels":["core","eio","transport"],"dependencies":[{"issue_id":"swim-90e","depends_on_id":"swim-oun","type":"blocks","created_at":"2026-01-08T18:48:09.299855321+01:00","created_by":"gdiazlo"},{"issue_id":"swim-90e","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:48:15.52111057+01:00","created_by":"gdiazlo"}]} 4 4 - {"id":"swim-don","title":"Implement benchmarks (bench/)","description":"Performance benchmarks for critical paths.\n\n## bench/bench_codec.ml\n- `bench_encode_ping` - encoding a Ping message\n- `bench_encode_packet` - full packet with piggyback\n- `bench_decode_packet` - decoding a packet\n- `bench_encoded_size` - size calculation\n\n## bench/bench_crypto.ml\n- `bench_encrypt` - encryption throughput\n- `bench_decrypt` - decryption throughput\n- `bench_key_init` - key initialization\n\n## bench/bench_throughput.ml\n- `bench_broadcast_throughput` - messages/second\n- `bench_probe_cycle` - probe cycle latency\n- `bench_concurrent_probes` - parallel probe handling\n\n## bench/bench_allocations.ml\n- `bench_probe_cycle_allocations` - count allocations per probe\n- `bench_buffer_reuse_rate` - % of buffers reused\n- `bench_message_handling_allocations` - allocations per message\n\n## Performance targets to verify\n- \u003c 5 allocations per probe cycle\n- \u003e 95% buffer reuse rate\n- \u003c 3 seconds failure detection\n- \u003e 10,000 broadcast/sec\n- \u003c 1% CPU idle, \u003c 5% under load\n\n## Design constraints\n- Use core_bench or similar\n- Warm up before measuring\n- Multiple iterations for stability\n- Report with confidence intervals","acceptance_criteria":"- All benchmarks run\n- Performance targets documented\n- Regression detection possible\n- Results reproducible","status":"open","priority":3,"issue_type":"task","created_at":"2026-01-08T18:50:57.818433013+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T18:50:57.818433013+01:00","labels":["bench","performance"],"dependencies":[{"issue_id":"swim-don","depends_on_id":"swim-zsi","type":"blocks","created_at":"2026-01-08T18:50:57.821397737+01:00","created_by":"gdiazlo"},{"issue_id":"swim-don","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:51:03.066326187+01:00","created_by":"gdiazlo"}]} 7 7 + {"id":"swim-don","title":"Implement benchmarks (bench/)","description":"Performance benchmarks for critical paths.\n\n## bench/bench_codec.ml\n- `bench_encode_ping` - encoding a Ping message\n- `bench_encode_packet` - full packet with piggyback\n- `bench_decode_packet` - decoding a packet\n- `bench_encoded_size` - size calculation\n\n## bench/bench_crypto.ml\n- `bench_encrypt` - encryption throughput\n- `bench_decrypt` - decryption throughput\n- `bench_key_init` - key initialization\n\n## bench/bench_throughput.ml\n- `bench_broadcast_throughput` - messages/second\n- `bench_probe_cycle` - probe cycle latency\n- `bench_concurrent_probes` - parallel probe handling\n\n## bench/bench_allocations.ml\n- `bench_probe_cycle_allocations` - count allocations per probe\n- `bench_buffer_reuse_rate` - % of buffers reused\n- `bench_message_handling_allocations` - allocations per message\n\n## Performance targets to verify\n- \u003c 5 allocations per probe cycle\n- \u003e 95% buffer reuse rate\n- \u003c 3 seconds failure detection\n- \u003e 10,000 broadcast/sec\n- \u003c 1% CPU idle, \u003c 5% under load\n\n## Design constraints\n- Use core_bench or similar\n- Warm up before measuring\n- Multiple iterations for stability\n- Report with confidence intervals","acceptance_criteria":"- All benchmarks run\n- Performance targets documented\n- Regression detection possible\n- Results reproducible","status":"closed","priority":3,"issue_type":"task","created_at":"2026-01-08T18:50:57.818433013+01:00","created_by":"gdiazlo","updated_at":"2026-01-09T00:08:02.021391851+01:00","closed_at":"2026-01-09T00:08:02.021391851+01:00","close_reason":"Benchmarks fully working with parallel execution, all 3 implementations (swim-ocaml, memberlist, serf) communicate and measure properly","labels":["bench","performance"],"dependencies":[{"issue_id":"swim-don","depends_on_id":"swim-zsi","type":"blocks","created_at":"2026-01-08T18:50:57.821397737+01:00","created_by":"gdiazlo"},{"issue_id":"swim-don","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:51:03.066326187+01:00","created_by":"gdiazlo"}]} 5 8 {"id":"swim-etm","title":"Implement pending_acks.ml - Ack tracking with promises","description":"Implement pending ack tracking for probe responses.\n\n## Pending_acks module\n```ocaml\ntype waiter = {\n promise : string option Eio.Promise.t;\n resolver : string option Eio.Promise.u;\n}\n\ntype t = {\n table : (int, waiter) Kcas_data.Hashtbl.t;\n}\n```\n\n### Functions\n- `create : unit -\u003e t`\n\n- `register : t -\u003e seq:int -\u003e waiter`\n - Create promise/resolver pair\n - Store in hashtable keyed by sequence number\n - Return waiter handle\n\n- `complete : t -\u003e seq:int -\u003e payload:string option -\u003e bool`\n - Find waiter by seq\n - Resolve promise with payload\n - Remove from table\n - Return true if found\n\n- `wait : waiter -\u003e timeout:float -\u003e clock:Eio.Time.clock -\u003e string option option`\n - Wait for promise with timeout\n - Return Some payload on success\n - Return None on timeout\n\n- `cancel : t -\u003e seq:int -\u003e unit`\n - Remove waiter from table\n - Called on timeout to cleanup\n\n## Design constraints\n- Use Eio.Promise for async waiting\n- Use Eio.Time.with_timeout for timeouts\n- Lock-free via Kcas_data.Hashtbl\n- Cleanup on timeout to prevent leaks","acceptance_criteria":"- Acks properly matched to probes\n- Timeouts work correctly\n- No memory leaks on timeout\n- Concurrent completion safe","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:47:51.390307674+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:35:56.984403853+01:00","closed_at":"2026-01-08T19:35:56.984403853+01:00","close_reason":"Implemented pending_acks with Eio.Promise for async waiting and Kcas_data.Hashtbl for lock-free storage","labels":["core","kcas","protocol"],"dependencies":[{"issue_id":"swim-etm","depends_on_id":"swim-oun","type":"blocks","created_at":"2026-01-08T18:47:51.394677184+01:00","created_by":"gdiazlo"},{"issue_id":"swim-etm","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:47:57.657173744+01:00","created_by":"gdiazlo"}]} 6 9 {"id":"swim-fac","title":"Implement protocol_pure.ml - Pure SWIM state transitions","description":"Implement pure (no effects) SWIM protocol logic for state transitions.\n\n## Core abstraction\n```ocaml\ntype 'a transition = {\n new_state : 'a;\n broadcasts : protocol_msg list;\n events : node_event list;\n}\n```\n\n## State transition functions\n- `handle_alive : member_state -\u003e alive_msg -\u003e now:float -\u003e member_state transition`\n- `handle_suspect : member_state -\u003e suspect_msg -\u003e now:float -\u003e member_state transition`\n- `handle_dead : member_state -\u003e dead_msg -\u003e now:float -\u003e member_state transition`\n- `handle_ack : probe_state -\u003e ack_msg -\u003e probe_state transition`\n\n## Timeout calculations\n- `suspicion_timeout : config -\u003e node_count:int -\u003e float`\n - Based on suspicion_mult and log(node_count)\n - Capped by suspicion_max_timeout\n\n## Probe target selection\n- `next_probe_target : probe_index:int -\u003e members:node list -\u003e (node * int) option`\n - Round-robin with wraparound\n - Skip self\n\n## Message invalidation (for queue pruning)\n- `invalidates : protocol_msg -\u003e protocol_msg -\u003e bool`\n - Alive invalidates Suspect for same node with \u003e= incarnation\n - Dead invalidates everything for same node\n - Suspect invalidates older Suspect\n\n## State merging\n- `merge_member_state : local:member_state -\u003e remote:member_state -\u003e member_state`\n - CRDT-style merge based on incarnation\n - Dead is final (tombstone)\n - Higher incarnation wins\n\n## Retransmit calculation\n- `retransmit_limit : config -\u003e node_count:int -\u003e int`\n - Based on retransmit_mult * ceil(log(node_count + 1))\n\n## Design constraints\n- PURE functions only - no I/O, no time, no randomness\n- All inputs explicit\n- Exhaustive pattern matching\n- Fully testable with property-based tests","acceptance_criteria":"- All functions are pure (no effects)\n- Property-based tests for SWIM invariants\n- Incarnation ordering correct\n- Suspicion timeout formula matches SWIM paper","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:46:48.400928801+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:29:29.816719466+01:00","closed_at":"2026-01-08T19:29:29.816719466+01:00","close_reason":"Implemented all pure SWIM state transitions: handle_alive, handle_suspect, handle_dead, suspicion_timeout, retransmit_limit, next_probe_target, invalidates, merge_member_state, select_indirect_targets","labels":["core","protocol","pure"],"dependencies":[{"issue_id":"swim-fac","depends_on_id":"swim-td8","type":"blocks","created_at":"2026-01-08T18:46:48.40501031+01:00","created_by":"gdiazlo"},{"issue_id":"swim-fac","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:46:52.770706917+01:00","created_by":"gdiazlo"}]} 10 10 + {"id":"swim-ffw","title":"Add TCP listener for memberlist Join() compatibility","description":"Memberlist uses TCP for the initial Join() pushPull state sync.\nCurrently OCaml SWIM only has UDP, so memberlist nodes cannot Join() to us.\n\nRequirements:\n1. TCP listener on bind_port (same as UDP)\n2. Handle pushPull state exchange messages\n3. Support encrypted TCP connections\n\nWire format for TCP is same as UDP but with length prefix.\n\nReference: hashicorp/memberlist net.go sendAndReceiveState()","status":"closed","priority":2,"issue_type":"feature","created_at":"2026-01-08T22:21:40.02285377+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T22:43:27.425951418+01:00","closed_at":"2026-01-08T22:43:27.425951418+01:00","close_reason":"Implemented TCP listener for memberlist Join() compatibility"} 7 11 {"id":"swim-hc9","title":"Implement crypto.ml - AES-256-GCM encryption","description":"Implement encryption layer using mirage-crypto for AES-256-GCM.\n\n## Constants\n- `nonce_size = 12`\n- `tag_size = 16`\n- `overhead = nonce_size + tag_size` (28 bytes)\n\n## Functions\n\n### Key initialization\n- `init_key : string -\u003e (key, [`Invalid_key_length]) result`\n- Must be exactly 32 bytes for AES-256\n\n### Encryption\n- `encrypt : key -\u003e Cstruct.t -\u003e Cstruct.t`\n- Generate random nonce via mirage-crypto-rng\n- Prepend nonce to ciphertext\n- Result: nonce (12) + ciphertext + tag (16)\n\n### Decryption\n- `decrypt : key -\u003e Cstruct.t -\u003e (Cstruct.t, [`Too_short | `Decryption_failed]) result`\n- Extract nonce from first 12 bytes\n- Verify and decrypt remaining data\n- Return plaintext or error\n\n## Design constraints\n- Use mirage-crypto.Cipher_block.AES.GCM\n- Use mirage-crypto-rng for nonce generation\n- Return Result types, no exceptions\n- Consider in-place decryption where possible","acceptance_criteria":"- Property-based roundtrip tests pass\n- Invalid data properly rejected\n- Key validation works\n- Nonces are unique (use RNG)","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:46:09.946405585+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:24:49.736202746+01:00","closed_at":"2026-01-08T19:24:49.736202746+01:00","close_reason":"Implemented crypto.ml with AES-256-GCM using mirage-crypto. Uses Eio.Flow for secure random nonce generation.","labels":["core","crypto","security"],"dependencies":[{"issue_id":"swim-hc9","depends_on_id":"swim-oun","type":"blocks","created_at":"2026-01-08T18:46:09.950083952+01:00","created_by":"gdiazlo"},{"issue_id":"swim-hc9","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:46:14.608204384+01:00","created_by":"gdiazlo"}]} 12 12 + {"id":"swim-hrd","title":"Optimize memory allocation in TCP handler and LZW","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T23:01:20.712060651+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T23:07:38.188801028+01:00","closed_at":"2026-01-08T23:07:38.188801028+01:00","close_reason":"Memory optimization complete"} 8 13 {"id":"swim-iwg","title":"Implement dissemination.ml - Broadcast queue with invalidation","description":"Implement the broadcast queue for SWIM protocol message dissemination.\n\n## Broadcast_queue module\n```ocaml\ntype item = {\n msg : protocol_msg;\n transmits : int Kcas.Loc.t;\n created : Mtime.span;\n}\n\ntype t = {\n queue : item Kcas_data.Queue.t;\n depth : int Kcas.Loc.t;\n}\n```\n\n### Functions\n- `create : unit -\u003e t`\n\n- `enqueue : t -\u003e protocol_msg -\u003e transmits:int -\u003e created:Mtime.span -\u003e unit`\n - Add message with initial transmit count\n - Increment depth\n\n- `drain : t -\u003e max_bytes:int -\u003e encode_size:(protocol_msg -\u003e int) -\u003e protocol_msg list`\n - Pop messages up to max_bytes\n - Decrement transmit count\n - Re-enqueue if transmits \u003e 0\n - Return list of messages to piggyback\n\n- `depth : t -\u003e int`\n\n- `invalidate : t -\u003e invalidates:(protocol_msg -\u003e protocol_msg -\u003e bool) -\u003e protocol_msg -\u003e unit`\n - Remove messages invalidated by newer message\n - Uses Protocol_pure.invalidates\n\n## Design constraints\n- Lock-free via Kcas_data.Queue\n- Transmit counting for reliable dissemination\n- Size-aware draining for UDP packet limits\n- Message invalidation to prune stale updates","acceptance_criteria":"- Messages properly disseminated\n- Transmit counts respected\n- Invalidation works correctly\n- No message loss during concurrent access","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:47:32.926237507+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:34:04.973053383+01:00","closed_at":"2026-01-08T19:34:04.973053383+01:00","close_reason":"Implemented broadcast queue with enqueue, drain (size-aware), and invalidate functions using Kcas_data.Queue","labels":["core","dissemination","kcas"],"dependencies":[{"issue_id":"swim-iwg","depends_on_id":"swim-td8","type":"blocks","created_at":"2026-01-08T18:47:32.933998652+01:00","created_by":"gdiazlo"},{"issue_id":"swim-iwg","depends_on_id":"swim-fac","type":"blocks","created_at":"2026-01-08T18:47:32.93580631+01:00","created_by":"gdiazlo"},{"issue_id":"swim-iwg","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:47:40.222942145+01:00","created_by":"gdiazlo"}]} 9 14 {"id":"swim-l32","title":"Implement codec tests (test/test_codec.ml)","description":"Property-based and unit tests for codec module.\n\n## Property tests\n\n### Roundtrip\n- `test_codec_roundtrip` - encode then decode equals original\n- `test_encoder_decoder_roundtrip` - for primitive types\n\n### Size calculation\n- `test_encoded_size_accurate` - encoded_size matches actual encoding\n\n### Error handling\n- `test_invalid_magic_rejected`\n- `test_unsupported_version_rejected`\n- `test_truncated_message_rejected`\n- `test_invalid_tag_rejected`\n\n## Unit tests\n\n### Encoder\n- Test write_byte, write_int16_be, etc.\n- Test write_string with various lengths\n- Test buffer overflow detection\n\n### Decoder\n- Test read operations\n- Test remaining/is_empty\n- Test boundary conditions\n\n### Message encoding\n- Test each message type individually\n- Test packet with piggyback messages\n- Test empty piggyback list\n\n## Design constraints\n- Use QCheck for property tests\n- Use Alcotest or similar for unit tests\n- Cover all message types\n- Test error paths","acceptance_criteria":"- All property tests pass\n- All unit tests pass\n- Edge cases covered\n- Error handling tested","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-08T18:49:38.017959466+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T20:03:07.370600701+01:00","closed_at":"2026-01-08T20:03:07.370600701+01:00","close_reason":"Implemented codec property and unit tests - all 19 tests passing","labels":["codec","test"],"dependencies":[{"issue_id":"swim-l32","depends_on_id":"swim-l5y","type":"blocks","created_at":"2026-01-08T18:49:38.021527282+01:00","created_by":"gdiazlo"},{"issue_id":"swim-l32","depends_on_id":"swim-294","type":"blocks","created_at":"2026-01-08T18:49:38.02331756+01:00","created_by":"gdiazlo"},{"issue_id":"swim-l32","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:49:42.065502393+01:00","created_by":"gdiazlo"}]} 10 15 {"id":"swim-l5y","title":"Implement codec.ml - Zero-copy binary encoding/decoding","description":"Implement binary encoding/decoding with zero-copy semantics using Cstruct.\n\n## Components\n\n### Encoder module\n- `type t` with buf and mutable pos\n- `create : buf:Cstruct.t -\u003e t`\n- `write_byte`, `write_int16_be`, `write_int32_be`, `write_int64_be`\n- `write_string` (length-prefixed)\n- `write_bytes`\n- `to_cstruct` - returns view, no copy\n- `reset`, `remaining`\n\n### Decoder module\n- `type t` with buf and mutable pos\n- `create : Cstruct.t -\u003e t`\n- `read_byte`, `read_int16_be`, `read_int32_be`, `read_int64_be`\n- `read_string` - returns string (must copy for safety)\n- `read_bytes` - returns Cstruct view\n- `remaining`, `is_empty`\n\n### Codec module\n- Magic bytes: \"SWIM\"\n- Version: 1\n- Message tags: 0x01-0x07 for each message type\n- `encode_packet : packet -\u003e buf:Cstruct.t -\u003e (int, [`Buffer_too_small]) result`\n- `decode_packet : Cstruct.t -\u003e packet decode_result`\n- `encoded_size : protocol_msg -\u003e int` for queue draining\n\n### Helper encoders\n- `encode_node`, `encode_node_id`\n- `encode_option`\n- `decode_msg`\n\n## Design constraints\n- No allocations in hot path except unavoidable string creation\n- Return Result types, no exceptions\n- Use Cstruct sub-views where possible","acceptance_criteria":"- Property-based roundtrip tests pass\n- No unnecessary allocations\n- All message types encode/decode correctly\n- Error handling for truncated/invalid data","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:45:54.407900731+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:23:12.726852552+01:00","closed_at":"2026-01-08T19:23:12.726852552+01:00","close_reason":"Implemented codec.ml with Encoder/Decoder modules, zero-copy encoding/decoding for all protocol messages, IP address parsing, and encoded_size calculation","labels":["codec","core","zero-copy"],"dependencies":[{"issue_id":"swim-l5y","depends_on_id":"swim-td8","type":"blocks","created_at":"2026-01-08T18:45:54.412742463+01:00","created_by":"gdiazlo"},{"issue_id":"swim-l5y","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:45:59.779010836+01:00","created_by":"gdiazlo"}]} 11 16 {"id":"swim-oll","title":"Implement membership.ml - Kcas-based member table","description":"Implement lock-free membership state management using kcas and kcas_data.\n\n## Member module\n```ocaml\ntype t = {\n node : node_info; (* Immutable *)\n state : member_state Kcas.Loc.t;\n incarnation : incarnation Kcas.Loc.t;\n state_change_time : Mtime.span Kcas.Loc.t;\n last_ack_time : Mtime.span Kcas.Loc.t;\n}\n```\n\n### Functions\n- `create : node_info -\u003e t`\n- `node : t -\u003e node_info` (pure accessor)\n- `get_state`, `get_incarnation`, `get_last_ack` (kcas reads)\n- `set_alive`, `set_suspect`, `set_dead` with `~xt:Kcas.Xt.t`\n- `record_ack : t -\u003e now:Mtime.span -\u003e xt:Kcas.Xt.t -\u003e unit`\n- `snapshot : t -\u003e xt:Kcas.Xt.t -\u003e member_snapshot`\n\n## Membership module\n```ocaml\ntype t = {\n table : (string, Member.t) Kcas_data.Hashtbl.t;\n count : int Kcas.Loc.t;\n}\n```\n\n### Functions\n- `create : unit -\u003e t`\n- `add : t -\u003e Member.t -\u003e unit`\n- `remove : t -\u003e node_id -\u003e unit` (returns bool for success)\n- `find : t -\u003e node_id -\u003e Member.t option`\n- `mem : t -\u003e node_id -\u003e bool`\n- `to_list : t -\u003e Member.t list` (snapshot)\n- `count : t -\u003e int`\n- `update_member : t -\u003e node_id -\u003e (Member.t -\u003e xt:Kcas.Xt.t -\u003e unit) -\u003e bool`\n\n## Design constraints\n- All state via kcas locations\n- Use Kcas_data.Hashtbl for lock-free hashtable\n- Transactional updates via Kcas.Xt.commit\n- No I/O inside transactions\n- Short transactions only","acceptance_criteria":"- Lock-free operations work correctly\n- Concurrent access safe\n- Atomic state transitions\n- Snapshot consistency","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:47:11.022624275+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:33:07.449792483+01:00","closed_at":"2026-01-08T19:33:07.449792483+01:00","close_reason":"Implemented Member module with kcas locations and Membership table with Kcas_data.Hashtbl","labels":["core","kcas","membership"],"dependencies":[{"issue_id":"swim-oll","depends_on_id":"swim-td8","type":"blocks","created_at":"2026-01-08T18:47:11.047048045+01:00","created_by":"gdiazlo"},{"issue_id":"swim-oll","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:47:20.00544253+01:00","created_by":"gdiazlo"}]} 12 17 {"id":"swim-oun","title":"Project setup: dune-project, opam, dependencies","description":"Set up the project structure and dependencies for the SWIM library.\n\n## Tasks\n1. Update dune-project with proper metadata and dependencies\n2. Configure swim.opam with all required dependencies:\n - eio (\u003e= 1.0)\n - kcas (\u003e= 0.7)\n - kcas_data (\u003e= 0.7)\n - mirage-crypto\n - mirage-crypto-rng\n - cstruct\n - qcheck (for testing)\n3. Create lib/dune with proper library configuration\n4. Create test/dune for test configuration\n5. Create bench/dune for benchmarks (optional initially)\n6. Verify project builds with `dune build`","acceptance_criteria":"- dune build succeeds\n- opam install . --deps-only works\n- All dependencies available","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:45:16.711747605+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:13:17.972217465+01:00","closed_at":"2026-01-08T19:13:17.972217465+01:00","close_reason":"Project setup complete: dune-project, lib/dune, test/dune configured. Build and tests pass.","labels":["infrastructure","setup"],"dependencies":[{"issue_id":"swim-oun","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:45:20.330948173+01:00","created_by":"gdiazlo"}]} 13 13 - {"id":"swim-szx","title":"Implement kcas data structure tests (test/test_kcas.ml)","description":"Concurrent correctness tests for kcas-based data structures.\n\n## Buffer_pool tests\n- `test_buffer_pool_no_leaks` - all acquired buffers released\n- `test_buffer_pool_concurrent` - multiple fibers acquiring/releasing\n- `test_with_buffer_exception_safe` - buffer released on exception\n\n## Membership tests\n- `test_membership_concurrent_add_remove` - no lost updates\n- `test_membership_snapshot_consistency` - to_list is consistent\n- `test_membership_count_accurate` - count matches actual\n\n## Broadcast_queue tests\n- `test_broadcast_queue_fifo` - messages dequeued in order\n- `test_broadcast_queue_transmit_counting` - transmits decremented correctly\n- `test_broadcast_queue_invalidation` - old messages pruned\n- `test_broadcast_queue_concurrent` - concurrent enqueue/drain safe\n\n## Pending_acks tests\n- `test_pending_acks_complete` - ack resolves waiter\n- `test_pending_acks_timeout` - timeout returns None\n- `test_pending_acks_cancel` - cancel removes waiter\n- `test_pending_acks_concurrent` - multiple pending acks\n\n## Transactional tests\n- `test_atomic_member_update` - multi-location update is atomic\n- `test_transaction_retry` - conflicting transactions retry\n\n## Design constraints\n- Use Eio for concurrency\n- Test with multiple domains if possible\n- Verify linearizability properties","acceptance_criteria":"- All concurrent tests pass\n- No race conditions\n- Atomicity verified\n- Stress tests pass","status":"open","priority":2,"issue_type":"task","created_at":"2026-01-08T18:50:25.944980162+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T18:50:25.944980162+01:00","labels":["concurrency","kcas","test"],"dependencies":[{"issue_id":"swim-szx","depends_on_id":"swim-xoo","type":"blocks","created_at":"2026-01-08T18:50:25.94903667+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-oll","type":"blocks","created_at":"2026-01-08T18:50:25.950569487+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-iwg","type":"blocks","created_at":"2026-01-08T18:50:25.951465481+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-etm","type":"blocks","created_at":"2026-01-08T18:50:25.952262505+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:50:30.713954321+01:00","created_by":"gdiazlo"}]} 18 18 + {"id":"swim-szx","title":"Implement kcas data structure tests (test/test_kcas.ml)","description":"Concurrent correctness tests for kcas-based data structures.\n\n## Buffer_pool tests\n- `test_buffer_pool_no_leaks` - all acquired buffers released\n- `test_buffer_pool_concurrent` - multiple fibers acquiring/releasing\n- `test_with_buffer_exception_safe` - buffer released on exception\n\n## Membership tests\n- `test_membership_concurrent_add_remove` - no lost updates\n- `test_membership_snapshot_consistency` - to_list is consistent\n- `test_membership_count_accurate` - count matches actual\n\n## Broadcast_queue tests\n- `test_broadcast_queue_fifo` - messages dequeued in order\n- `test_broadcast_queue_transmit_counting` - transmits decremented correctly\n- `test_broadcast_queue_invalidation` - old messages pruned\n- `test_broadcast_queue_concurrent` - concurrent enqueue/drain safe\n\n## Pending_acks tests\n- `test_pending_acks_complete` - ack resolves waiter\n- `test_pending_acks_timeout` - timeout returns None\n- `test_pending_acks_cancel` - cancel removes waiter\n- `test_pending_acks_concurrent` - multiple pending acks\n\n## Transactional tests\n- `test_atomic_member_update` - multi-location update is atomic\n- `test_transaction_retry` - conflicting transactions retry\n\n## Design constraints\n- Use Eio for concurrency\n- Test with multiple domains if possible\n- Verify linearizability properties","acceptance_criteria":"- All concurrent tests pass\n- No race conditions\n- Atomicity verified\n- Stress tests pass","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-08T18:50:25.944980162+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T20:37:32.85250403+01:00","closed_at":"2026-01-08T20:37:32.85250403+01:00","close_reason":"Implemented kcas data structure tests - 15 tests for buffer_pool, membership, pending_acks, and member transitions","labels":["concurrency","kcas","test"],"dependencies":[{"issue_id":"swim-szx","depends_on_id":"swim-xoo","type":"blocks","created_at":"2026-01-08T18:50:25.94903667+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-oll","type":"blocks","created_at":"2026-01-08T18:50:25.950569487+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-iwg","type":"blocks","created_at":"2026-01-08T18:50:25.951465481+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-etm","type":"blocks","created_at":"2026-01-08T18:50:25.952262505+01:00","created_by":"gdiazlo"},{"issue_id":"swim-szx","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:50:30.713954321+01:00","created_by":"gdiazlo"}]} 14 19 {"id":"swim-t28","title":"Implement protocol.ml - Main protocol loop and handlers","description":"Implement the effectful protocol runner that applies pure transitions.\n\n## Main Cluster Type\n```ocaml\ntype t = {\n config : config;\n env : env;\n self : node;\n members : Membership.t;\n incarnation : int Kcas.Loc.t;\n sequence : int Kcas.Loc.t;\n broadcast_queue : Broadcast_queue.t;\n pending_acks : Pending_acks.t;\n probe_index : int Kcas.Loc.t;\n send_pool : Buffer_pool.t;\n recv_pool : Buffer_pool.t;\n udp_sock : Eio.Net.datagram_socket;\n tcp_listener : Eio.Net.listening_socket;\n event_stream : node_event Eio.Stream.t;\n handlers : (node -\u003e string -\u003e string -\u003e unit) list Kcas.Loc.t;\n cipher_key : Mirage_crypto.Cipher_block.AES.GCM.key;\n stats : stats Kcas.Loc.t;\n shutdown : bool Kcas.Loc.t;\n}\n```\n\n## Protocol Loop\n- `run_protocol : t -\u003e unit`\n - Main loop: probe cycle, timing, check shutdown\n - Use Protocol_pure for state transitions\n\n- `probe_cycle : t -\u003e Member.t -\u003e unit`\n - Get sequence number\n - Drain piggyback messages\n - Send ping\n - Wait for ack with timeout\n - On timeout: indirect probe\n\n- `indirect_probe : t -\u003e Member.t -\u003e seq:int -\u003e now:Mtime.span -\u003e unit`\n - Select k random members\n - Send ping_req through them\n - Wait for any ack\n\n## Receive Loop\n- `run_udp_receiver : t -\u003e unit`\n - Acquire buffer from pool\n - Receive packet\n - Fork fiber for processing\n - Release buffer after processing\n\n- `handle_udp_packet : t -\u003e buf:Cstruct.t -\u003e addr:Eio.Net.Sockaddr.datagram -\u003e unit`\n - Decrypt\n - Decode\n - Dispatch to handler\n\n## Message Handlers\n- `handle_packet : t -\u003e addr:Eio.Net.Sockaddr.datagram -\u003e packet -\u003e unit`\n- `handle_ping : t -\u003e Ping.t -\u003e unit`\n- `handle_ping_req : t -\u003e Ping_req.t -\u003e unit`\n- `handle_ack : t -\u003e Ack.t -\u003e unit`\n- `handle_alive : t -\u003e Alive.t -\u003e unit`\n- `handle_suspect : t -\u003e Suspect.t -\u003e unit`\n- `handle_dead : t -\u003e Dead.t -\u003e unit`\n- `handle_user_msg : t -\u003e User_msg.t -\u003e unit`\n\n## Design constraints\n- Thin effectful wrapper over Protocol_pure\n- Use kcas for all state\n- Buffer pool for zero-copy I/O\n- Fork fibers for concurrent handling","acceptance_criteria":"- Protocol loop runs correctly\n- Probe cycles at configured interval\n- All message types handled\n- Stats updated accurately","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:48:36.304687885+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:53:04.782054511+01:00","closed_at":"2026-01-08T19:53:04.782054511+01:00","close_reason":"Implemented main protocol loop with all message handlers, probe cycles, indirect probing, UDP receiver, and cluster state management","labels":["core","eio","protocol"],"dependencies":[{"issue_id":"swim-t28","depends_on_id":"swim-td8","type":"blocks","created_at":"2026-01-08T18:48:36.308642743+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-l5y","type":"blocks","created_at":"2026-01-08T18:48:36.310137809+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-hc9","type":"blocks","created_at":"2026-01-08T18:48:36.310988083+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-xoo","type":"blocks","created_at":"2026-01-08T18:48:36.311690387+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-fac","type":"blocks","created_at":"2026-01-08T18:48:36.3123488+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-oll","type":"blocks","created_at":"2026-01-08T18:48:36.313012122+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-iwg","type":"blocks","created_at":"2026-01-08T18:48:36.313695305+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-etm","type":"blocks","created_at":"2026-01-08T18:48:36.314462189+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-90e","type":"blocks","created_at":"2026-01-08T18:48:36.315296073+01:00","created_by":"gdiazlo"},{"issue_id":"swim-t28","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:48:48.416247923+01:00","created_by":"gdiazlo"}]} 15 20 {"id":"swim-td8","title":"Implement types.ml - Immutable message and node types","description":"Create the core immutable types for the SWIM protocol.\n\n## Types to implement\n\n### Node identification\n- `node_id = Node_id of string [@@unboxed]`\n- `incarnation = Incarnation of int [@@unboxed]`\n\n### Node information\n- `node_info` record with id, addr (Eio.Net.Sockaddr.datagram), meta\n\n### Member state\n- `member_state = Alive | Suspect | Dead`\n- `member_snapshot` record for pure operations\n\n### Protocol messages (pattern-matchable variants)\n- `Ping of { seq; sender }`\n- `Ping_req of { seq; target; sender }`\n- `Ack of { seq; responder; payload }`\n- `Alive of { node; incarnation }`\n- `Suspect of { node; incarnation; suspector }`\n- `Dead of { node; incarnation; declarator }`\n- `User_msg of { topic; payload; origin }`\n\n### Packet structure\n- `packet = { cluster; primary; piggyback }`\n\n### Error types\n- `decode_error` variants\n- `send_error` variants\n\n### Configuration\n- `config` record with all SWIM parameters\n- `default_config` value\n\n### Environment\n- `env` record with Eio dependencies (net, clock, mono_clock, random, sw)\n\n## Design constraints\n- All types immutable\n- Use [@@unboxed] where appropriate for performance\n- Pattern-matchable variants for protocol messages","acceptance_criteria":"- All types defined with proper signatures in types.mli\n- Types compile with dune build\n- No mutable fields except where kcas will manage them","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:45:34.790084068+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:16:46.941262108+01:00","closed_at":"2026-01-08T19:16:46.941262108+01:00","close_reason":"Implemented types.ml and types.mli with all core types: node_id, incarnation, node_info, member_state, protocol_msg, packet, decode_error, send_error, node_event, config, env, stats","labels":["core","types"],"dependencies":[{"issue_id":"swim-td8","depends_on_id":"swim-oun","type":"blocks","created_at":"2026-01-08T18:45:34.794012265+01:00","created_by":"gdiazlo"},{"issue_id":"swim-td8","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:45:39.489609655+01:00","created_by":"gdiazlo"}]} 16 21 {"id":"swim-w4y","title":"Implement protocol_pure tests (test/test_pure.ml)","description":"Property-based tests for pure SWIM logic.\n\n## State transition properties\n\n### Incarnation ordering\n- `test_alive_dominates_suspect` - Alive with \u003e= incarnation beats Suspect\n- `test_higher_incarnation_wins` - Higher incarnation always dominates\n- `test_dead_is_final` - Dead state cannot be overridden\n\n### Message invalidation\n- `test_invalidation_transitive` - if A invalidates B and B invalidates C, A invalidates C\n- `test_alive_invalidates_suspect` - for same node with \u003e= incarnation\n- `test_dead_invalidates_all` - Dead invalidates Alive and Suspect for same node\n\n### Merge properties\n- `test_merge_commutative` - merge(a, b) = merge(b, a)\n- `test_merge_idempotent` - merge(a, a) = a\n- `test_merge_respects_incarnation` - higher incarnation wins\n\n### Timeout calculation\n- `test_suspicion_timeout_increases_with_nodes` - more nodes = longer timeout\n- `test_suspicion_timeout_bounded` - never exceeds max\n\n### Probe target selection\n- `test_probe_wraps_around` - index wraps at list end\n- `test_probe_skips_self` - self is never selected\n\n## Unit tests\n- Test specific transition scenarios\n- Test edge cases (empty member list, incarnation 0, etc.)\n\n## Design constraints\n- All tests on pure functions\n- No I/O or effects in tests\n- Comprehensive property coverage","acceptance_criteria":"- All SWIM invariants tested\n- Properties match SWIM paper\n- Edge cases covered\n- All tests pass","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-08T18:50:08.398465616+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T20:08:47.505087764+01:00","closed_at":"2026-01-08T20:08:47.505087764+01:00","close_reason":"Implemented protocol_pure property and unit tests - all 32 tests passing","labels":["protocol","pure","test"],"dependencies":[{"issue_id":"swim-w4y","depends_on_id":"swim-fac","type":"blocks","created_at":"2026-01-08T18:50:08.402396924+01:00","created_by":"gdiazlo"},{"issue_id":"swim-w4y","depends_on_id":"swim-294","type":"blocks","created_at":"2026-01-08T18:50:08.40380169+01:00","created_by":"gdiazlo"},{"issue_id":"swim-w4y","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:50:13.114782761+01:00","created_by":"gdiazlo"}]} 17 22 {"id":"swim-wdc","title":"SWIM Protocol Library Implementation","description":"Production-ready SWIM (Scalable Weakly-consistent Infection-style Process Group Membership) protocol library in OCaml 5 for cluster membership, failure detection, and lightweight pub/sub messaging.\n\n## Core Design Principles\n- Pure functions by default, separate pure logic from effectful operations\n- Immutable data structures, mutations only through kcas\n- Zero-copy buffer management with buffer pools\n- Lock-free coordination via kcas/kcas_data\n- AES-256-GCM encryption\n\n## Dependencies (allowed)\n- eio (\u003e= 1.0), kcas (\u003e= 0.7), kcas_data (\u003e= 0.7)\n- mirage-crypto, mirage-crypto-rng, cstruct\n\n## Target Scale\n- Up to 100 nodes\n- Sub-second failure detection\n- Optimized for datacenter/cloud environments","acceptance_criteria":"- All 11 core modules implemented\n- Property-based tests for pure functions\n- Integration tests passing\n- Build and opam package working\n- Performance targets met (\u003c 5 allocations/probe, \u003e 95% buffer reuse)","status":"open","priority":1,"issue_type":"epic","created_at":"2026-01-08T18:45:08.49485159+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T18:45:08.49485159+01:00","labels":["epic","ocaml5","swim"]} 18 18 - {"id":"swim-wwr","title":"Implement integration tests (test/test_integration.ml)","description":"End-to-end integration tests for the SWIM library.\n\n## Two-node tests\n- `test_two_node_join` - node2 joins node1, both see each other\n- `test_two_node_leave` - graceful leave propagates\n- `test_two_node_broadcast` - broadcast message received\n- `test_two_node_direct_send` - direct TCP message delivered\n\n## Three-node tests\n- `test_gossip_propagation` - message reaches all nodes\n- `test_indirect_probe` - indirect probe detects alive node\n- `test_failure_detection` - dead node detected and removed\n\n## Failure scenarios\n- `test_network_partition` - nodes handle partition\n- `test_node_crash` - crashed node detected as dead\n- `test_rejoin_after_crash` - node can rejoin after restart\n\n## Metadata tests\n- `test_metadata_propagation` - metadata updates reach all nodes\n- `test_metadata_update` - updated metadata replaces old\n\n## Event stream tests\n- `test_join_event_fired` - Join event on new member\n- `test_leave_event_fired` - Leave event on departure\n- `test_suspect_event_fired` - Suspect event on probe timeout\n\n## Performance tests\n- `test_convergence_time` - cluster converges within expected time\n- `test_message_throughput` - broadcast rate meets target\n\n## Design constraints\n- Use Eio_main.run for all tests\n- Proper cleanup with shutdown\n- Realistic timing (but accelerated)\n- Isolated network per test","acceptance_criteria":"- All integration tests pass\n- Failure scenarios handled\n- Performance targets met\n- Clean teardown","status":"open","priority":2,"issue_type":"task","created_at":"2026-01-08T18:50:43.333077327+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T18:50:43.333077327+01:00","labels":["integration","test"],"dependencies":[{"issue_id":"swim-wwr","depends_on_id":"swim-zsi","type":"blocks","created_at":"2026-01-08T18:50:43.337480017+01:00","created_by":"gdiazlo"},{"issue_id":"swim-wwr","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:50:46.783801496+01:00","created_by":"gdiazlo"}]} 23 23 + {"id":"swim-wwr","title":"Implement integration tests (test/test_integration.ml)","description":"End-to-end integration tests for the SWIM library.\n\n## Two-node tests\n- `test_two_node_join` - node2 joins node1, both see each other\n- `test_two_node_leave` - graceful leave propagates\n- `test_two_node_broadcast` - broadcast message received\n- `test_two_node_direct_send` - direct TCP message delivered\n\n## Three-node tests\n- `test_gossip_propagation` - message reaches all nodes\n- `test_indirect_probe` - indirect probe detects alive node\n- `test_failure_detection` - dead node detected and removed\n\n## Failure scenarios\n- `test_network_partition` - nodes handle partition\n- `test_node_crash` - crashed node detected as dead\n- `test_rejoin_after_crash` - node can rejoin after restart\n\n## Metadata tests\n- `test_metadata_propagation` - metadata updates reach all nodes\n- `test_metadata_update` - updated metadata replaces old\n\n## Event stream tests\n- `test_join_event_fired` - Join event on new member\n- `test_leave_event_fired` - Leave event on departure\n- `test_suspect_event_fired` - Suspect event on probe timeout\n\n## Performance tests\n- `test_convergence_time` - cluster converges within expected time\n- `test_message_throughput` - broadcast rate meets target\n\n## Design constraints\n- Use Eio_main.run for all tests\n- Proper cleanup with shutdown\n- Realistic timing (but accelerated)\n- Isolated network per test","acceptance_criteria":"- All integration tests pass\n- Failure scenarios handled\n- Performance targets met\n- Clean teardown","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-08T18:50:43.333077327+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T20:43:29.225508468+01:00","closed_at":"2026-01-08T20:43:29.225508468+01:00","close_reason":"Integration and kcas tests complete, 89 tests total passing","labels":["integration","test"],"dependencies":[{"issue_id":"swim-wwr","depends_on_id":"swim-zsi","type":"blocks","created_at":"2026-01-08T18:50:43.337480017+01:00","created_by":"gdiazlo"},{"issue_id":"swim-wwr","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:50:46.783801496+01:00","created_by":"gdiazlo"}]} 19 24 {"id":"swim-xoo","title":"Implement buffer_pool.ml - Buffer management with kcas_data","description":"Implement buffer pool for zero-copy network I/O.\n\n## Buffer_pool module\n\n### Type\n```ocaml\ntype t = {\n buffers : Cstruct.t Kcas_data.Queue.t;\n size : int;\n total : int;\n semaphore : Eio.Semaphore.t;\n}\n```\n\n### Functions\n- `create : size:int -\u003e count:int -\u003e t`\n - Pre-allocate `count` buffers of `size` bytes\n - Use Kcas_data.Queue for lock-free storage\n - Eio.Semaphore for blocking acquire\n\n- `acquire : t -\u003e Cstruct.t`\n - Block on semaphore if no buffers\n - Pop from queue\n - Reset buffer (memset 0) before returning\n\n- `try_acquire : t -\u003e Cstruct.t option`\n - Non-blocking acquire\n - Return None if no buffers available\n\n- `release : t -\u003e Cstruct.t -\u003e unit`\n - Push buffer back to queue\n - Release semaphore\n\n- `with_buffer : t -\u003e (Cstruct.t -\u003e 'a) -\u003e 'a`\n - RAII-style acquire/release\n - Use Fun.protect for exception safety\n\n- `available : t -\u003e int` - current available count\n- `total : t -\u003e int` - total pool size\n\n## Design constraints\n- Lock-free queue via kcas_data\n- Semaphore for blocking (only blocking allowed per spec)\n- Clear buffer ownership semantics\n- No memory leaks on exceptions","acceptance_criteria":"- Buffers properly recycled\n- No leaks under concurrent use\n- with_buffer is exception-safe\n- Stats accurate","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:46:28.146790073+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:27:29.348943322+01:00","closed_at":"2026-01-08T19:27:29.348943322+01:00","close_reason":"Implemented buffer_pool.ml with Kcas_data.Queue and Eio.Semaphore","labels":["buffer","core","zero-copy"],"dependencies":[{"issue_id":"swim-xoo","depends_on_id":"swim-oun","type":"blocks","created_at":"2026-01-08T18:46:28.151030562+01:00","created_by":"gdiazlo"},{"issue_id":"swim-xoo","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:46:32.927877844+01:00","created_by":"gdiazlo"}]} 20 25 {"id":"swim-zsi","title":"Implement swim.ml/swim.mli - Public API assembly","description":"Implement the public API as specified in swim.mli.\n\n## Cluster module (public interface)\n\n### Lifecycle\n- `create : env -\u003e config -\u003e (t, [\u003e `Invalid_key | `Bind_failed of string]) result`\n - Initialize crypto\n - Create buffer pools\n - Bind sockets\n - Start protocol and receiver fibers\n\n- `join : t -\u003e seed_nodes:string list -\u003e (unit, [\u003e `No_seeds_reachable]) result`\n - Parse seed addresses\n - Send join requests\n - Wait for acks\n\n- `leave : t -\u003e ?timeout:float -\u003e unit -\u003e unit`\n - Broadcast leave\n - Wait for propagation\n - Graceful shutdown\n\n- `shutdown : t -\u003e unit`\n - Set shutdown flag\n - Close sockets\n - Release resources\n\n### Membership queries (pure)\n- `local_node : t -\u003e node`\n- `nodes : t -\u003e node list`\n- `node_count : t -\u003e int`\n- `is_alive : t -\u003e node_id -\u003e bool`\n- `find_node : t -\u003e node_id -\u003e node option`\n\n### Events\n- `events : t -\u003e node_event Eio.Stream.t`\n\n### Metadata\n- `set_meta : t -\u003e string -\u003e (unit, [\u003e `Too_large]) result`\n\n### Msg submodule\n- `broadcast : t -\u003e topic:string -\u003e payload:string -\u003e (unit, [\u003e `Too_large]) result`\n- `send : t -\u003e node -\u003e payload:string -\u003e (unit, [\u003e `Unreachable | `Timeout]) result`\n- `on_message : t -\u003e handler -\u003e unit`\n- `on_topic : t -\u003e string -\u003e (node -\u003e string -\u003e unit) -\u003e unit`\n\n### Health submodule\n- `stats : t -\u003e stats`\n- `is_healthy : t -\u003e bool`\n\n## Design constraints\n- All operations fiber-safe\n- No blocking except Eio primitives\n- Result types for fallible operations\n- Clean module signature in .mli","acceptance_criteria":"- Public API matches spec\n- All operations work correctly\n- Clean .mli signature\n- Documentation comments","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-08T18:49:05.567892446+01:00","created_by":"gdiazlo","updated_at":"2026-01-08T19:54:05.541094079+01:00","closed_at":"2026-01-08T19:54:05.541094079+01:00","close_reason":"Implemented Cluster module as public API with create, start, shutdown, join, broadcast, member queries, and event streaming","labels":["api","core"],"dependencies":[{"issue_id":"swim-zsi","depends_on_id":"swim-t28","type":"blocks","created_at":"2026-01-08T18:49:05.571629003+01:00","created_by":"gdiazlo"},{"issue_id":"swim-zsi","depends_on_id":"swim-wdc","type":"parent-child","created_at":"2026-01-08T18:49:09.915596516+01:00","created_by":"gdiazlo"}]}

+5

.gitignore

··· 1 1 _build/ 2 2 *.install 3 3 .merlin 4 4 + .idea/ 5 5 + 6 6 + # Compiled binaries 7 7 + interop/memberlist-server 8 8 + interop/debug/debug_sender

-40

AGENTS.md

··· 1 1 - # Agent Instructions 2 2 - 3 3 - This project uses **bd** (beads) for issue tracking. Run `bd onboard` to get started. 4 4 - 5 5 - ## Quick Reference 6 6 - 7 7 - ```bash 8 8 - bd ready # Find available work 9 9 - bd show <id> # View issue details 10 10 - bd update <id> --status in_progress # Claim work 11 11 - bd close <id> # Complete work 12 12 - bd sync # Sync with git 13 13 - ``` 14 14 - 15 15 - ## Landing the Plane (Session Completion) 16 16 - 17 17 - **When ending a work session**, you MUST complete ALL steps below. Work is NOT complete until `git push` succeeds. 18 18 - 19 19 - **MANDATORY WORKFLOW:** 20 20 - 21 21 - 1. **File issues for remaining work** - Create issues for anything that needs follow-up 22 22 - 2. **Run quality gates** (if code changed) - Tests, linters, builds 23 23 - 3. **Update issue status** - Close finished work, update in-progress items 24 24 - 4. **PUSH TO REMOTE** - This is MANDATORY: 25 25 - ```bash 26 26 - git pull --rebase 27 27 - bd sync 28 28 - git push 29 29 - git status # MUST show "up to date with origin" 30 30 - ``` 31 31 - 5. **Clean up** - Clear stashes, prune remote branches 32 32 - 6. **Verify** - All changes committed AND pushed 33 33 - 7. **Hand off** - Provide context for next session 34 34 - 35 35 - **CRITICAL RULES:** 36 36 - - Work is NOT complete until `git push` succeeds 37 37 - - NEVER stop before pushing - that leaves work stranded locally 38 38 - - NEVER say "ready to push when you are" - YOU must push 39 39 - - If push fails, resolve and retry until it succeeds 40 40 -

+177

README.md

··· 1 1 + # swim 2 2 + 3 3 + An OCaml 5 implementation of the SWIM (Scalable Weakly-consistent Infection-style Process Group Membership) protocol for cluster membership and failure detection. 4 4 + 5 5 + ## Overview 6 6 + 7 7 + This library provides: 8 8 + 9 9 + - **Membership Management**: Automatic discovery and tracking of cluster nodes 10 10 + - **Failure Detection**: Identifies unreachable nodes using periodic probes and indirect checks 11 11 + - **Gossip Protocol**: Propagates state changes (Alive/Suspect/Dead) across the cluster 12 12 + - **Messaging**: Cluster-wide broadcast (gossip-based) and direct point-to-point UDP messaging 13 13 + - **Encryption**: Optional AES-256-GCM encryption for all network traffic 14 14 + 15 15 + Built on [Eio](https://github.com/ocaml-multicore/eio) for effect-based concurrency and [Kcas](https://github.com/ocaml-multicore/kcas) for lock-free shared state. 16 16 + 17 17 + ## Requirements 18 18 + 19 19 + - OCaml >= 5.1 20 20 + - Dune >= 3.20 21 21 + 22 22 + ## Installation 23 23 + 24 24 + ```bash 25 25 + opam install . 26 26 + ``` 27 27 + 28 28 + Or add to your dune-project: 29 29 + 30 30 + ``` 31 31 + (depends (swim (>= 0.1.0))) 32 32 + ``` 33 33 + 34 34 + ## Usage 35 35 + 36 36 + ### Basic Example 37 37 + 38 38 + ```ocaml 39 39 + open Swim.Types 40 40 + 41 41 + let config = { 42 42 + default_config with 43 43 + bind_port = 7946; 44 44 + node_name = Some "node-1"; 45 45 + secret_key = "your-32-byte-secret-key-here!!!"; (* 32 bytes for AES-256 *) 46 46 + encryption_enabled = true; 47 47 + } 48 48 + 49 49 + let () = 50 50 + Eio_main.run @@ fun env -> 51 51 + Eio.Switch.run @@ fun sw -> 52 52 + let env_wrap = { stdenv = env; sw } in 53 53 + match Swim.Cluster.create ~sw ~env:env_wrap ~config with 54 54 + | Error `Invalid_key -> failwith "Invalid secret key" 55 55 + | Ok cluster -> 56 56 + Swim.Cluster.start cluster; 57 57 + 58 58 + (* Join an existing cluster *) 59 59 + let seed_nodes = ["192.168.1.10:7946"] in 60 60 + (match Swim.Cluster.join cluster ~seed_nodes with 61 61 + | Ok () -> Printf.printf "Joined cluster\n" 62 62 + | Error `No_seeds_reachable -> Printf.printf "Failed to join\n"); 63 63 + 64 64 + (* Send a broadcast message to all nodes *) 65 65 + Swim.Cluster.broadcast cluster ~topic:"config" ~payload:"v2"; 66 66 + 67 67 + (* Send a direct message to a specific node *) 68 68 + let target = node_id_of_string "node-2" in 69 69 + Swim.Cluster.send cluster ~target ~topic:"ping" ~payload:"hello"; 70 70 + 71 71 + (* Handle incoming messages *) 72 72 + Swim.Cluster.on_message cluster (fun sender topic payload -> 73 73 + Printf.printf "From %s: [%s] %s\n" 74 74 + (node_id_to_string sender.id) topic payload); 75 75 + 76 76 + (* Listen for membership events *) 77 77 + Eio.Fiber.fork ~sw (fun () -> 78 78 + let stream = Swim.Cluster.events cluster in 79 79 + while true do 80 80 + match Eio.Stream.take stream with 81 81 + | Join node -> Printf.printf "Joined: %s\n" (node_id_to_string node.id) 82 82 + | Leave node -> Printf.printf "Left: %s\n" (node_id_to_string node.id) 83 83 + | Suspect_event node -> Printf.printf "Suspect: %s\n" (node_id_to_string node.id) 84 84 + | Alive_event node -> Printf.printf "Alive: %s\n" (node_id_to_string node.id) 85 85 + | Update _ -> () 86 86 + done); 87 87 + 88 88 + Eio.Fiber.await_cancel () 89 89 + ``` 90 90 + 91 91 + ### Configuration Options 92 92 + 93 93 + | Field | Default | Description | 94 94 + |-------|---------|-------------| 95 95 + | `bind_addr` | "0.0.0.0" | Interface to bind listeners | 96 96 + | `bind_port` | 7946 | Port for SWIM protocol | 97 97 + | `protocol_interval` | 1.0 | Seconds between probe rounds | 98 98 + | `probe_timeout` | 0.5 | Seconds to wait for Ack | 99 99 + | `indirect_checks` | 3 | Peers to ask for indirect probes | 100 100 + | `secret_key` | (zeros) | 32-byte key for AES-256-GCM | 101 101 + | `encryption_enabled` | false | Enable encryption | 102 102 + 103 103 + ## Interoperability Testing 104 104 + 105 105 + The library includes interoperability tests with HashiCorp's [memberlist](https://github.com/hashicorp/memberlist) (Go). This verifies protocol compatibility with the reference implementation. 106 106 + 107 107 + ### Prerequisites 108 108 + 109 109 + - Go >= 1.19 110 110 + - OCaml environment with dune 111 111 + 112 112 + ### Running Interop Tests 113 113 + 114 114 + The interop test suite starts a Go memberlist node and an OCaml node, then verifies they can discover each other and exchange messages. 115 115 + 116 116 + ```bash 117 117 + # Build the OCaml project 118 118 + dune build 119 119 + 120 120 + # Build the Go memberlist server 121 121 + cd interop && go build -o memberlist-server main.go && cd .. 122 122 + 123 123 + # Run the interop test 124 124 + bash test/scripts/test_interop.sh 125 125 + 126 126 + # Run with encryption enabled 127 127 + bash test/scripts/test_interop_encrypted.sh 128 128 + ``` 129 129 + 130 130 + ### Manual Interop Testing 131 131 + 132 132 + Start the Go node: 133 133 + 134 134 + ```bash 135 135 + cd interop 136 136 + go run main.go -name go-node -bind 127.0.0.1 -port 7946 137 137 + ``` 138 138 + 139 139 + In another terminal, start the OCaml node: 140 140 + 141 141 + ```bash 142 142 + dune exec swim-interop-test 143 143 + ``` 144 144 + 145 145 + The OCaml node will connect to the Go node and print membership statistics for 30 seconds. 146 146 + 147 147 + ### Available Test Scripts 148 148 + 149 149 + | Script | Description | 150 150 + |--------|-------------| 151 151 + | `test/scripts/test_interop.sh` | Basic interop test | 152 152 + | `test/scripts/test_interop_encrypted.sh` | Interop with AES encryption | 153 153 + | `test/scripts/test_interop_udp_only.sh` | UDP-only communication test | 154 154 + | `test/scripts/test_interop_go_joins.sh` | Go node joining OCaml cluster | 155 155 + 156 156 + ### Debug Utilities 157 157 + 158 158 + ```bash 159 159 + # Test packet encoding/decoding 160 160 + dune exec swim-debug-codec 161 161 + 162 162 + # Receive and display incoming SWIM packets 163 163 + dune exec swim-debug-recv 164 164 + 165 165 + # Send manual ping to a target node 166 166 + dune exec swim-debug-ping 167 167 + ``` 168 168 + 169 169 + ## Running Tests 170 170 + 171 171 + ```bash 172 172 + dune runtest 173 173 + ``` 174 174 + 175 175 + ## License 176 176 + 177 177 + ISC License. See [LICENSE](LICENSE) for details.

+3

bench/.gitignore

··· 1 1 + bin/ 2 2 + results/ 3 3 + go.sum

+261

bench/cmd/memberlist/main.go

··· 1 1 + package main 2 2 + 3 3 + import ( 4 4 + "encoding/json" 5 5 + "flag" 6 6 + "fmt" 7 7 + "log" 8 8 + "net" 9 9 + "os" 10 10 + "runtime" 11 11 + "sync" 12 12 + "sync/atomic" 13 13 + "time" 14 14 + 15 15 + "github.com/hashicorp/memberlist" 16 16 + ) 17 17 + 18 18 + type BenchmarkResult struct { 19 19 + Implementation string `json:"implementation"` 20 20 + NumNodes int `json:"num_nodes"` 21 21 + Duration time.Duration `json:"duration_ns"` 22 22 + MessagesReceived int64 `json:"messages_received"` 23 23 + MessagesSent int64 `json:"messages_sent"` 24 24 + ConvergenceTime time.Duration `json:"convergence_time_ns"` 25 25 + MemoryUsedBytes uint64 `json:"memory_used_bytes"` 26 26 + GoroutinesUsed int `json:"goroutines_used"` 27 27 + CPUCores int `json:"cpu_cores"` 28 28 + } 29 29 + 30 30 + type benchDelegate struct { 31 31 + received atomic.Int64 32 32 + sent atomic.Int64 33 33 + meta []byte 34 34 + } 35 35 + 36 36 + func (d *benchDelegate) NodeMeta(limit int) []byte { 37 37 + return d.meta 38 38 + } 39 39 + 40 40 + func (d *benchDelegate) NotifyMsg(msg []byte) { 41 41 + d.received.Add(1) 42 42 + } 43 43 + 44 44 + func (d *benchDelegate) GetBroadcasts(overhead, limit int) [][]byte { 45 45 + return nil 46 46 + } 47 47 + 48 48 + func (d *benchDelegate) LocalState(join bool) []byte { 49 49 + return nil 50 50 + } 51 51 + 52 52 + func (d *benchDelegate) MergeRemoteState(buf []byte, join bool) { 53 53 + } 54 54 + 55 55 + type benchEventDelegate struct { 56 56 + joinCh chan string 57 57 + mu sync.Mutex 58 58 + joined map[string]bool 59 59 + } 60 60 + 61 61 + func newBenchEventDelegate() *benchEventDelegate { 62 62 + return &benchEventDelegate{ 63 63 + joinCh: make(chan string, 1000), 64 64 + joined: make(map[string]bool), 65 65 + } 66 66 + } 67 67 + 68 68 + func (e *benchEventDelegate) NotifyJoin(node *memberlist.Node) { 69 69 + e.mu.Lock() 70 70 + if !e.joined[node.Name] { 71 71 + e.joined[node.Name] = true 72 72 + select { 73 73 + case e.joinCh <- node.Name: 74 74 + default: 75 75 + } 76 76 + } 77 77 + e.mu.Unlock() 78 78 + } 79 79 + 80 80 + func (e *benchEventDelegate) NotifyLeave(node *memberlist.Node) {} 81 81 + func (e *benchEventDelegate) NotifyUpdate(node *memberlist.Node) {} 82 82 + 83 83 + func (e *benchEventDelegate) waitForNodes(n int, timeout time.Duration) bool { 84 84 + deadline := time.Now().Add(timeout) 85 85 + for { 86 86 + e.mu.Lock() 87 87 + count := len(e.joined) 88 88 + e.mu.Unlock() 89 89 + if count >= n { 90 90 + return true 91 91 + } 92 92 + if time.Now().After(deadline) { 93 93 + return false 94 94 + } 95 95 + time.Sleep(10 * time.Millisecond) 96 96 + } 97 97 + } 98 98 + 99 99 + func createMemberlistNode(name string, port int, delegate *benchDelegate, events *benchEventDelegate) (*memberlist.Memberlist, error) { 100 100 + cfg := memberlist.DefaultLANConfig() 101 101 + cfg.Name = name 102 102 + cfg.BindAddr = "127.0.0.1" 103 103 + cfg.BindPort = port 104 104 + cfg.AdvertisePort = port 105 105 + cfg.Delegate = delegate 106 106 + cfg.Events = events 107 107 + cfg.LogOutput = os.Stderr 108 108 + cfg.GossipInterval = 100 * time.Millisecond 109 109 + cfg.ProbeInterval = 500 * time.Millisecond 110 110 + cfg.PushPullInterval = 15 * time.Second 111 111 + cfg.GossipNodes = 3 112 112 + 113 113 + return memberlist.Create(cfg) 114 114 + } 115 115 + 116 116 + func runMemberlistBenchmark(numNodes int, duration time.Duration) (*BenchmarkResult, error) { 117 117 + var memBefore runtime.MemStats 118 118 + runtime.GC() 119 119 + runtime.ReadMemStats(&memBefore) 120 120 + goroutinesBefore := runtime.NumGoroutine() 121 121 + 122 122 + nodes := make([]*memberlist.Memberlist, numNodes) 123 123 + delegates := make([]*benchDelegate, numNodes) 124 124 + eventDelegates := make([]*benchEventDelegate, numNodes) 125 125 + 126 126 + basePort := 17946 127 127 + 128 128 + for i := 0; i < numNodes; i++ { 129 129 + delegates[i] = &benchDelegate{meta: []byte(fmt.Sprintf("node-%d", i))} 130 130 + eventDelegates[i] = newBenchEventDelegate() 131 131 + 132 132 + var err error 133 133 + nodes[i], err = createMemberlistNode( 134 134 + fmt.Sprintf("node-%d", i), 135 135 + basePort+i, 136 136 + delegates[i], 137 137 + eventDelegates[i], 138 138 + ) 139 139 + if err != nil { 140 140 + for j := 0; j < i; j++ { 141 141 + nodes[j].Shutdown() 142 142 + } 143 143 + return nil, fmt.Errorf("failed to create node %d: %w", i, err) 144 144 + } 145 145 + } 146 146 + 147 147 + convergenceStart := time.Now() 148 148 + 149 149 + for i := 1; i < numNodes; i++ { 150 150 + addr := fmt.Sprintf("127.0.0.1:%d", basePort) 151 151 + _, err := nodes[i].Join([]string{addr}) 152 152 + if err != nil { 153 153 + log.Printf("Warning: node %d failed to join: %v", i, err) 154 154 + } 155 155 + } 156 156 + 157 157 + allConverged := true 158 158 + for i := 0; i < numNodes; i++ { 159 159 + if !eventDelegates[i].waitForNodes(numNodes, 30*time.Second) { 160 160 + allConverged = false 161 161 + log.Printf("Node %d did not see all %d nodes", i, numNodes) 162 162 + } 163 163 + } 164 164 + 165 165 + convergenceTime := time.Since(convergenceStart) 166 166 + if !allConverged { 167 167 + log.Printf("Warning: not all nodes converged within timeout") 168 168 + } 169 169 + 170 170 + stopBroadcast := make(chan struct{}) 171 171 + var wg sync.WaitGroup 172 172 + wg.Add(1) 173 173 + go func() { 174 174 + defer wg.Done() 175 175 + ticker := time.NewTicker(100 * time.Millisecond) 176 176 + defer ticker.Stop() 177 177 + msg := []byte("benchmark-message") 178 178 + for { 179 179 + select { 180 180 + case <-ticker.C: 181 181 + for i, n := range nodes { 182 182 + n.SendBestEffort(n.LocalNode(), msg) 183 183 + delegates[i].sent.Add(1) 184 184 + } 185 185 + case <-stopBroadcast: 186 186 + return 187 187 + } 188 188 + } 189 189 + }() 190 190 + 191 191 + time.Sleep(duration) 192 192 + close(stopBroadcast) 193 193 + wg.Wait() 194 194 + 195 195 + var memAfter runtime.MemStats 196 196 + runtime.ReadMemStats(&memAfter) 197 197 + goroutinesAfter := runtime.NumGoroutine() 198 198 + 199 199 + var totalReceived, totalSent int64 200 200 + for _, d := range delegates { 201 201 + totalReceived += d.received.Load() 202 202 + totalSent += d.sent.Load() 203 203 + } 204 204 + 205 205 + for _, n := range nodes { 206 206 + n.Shutdown() 207 207 + } 208 208 + 209 209 + return &BenchmarkResult{ 210 210 + Implementation: "memberlist", 211 211 + NumNodes: numNodes, 212 212 + Duration: duration, 213 213 + MessagesReceived: totalReceived, 214 214 + MessagesSent: totalSent, 215 215 + ConvergenceTime: convergenceTime, 216 216 + MemoryUsedBytes: memAfter.HeapAlloc - memBefore.HeapAlloc, 217 217 + GoroutinesUsed: goroutinesAfter - goroutinesBefore, 218 218 + CPUCores: runtime.NumCPU(), 219 219 + }, nil 220 220 + } 221 221 + 222 222 + func getFreePort() (int, error) { 223 223 + addr, err := net.ResolveTCPAddr("tcp", "127.0.0.1:0") 224 224 + if err != nil { 225 225 + return 0, err 226 226 + } 227 227 + l, err := net.ListenTCP("tcp", addr) 228 228 + if err != nil { 229 229 + return 0, err 230 230 + } 231 231 + defer l.Close() 232 232 + return l.Addr().(*net.TCPAddr).Port, nil 233 233 + } 234 234 + 235 235 + func main() { 236 236 + numNodes := flag.Int("nodes", 5, "number of nodes") 237 237 + durationSec := flag.Int("duration", 10, "benchmark duration in seconds") 238 238 + outputJSON := flag.Bool("json", false, "output as JSON") 239 239 + flag.Parse() 240 240 + 241 241 + result, err := runMemberlistBenchmark(*numNodes, time.Duration(*durationSec)*time.Second) 242 242 + if err != nil { 243 243 + log.Fatalf("Benchmark failed: %v", err) 244 244 + } 245 245 + 246 246 + if *outputJSON { 247 247 + enc := json.NewEncoder(os.Stdout) 248 248 + enc.SetIndent("", " ") 249 249 + enc.Encode(result) 250 250 + } else { 251 251 + fmt.Printf("=== Memberlist Benchmark Results ===\n") 252 252 + fmt.Printf("Nodes: %d\n", result.NumNodes) 253 253 + fmt.Printf("Duration: %s\n", result.Duration) 254 254 + fmt.Printf("Convergence: %s\n", result.ConvergenceTime) 255 255 + fmt.Printf("Messages Recv: %d\n", result.MessagesReceived) 256 256 + fmt.Printf("Messages Sent: %d\n", result.MessagesSent) 257 257 + fmt.Printf("Memory Used: %.2f MB\n", float64(result.MemoryUsedBytes)/1024/1024) 258 258 + fmt.Printf("Goroutines: %d\n", result.GoroutinesUsed) 259 259 + fmt.Printf("CPU Cores: %d\n", result.CPUCores) 260 260 + } 261 261 + }

+247

bench/cmd/memberlist_throughput/main.go

··· 1 1 + package main 2 2 + 3 3 + import ( 4 4 + "encoding/json" 5 5 + "flag" 6 6 + "fmt" 7 7 + "log" 8 8 + "os" 9 9 + "runtime" 10 10 + "sync" 11 11 + "sync/atomic" 12 12 + "time" 13 13 + 14 14 + "github.com/hashicorp/memberlist" 15 15 + ) 16 16 + 17 17 + type ThroughputResult struct { 18 18 + Implementation string `json:"implementation"` 19 19 + NumNodes int `json:"num_nodes"` 20 20 + DurationNs int64 `json:"duration_ns"` 21 21 + MsgRate int `json:"msg_rate"` 22 22 + BroadcastsSent int64 `json:"broadcasts_sent"` 23 23 + BroadcastsReceived int64 `json:"broadcasts_received"` 24 24 + MsgsPerSec float64 `json:"msgs_per_sec"` 25 25 + CPUCores int `json:"cpu_cores"` 26 26 + } 27 27 + 28 28 + type throughputDelegate struct { 29 29 + received atomic.Int64 30 30 + meta []byte 31 31 + } 32 32 + 33 33 + func (d *throughputDelegate) NodeMeta(limit int) []byte { 34 34 + return d.meta 35 35 + } 36 36 + 37 37 + func (d *throughputDelegate) NotifyMsg(msg []byte) { 38 38 + if len(msg) > 0 && msg[0] == 'B' { 39 39 + d.received.Add(1) 40 40 + } 41 41 + } 42 42 + 43 43 + func (d *throughputDelegate) GetBroadcasts(overhead, limit int) [][]byte { 44 44 + return nil 45 45 + } 46 46 + 47 47 + func (d *throughputDelegate) LocalState(join bool) []byte { 48 48 + return nil 49 49 + } 50 50 + 51 51 + func (d *throughputDelegate) MergeRemoteState(buf []byte, join bool) { 52 52 + } 53 53 + 54 54 + type throughputEventDelegate struct { 55 55 + joinCh chan string 56 56 + mu sync.Mutex 57 57 + joined map[string]bool 58 58 + } 59 59 + 60 60 + func newThroughputEventDelegate() *throughputEventDelegate { 61 61 + return &throughputEventDelegate{ 62 62 + joinCh: make(chan string, 1000), 63 63 + joined: make(map[string]bool), 64 64 + } 65 65 + } 66 66 + 67 67 + func (e *throughputEventDelegate) NotifyJoin(node *memberlist.Node) { 68 68 + e.mu.Lock() 69 69 + if !e.joined[node.Name] { 70 70 + e.joined[node.Name] = true 71 71 + select { 72 72 + case e.joinCh <- node.Name: 73 73 + default: 74 74 + } 75 75 + } 76 76 + e.mu.Unlock() 77 77 + } 78 78 + 79 79 + func (e *throughputEventDelegate) NotifyLeave(node *memberlist.Node) {} 80 80 + func (e *throughputEventDelegate) NotifyUpdate(node *memberlist.Node) {} 81 81 + 82 82 + func (e *throughputEventDelegate) waitForNodes(n int, timeout time.Duration) bool { 83 83 + deadline := time.Now().Add(timeout) 84 84 + for { 85 85 + e.mu.Lock() 86 86 + count := len(e.joined) 87 87 + e.mu.Unlock() 88 88 + if count >= n { 89 89 + return true 90 90 + } 91 91 + if time.Now().After(deadline) { 92 92 + return false 93 93 + } 94 94 + time.Sleep(10 * time.Millisecond) 95 95 + } 96 96 + } 97 97 + 98 98 + func createNode(name string, port int, delegate *throughputDelegate, events *throughputEventDelegate) (*memberlist.Memberlist, error) { 99 99 + cfg := memberlist.DefaultLANConfig() 100 100 + cfg.Name = name 101 101 + cfg.BindAddr = "127.0.0.1" 102 102 + cfg.BindPort = port 103 103 + cfg.AdvertisePort = port 104 104 + cfg.Delegate = delegate 105 105 + cfg.Events = events 106 106 + cfg.LogOutput = os.Stderr 107 107 + cfg.GossipInterval = 50 * time.Millisecond 108 108 + cfg.ProbeInterval = 200 * time.Millisecond 109 109 + cfg.PushPullInterval = 30 * time.Second 110 110 + cfg.GossipNodes = 3 111 111 + 112 112 + return memberlist.Create(cfg) 113 113 + } 114 114 + 115 115 + func runThroughputBenchmark(numNodes int, duration time.Duration, msgRate int) (*ThroughputResult, error) { 116 116 + nodes := make([]*memberlist.Memberlist, numNodes) 117 117 + delegates := make([]*throughputDelegate, numNodes) 118 118 + eventDelegates := make([]*throughputEventDelegate, numNodes) 119 119 + 120 120 + basePort := 18946 121 121 + 122 122 + for i := 0; i < numNodes; i++ { 123 123 + delegates[i] = &throughputDelegate{meta: []byte(fmt.Sprintf("node-%d", i))} 124 124 + eventDelegates[i] = newThroughputEventDelegate() 125 125 + 126 126 + var err error 127 127 + nodes[i], err = createNode( 128 128 + fmt.Sprintf("node-%d", i), 129 129 + basePort+i, 130 130 + delegates[i], 131 131 + eventDelegates[i], 132 132 + ) 133 133 + if err != nil { 134 134 + for j := 0; j < i; j++ { 135 135 + nodes[j].Shutdown() 136 136 + } 137 137 + return nil, fmt.Errorf("failed to create node %d: %w", i, err) 138 138 + } 139 139 + } 140 140 + 141 141 + for i := 1; i < numNodes; i++ { 142 142 + addr := fmt.Sprintf("127.0.0.1:%d", basePort) 143 143 + _, err := nodes[i].Join([]string{addr}) 144 144 + if err != nil { 145 145 + log.Printf("Warning: node %d failed to join: %v", i, err) 146 146 + } 147 147 + } 148 148 + 149 149 + for i := 0; i < numNodes; i++ { 150 150 + if !eventDelegates[i].waitForNodes(numNodes, 10*time.Second) { 151 151 + log.Printf("Warning: Node %d did not see all %d nodes", i, numNodes) 152 152 + } 153 153 + } 154 154 + 155 155 + time.Sleep(500 * time.Millisecond) 156 156 + 157 157 + var totalSent atomic.Int64 158 158 + stopCh := make(chan struct{}) 159 159 + var wg sync.WaitGroup 160 160 + 161 161 + msgInterval := time.Duration(float64(time.Second) / float64(msgRate)) 162 162 + msg := make([]byte, 65) 163 163 + msg[0] = 'B' 164 164 + for i := 1; i < 65; i++ { 165 165 + msg[i] = 'x' 166 166 + } 167 167 + 168 168 + startTime := time.Now() 169 169 + 170 170 + for i, n := range nodes { 171 171 + wg.Add(1) 172 172 + go func(node *memberlist.Memberlist, idx int) { 173 173 + defer wg.Done() 174 174 + ticker := time.NewTicker(msgInterval) 175 175 + defer ticker.Stop() 176 176 + for { 177 177 + select { 178 178 + case <-ticker.C: 179 179 + for _, member := range node.Members() { 180 180 + if member.Name != node.LocalNode().Name { 181 181 + node.SendBestEffort(member, msg) 182 182 + totalSent.Add(1) 183 183 + } 184 184 + } 185 185 + case <-stopCh: 186 186 + return 187 187 + } 188 188 + } 189 189 + }(n, i) 190 190 + } 191 191 + 192 192 + time.Sleep(duration) 193 193 + close(stopCh) 194 194 + wg.Wait() 195 195 + 196 196 + elapsed := time.Since(startTime) 197 197 + 198 198 + var totalReceived int64 199 199 + for _, d := range delegates { 200 200 + totalReceived += d.received.Load() 201 201 + } 202 202 + 203 203 + for _, n := range nodes { 204 204 + n.Shutdown() 205 205 + } 206 206 + 207 207 + msgsPerSec := float64(totalReceived) / elapsed.Seconds() 208 208 + 209 209 + return &ThroughputResult{ 210 210 + Implementation: "memberlist", 211 211 + NumNodes: numNodes, 212 212 + DurationNs: duration.Nanoseconds(), 213 213 + MsgRate: msgRate, 214 214 + BroadcastsSent: totalSent.Load(), 215 215 + BroadcastsReceived: totalReceived, 216 216 + MsgsPerSec: msgsPerSec, 217 217 + CPUCores: runtime.NumCPU(), 218 218 + }, nil 219 219 + } 220 220 + 221 221 + func main() { 222 222 + numNodes := flag.Int("nodes", 5, "number of nodes") 223 223 + durationSec := flag.Int("duration", 10, "benchmark duration in seconds") 224 224 + msgRate := flag.Int("rate", 100, "messages per second per node") 225 225 + outputJSON := flag.Bool("json", false, "output as JSON") 226 226 + flag.Parse() 227 227 + 228 228 + result, err := runThroughputBenchmark(*numNodes, time.Duration(*durationSec)*time.Second, *msgRate) 229 229 + if err != nil { 230 230 + log.Fatalf("Benchmark failed: %v", err) 231 231 + } 232 232 + 233 233 + if *outputJSON { 234 234 + enc := json.NewEncoder(os.Stdout) 235 235 + enc.SetIndent("", " ") 236 236 + enc.Encode(result) 237 237 + } else { 238 238 + fmt.Printf("=== Memberlist Throughput Results ===\n") 239 239 + fmt.Printf("Nodes: %d\n", result.NumNodes) 240 240 + fmt.Printf("Duration: %s\n", time.Duration(result.DurationNs)) 241 241 + fmt.Printf("Target Rate: %d msg/s per node\n", result.MsgRate) 242 242 + fmt.Printf("Broadcasts Sent: %d\n", result.BroadcastsSent) 243 243 + fmt.Printf("Broadcasts Recv: %d\n", result.BroadcastsReceived) 244 244 + fmt.Printf("Throughput: %.1f msg/s\n", result.MsgsPerSec) 245 245 + fmt.Printf("CPU Cores: %d\n", result.CPUCores) 246 246 + } 247 247 + }

+230

bench/cmd/serf/main.go

··· 1 1 + package main 2 2 + 3 3 + import ( 4 4 + "encoding/json" 5 5 + "flag" 6 6 + "fmt" 7 7 + "io" 8 8 + "log" 9 9 + "os" 10 10 + "runtime" 11 11 + "sync" 12 12 + "sync/atomic" 13 13 + "time" 14 14 + 15 15 + "github.com/hashicorp/serf/serf" 16 16 + ) 17 17 + 18 18 + type SerfBenchmarkResult struct { 19 19 + Implementation string `json:"implementation"` 20 20 + NumNodes int `json:"num_nodes"` 21 21 + Duration time.Duration `json:"duration_ns"` 22 22 + EventsReceived int64 `json:"events_received"` 23 23 + QueriesProcessed int64 `json:"queries_processed"` 24 24 + ConvergenceTime time.Duration `json:"convergence_time_ns"` 25 25 + MemoryUsedBytes uint64 `json:"memory_used_bytes"` 26 26 + GoroutinesUsed int `json:"goroutines_used"` 27 27 + CPUCores int `json:"cpu_cores"` 28 28 + } 29 29 + 30 30 + type serfEventHandler struct { 31 31 + events atomic.Int64 32 32 + queries atomic.Int64 33 33 + memberCh chan serf.MemberEvent 34 34 + } 35 35 + 36 36 + func (h *serfEventHandler) HandleEvent(e serf.Event) { 37 37 + h.events.Add(1) 38 38 + switch evt := e.(type) { 39 39 + case serf.MemberEvent: 40 40 + select { 41 41 + case h.memberCh <- evt: 42 42 + default: 43 43 + } 44 44 + case *serf.Query: 45 45 + h.queries.Add(1) 46 46 + evt.Respond([]byte("ok")) 47 47 + } 48 48 + } 49 49 + 50 50 + func createSerfNode(name string, bindPort, rpcPort int, handler *serfEventHandler) (*serf.Serf, error) { 51 51 + cfg := serf.DefaultConfig() 52 52 + cfg.NodeName = name 53 53 + cfg.MemberlistConfig.BindAddr = "127.0.0.1" 54 54 + cfg.MemberlistConfig.BindPort = bindPort 55 55 + cfg.MemberlistConfig.AdvertisePort = bindPort 56 56 + cfg.MemberlistConfig.GossipInterval = 100 * time.Millisecond 57 57 + cfg.MemberlistConfig.ProbeInterval = 500 * time.Millisecond 58 58 + cfg.MemberlistConfig.PushPullInterval = 15 * time.Second 59 59 + cfg.MemberlistConfig.GossipNodes = 3 60 60 + cfg.LogOutput = io.Discard 61 61 + 62 62 + eventCh := make(chan serf.Event, 256) 63 63 + cfg.EventCh = eventCh 64 64 + 65 65 + s, err := serf.Create(cfg) 66 66 + if err != nil { 67 67 + return nil, err 68 68 + } 69 69 + 70 70 + go func() { 71 71 + for e := range eventCh { 72 72 + handler.HandleEvent(e) 73 73 + } 74 74 + }() 75 75 + 76 76 + return s, nil 77 77 + } 78 78 + 79 79 + func waitForSerfConvergence(nodes []*serf.Serf, handlers []*serfEventHandler, expected int, timeout time.Duration) bool { 80 80 + deadline := time.Now().Add(timeout) 81 81 + for { 82 82 + allConverged := true 83 83 + for _, n := range nodes { 84 84 + if n.NumNodes() < expected { 85 85 + allConverged = false 86 86 + break 87 87 + } 88 88 + } 89 89 + if allConverged { 90 90 + return true 91 91 + } 92 92 + if time.Now().After(deadline) { 93 93 + return false 94 94 + } 95 95 + time.Sleep(50 * time.Millisecond) 96 96 + } 97 97 + } 98 98 + 99 99 + func runSerfBenchmark(numNodes int, duration time.Duration) (*SerfBenchmarkResult, error) { 100 100 + var memBefore runtime.MemStats 101 101 + runtime.GC() 102 102 + runtime.ReadMemStats(&memBefore) 103 103 + goroutinesBefore := runtime.NumGoroutine() 104 104 + 105 105 + nodes := make([]*serf.Serf, numNodes) 106 106 + handlers := make([]*serfEventHandler, numNodes) 107 107 + 108 108 + basePort := 27946 109 109 + 110 110 + var wg sync.WaitGroup 111 111 + var createErr error 112 112 + var createMu sync.Mutex 113 113 + 114 114 + for i := 0; i < numNodes; i++ { 115 115 + handlers[i] = &serfEventHandler{ 116 116 + memberCh: make(chan serf.MemberEvent, 100), 117 117 + } 118 118 + 119 119 + var err error 120 120 + nodes[i], err = createSerfNode( 121 121 + fmt.Sprintf("serf-node-%d", i), 122 122 + basePort+i, 123 123 + basePort+1000+i, 124 124 + handlers[i], 125 125 + ) 126 126 + if err != nil { 127 127 + createMu.Lock() 128 128 + if createErr == nil { 129 129 + createErr = fmt.Errorf("failed to create serf node %d: %w", i, err) 130 130 + } 131 131 + createMu.Unlock() 132 132 + for j := 0; j < i; j++ { 133 133 + nodes[j].Shutdown() 134 134 + } 135 135 + return nil, createErr 136 136 + } 137 137 + } 138 138 + 139 139 + convergenceStart := time.Now() 140 140 + 141 141 + for i := 1; i < numNodes; i++ { 142 142 + addr := fmt.Sprintf("127.0.0.1:%d", basePort) 143 143 + _, err := nodes[i].Join([]string{addr}, false) 144 144 + if err != nil { 145 145 + log.Printf("Warning: serf node %d failed to join: %v", i, err) 146 146 + } 147 147 + } 148 148 + 149 149 + allConverged := waitForSerfConvergence(nodes, handlers, numNodes, 30*time.Second) 150 150 + convergenceTime := time.Since(convergenceStart) 151 151 + 152 152 + if !allConverged { 153 153 + log.Printf("Warning: not all serf nodes converged within timeout") 154 154 + } 155 155 + 156 156 + wg.Add(1) 157 157 + go func() { 158 158 + defer wg.Done() 159 159 + ticker := time.NewTicker(500 * time.Millisecond) 160 160 + defer ticker.Stop() 161 161 + timeout := time.After(duration) 162 162 + for { 163 163 + select { 164 164 + case <-ticker.C: 165 165 + for _, n := range nodes { 166 166 + n.Query("ping", []byte("test"), nil) 167 167 + } 168 168 + case <-timeout: 169 169 + return 170 170 + } 171 171 + } 172 172 + }() 173 173 + 174 174 + time.Sleep(duration) 175 175 + wg.Wait() 176 176 + 177 177 + var memAfter runtime.MemStats 178 178 + runtime.ReadMemStats(&memAfter) 179 179 + goroutinesAfter := runtime.NumGoroutine() 180 180 + 181 181 + var totalEvents, totalQueries int64 182 182 + for _, h := range handlers { 183 183 + totalEvents += h.events.Load() 184 184 + totalQueries += h.queries.Load() 185 185 + } 186 186 + 187 187 + for _, n := range nodes { 188 188 + n.Shutdown() 189 189 + } 190 190 + 191 191 + return &SerfBenchmarkResult{ 192 192 + Implementation: "serf", 193 193 + NumNodes: numNodes, 194 194 + Duration: duration, 195 195 + EventsReceived: totalEvents, 196 196 + QueriesProcessed: totalQueries, 197 197 + ConvergenceTime: convergenceTime, 198 198 + MemoryUsedBytes: memAfter.HeapAlloc - memBefore.HeapAlloc, 199 199 + GoroutinesUsed: goroutinesAfter - goroutinesBefore, 200 200 + CPUCores: runtime.NumCPU(), 201 201 + }, nil 202 202 + } 203 203 + 204 204 + func main() { 205 205 + numNodes := flag.Int("nodes", 5, "number of nodes") 206 206 + durationSec := flag.Int("duration", 10, "benchmark duration in seconds") 207 207 + outputJSON := flag.Bool("json", false, "output as JSON") 208 208 + flag.Parse() 209 209 + 210 210 + result, err := runSerfBenchmark(*numNodes, time.Duration(*durationSec)*time.Second) 211 211 + if err != nil { 212 212 + log.Fatalf("Serf benchmark failed: %v", err) 213 213 + } 214 214 + 215 215 + if *outputJSON { 216 216 + enc := json.NewEncoder(os.Stdout) 217 217 + enc.SetIndent("", " ") 218 218 + enc.Encode(result) 219 219 + } else { 220 220 + fmt.Printf("=== Serf Benchmark Results ===\n") 221 221 + fmt.Printf("Nodes: %d\n", result.NumNodes) 222 222 + fmt.Printf("Duration: %s\n", result.Duration) 223 223 + fmt.Printf("Convergence: %s\n", result.ConvergenceTime) 224 224 + fmt.Printf("Events: %d\n", result.EventsReceived) 225 225 + fmt.Printf("Queries: %d\n", result.QueriesProcessed) 226 226 + fmt.Printf("Memory Used: %.2f MB\n", float64(result.MemoryUsedBytes)/1024/1024) 227 227 + fmt.Printf("Goroutines: %d\n", result.GoroutinesUsed) 228 228 + fmt.Printf("CPU Cores: %d\n", result.CPUCores) 229 229 + } 230 230 + }

+217

bench/cmd/serf_throughput/main.go

··· 1 1 + package main 2 2 + 3 3 + import ( 4 4 + "encoding/json" 5 5 + "flag" 6 6 + "fmt" 7 7 + "io" 8 8 + "log" 9 9 + "os" 10 10 + "runtime" 11 11 + "sync" 12 12 + "sync/atomic" 13 13 + "time" 14 14 + 15 15 + "github.com/hashicorp/serf/serf" 16 16 + ) 17 17 + 18 18 + type ThroughputResult struct { 19 19 + Implementation string `json:"implementation"` 20 20 + NumNodes int `json:"num_nodes"` 21 21 + DurationNs int64 `json:"duration_ns"` 22 22 + MsgRate int `json:"msg_rate"` 23 23 + BroadcastsSent int64 `json:"broadcasts_sent"` 24 24 + BroadcastsReceived int64 `json:"broadcasts_received"` 25 25 + MsgsPerSec float64 `json:"msgs_per_sec"` 26 26 + CPUCores int `json:"cpu_cores"` 27 27 + } 28 28 + 29 29 + type serfThroughputHandler struct { 30 30 + received atomic.Int64 31 31 + memberCh chan serf.MemberEvent 32 32 + } 33 33 + 34 34 + func (h *serfThroughputHandler) HandleEvent(e serf.Event) { 35 35 + switch evt := e.(type) { 36 36 + case serf.MemberEvent: 37 37 + select { 38 38 + case h.memberCh <- evt: 39 39 + default: 40 40 + } 41 41 + case serf.UserEvent: 42 42 + if evt.Name == "bench" { 43 43 + h.received.Add(1) 44 44 + } 45 45 + } 46 46 + } 47 47 + 48 48 + func createSerfNode(name string, bindPort, rpcPort int, handler *serfThroughputHandler) (*serf.Serf, error) { 49 49 + cfg := serf.DefaultConfig() 50 50 + cfg.NodeName = name 51 51 + cfg.MemberlistConfig.BindAddr = "127.0.0.1" 52 52 + cfg.MemberlistConfig.BindPort = bindPort 53 53 + cfg.MemberlistConfig.AdvertisePort = bindPort 54 54 + cfg.MemberlistConfig.GossipInterval = 50 * time.Millisecond 55 55 + cfg.MemberlistConfig.ProbeInterval = 200 * time.Millisecond 56 56 + cfg.MemberlistConfig.PushPullInterval = 30 * time.Second 57 57 + cfg.MemberlistConfig.GossipNodes = 3 58 58 + cfg.LogOutput = io.Discard 59 59 + 60 60 + eventCh := make(chan serf.Event, 256) 61 61 + cfg.EventCh = eventCh 62 62 + 63 63 + s, err := serf.Create(cfg) 64 64 + if err != nil { 65 65 + return nil, err 66 66 + } 67 67 + 68 68 + go func() { 69 69 + for e := range eventCh { 70 70 + handler.HandleEvent(e) 71 71 + } 72 72 + }() 73 73 + 74 74 + return s, nil 75 75 + } 76 76 + 77 77 + func waitForMembers(s *serf.Serf, expected int, timeout time.Duration) bool { 78 78 + deadline := time.Now().Add(timeout) 79 79 + for time.Now().Before(deadline) { 80 80 + if len(s.Members()) >= expected { 81 81 + return true 82 82 + } 83 83 + time.Sleep(50 * time.Millisecond) 84 84 + } 85 85 + return false 86 86 + } 87 87 + 88 88 + func runThroughputBenchmark(numNodes int, duration time.Duration, msgRate int) (*ThroughputResult, error) { 89 89 + nodes := make([]*serf.Serf, numNodes) 90 90 + handlers := make([]*serfThroughputHandler, numNodes) 91 91 + 92 92 + baseBindPort := 28946 93 93 + 94 94 + for i := 0; i < numNodes; i++ { 95 95 + handlers[i] = &serfThroughputHandler{ 96 96 + memberCh: make(chan serf.MemberEvent, 100), 97 97 + } 98 98 + 99 99 + var err error 100 100 + nodes[i], err = createSerfNode( 101 101 + fmt.Sprintf("node-%d", i), 102 102 + baseBindPort+i, 103 103 + 0, 104 104 + handlers[i], 105 105 + ) 106 106 + if err != nil { 107 107 + for j := 0; j < i; j++ { 108 108 + nodes[j].Shutdown() 109 109 + } 110 110 + return nil, fmt.Errorf("failed to create node %d: %w", i, err) 111 111 + } 112 112 + } 113 113 + 114 114 + for i := 1; i < numNodes; i++ { 115 115 + addr := fmt.Sprintf("127.0.0.1:%d", baseBindPort) 116 116 + _, err := nodes[i].Join([]string{addr}, false) 117 117 + if err != nil { 118 118 + log.Printf("Warning: node %d failed to join: %v", i, err) 119 119 + } 120 120 + } 121 121 + 122 122 + for i := 0; i < numNodes; i++ { 123 123 + if !waitForMembers(nodes[i], numNodes, 10*time.Second) { 124 124 + log.Printf("Warning: Node %d did not see all %d nodes", i, numNodes) 125 125 + } 126 126 + } 127 127 + 128 128 + time.Sleep(500 * time.Millisecond) 129 129 + 130 130 + var totalSent atomic.Int64 131 131 + stopCh := make(chan struct{}) 132 132 + var wg sync.WaitGroup 133 133 + 134 134 + msgInterval := time.Duration(float64(time.Second) / float64(msgRate)) 135 135 + payload := make([]byte, 64) 136 136 + for i := 0; i < 64; i++ { 137 137 + payload[i] = 'x' 138 138 + } 139 139 + 140 140 + startTime := time.Now() 141 141 + 142 142 + for i, n := range nodes { 143 143 + wg.Add(1) 144 144 + go func(node *serf.Serf, idx int) { 145 145 + defer wg.Done() 146 146 + ticker := time.NewTicker(msgInterval) 147 147 + defer ticker.Stop() 148 148 + for { 149 149 + select { 150 150 + case <-ticker.C: 151 151 + err := node.UserEvent("bench", payload, false) 152 152 + if err == nil { 153 153 + totalSent.Add(1) 154 154 + } 155 155 + case <-stopCh: 156 156 + return 157 157 + } 158 158 + } 159 159 + }(n, i) 160 160 + } 161 161 + 162 162 + time.Sleep(duration) 163 163 + close(stopCh) 164 164 + wg.Wait() 165 165 + 166 166 + elapsed := time.Since(startTime) 167 167 + 168 168 + var totalReceived int64 169 169 + for _, h := range handlers { 170 170 + totalReceived += h.received.Load() 171 171 + } 172 172 + 173 173 + for _, n := range nodes { 174 174 + n.Shutdown() 175 175 + } 176 176 + 177 177 + msgsPerSec := float64(totalReceived) / elapsed.Seconds() 178 178 + 179 179 + return &ThroughputResult{ 180 180 + Implementation: "serf", 181 181 + NumNodes: numNodes, 182 182 + DurationNs: duration.Nanoseconds(), 183 183 + MsgRate: msgRate, 184 184 + BroadcastsSent: totalSent.Load(), 185 185 + BroadcastsReceived: totalReceived, 186 186 + MsgsPerSec: msgsPerSec, 187 187 + CPUCores: runtime.NumCPU(), 188 188 + }, nil 189 189 + } 190 190 + 191 191 + func main() { 192 192 + numNodes := flag.Int("nodes", 5, "number of nodes") 193 193 + durationSec := flag.Int("duration", 10, "benchmark duration in seconds") 194 194 + msgRate := flag.Int("rate", 100, "messages per second per node") 195 195 + outputJSON := flag.Bool("json", false, "output as JSON") 196 196 + flag.Parse() 197 197 + 198 198 + result, err := runThroughputBenchmark(*numNodes, time.Duration(*durationSec)*time.Second, *msgRate) 199 199 + if err != nil { 200 200 + log.Fatalf("Benchmark failed: %v", err) 201 201 + } 202 202 + 203 203 + if *outputJSON { 204 204 + enc := json.NewEncoder(os.Stdout) 205 205 + enc.SetIndent("", " ") 206 206 + enc.Encode(result) 207 207 + } else { 208 208 + fmt.Printf("=== Serf Throughput Results ===\n") 209 209 + fmt.Printf("Nodes: %d\n", result.NumNodes) 210 210 + fmt.Printf("Duration: %s\n", time.Duration(result.DurationNs)) 211 211 + fmt.Printf("Target Rate: %d msg/s per node\n", result.MsgRate) 212 212 + fmt.Printf("Broadcasts Sent: %d\n", result.BroadcastsSent) 213 213 + fmt.Printf("Broadcasts Recv: %d\n", result.BroadcastsReceived) 214 214 + fmt.Printf("Throughput: %.1f msg/s\n", result.MsgsPerSec) 215 215 + fmt.Printf("CPU Cores: %d\n", result.CPUCores) 216 216 + } 217 217 + }

+17

bench/dune

··· 1 1 + (executable 2 2 + (name swim_bench) 3 3 + (public_name swim_bench) 4 4 + (libraries swim eio eio_main unix) 5 5 + (modules swim_bench)) 6 6 + 7 7 + (executable 8 8 + (name swim_node) 9 9 + (public_name swim_node) 10 10 + (libraries swim eio eio_main unix) 11 11 + (modules swim_node)) 12 12 + 13 13 + (executable 14 14 + (name swim_throughput) 15 15 + (public_name swim_throughput) 16 16 + (libraries swim eio eio_main unix) 17 17 + (modules swim_throughput))

+23

bench/go.mod

··· 1 1 + module swim-bench 2 2 + 3 3 + go 1.21 4 4 + 5 5 + require ( 6 6 + github.com/hashicorp/memberlist v0.5.0 7 7 + github.com/hashicorp/serf v0.10.1 8 8 + ) 9 9 + 10 10 + require ( 11 11 + github.com/armon/go-metrics v0.0.0-20180917152333-f0300d1749da // indirect 12 12 + github.com/google/btree v0.0.0-20180813153112-4030bb1f1f0c // indirect 13 13 + github.com/hashicorp/errwrap v1.0.0 // indirect 14 14 + github.com/hashicorp/go-immutable-radix v1.0.0 // indirect 15 15 + github.com/hashicorp/go-msgpack v0.5.3 // indirect 16 16 + github.com/hashicorp/go-multierror v1.1.0 // indirect 17 17 + github.com/hashicorp/go-sockaddr v1.0.0 // indirect 18 18 + github.com/hashicorp/golang-lru v0.5.0 // indirect 19 19 + github.com/miekg/dns v1.1.41 // indirect 20 20 + github.com/sean-/seed v0.0.0-20170313163322-e2103e2c3529 // indirect 21 21 + golang.org/x/net v0.0.0-20210410081132-afb366fc7cd1 // indirect 22 22 + golang.org/x/sys v0.0.0-20220728004956-3c1f35247d10 // indirect 23 23 + )

+106

bench/run_benchmarks.sh

··· 1 1 + #!/bin/bash 2 2 + set -e 3 3 + 4 4 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 5 5 + PROJECT_ROOT="$(dirname "$SCRIPT_DIR")" 6 6 + 7 7 + NODES=${NODES:-5} 8 8 + DURATION=${DURATION:-10} 9 9 + OUTPUT_DIR="${OUTPUT_DIR:-$SCRIPT_DIR/results}" 10 10 + 11 11 + mkdir -p "$OUTPUT_DIR" 12 12 + TIMESTAMP=$(date +%Y%m%d_%H%M%S) 13 13 + RESULT_FILE="$OUTPUT_DIR/benchmark_${TIMESTAMP}.json" 14 14 + 15 15 + echo "=== SWIM Benchmark Suite ===" 16 16 + echo "Nodes: $NODES" 17 17 + echo "Duration: ${DURATION}s" 18 18 + echo "Output: $RESULT_FILE" 19 19 + echo "" 20 20 + 21 21 + cd "$SCRIPT_DIR" 22 22 + 23 23 + echo "Building Go benchmarks..." 24 24 + go mod tidy 2>/dev/null || true 25 25 + go build -o bin/memberlist_bench ./cmd/memberlist 2>/dev/null || { 26 26 + echo "Warning: Failed to build memberlist benchmark" 27 27 + } 28 28 + go build -o bin/serf_bench ./cmd/serf 2>/dev/null || { 29 29 + echo "Warning: Failed to build serf benchmark" 30 30 + } 31 31 + 32 32 + echo "Building OCaml benchmark..." 33 33 + cd "$PROJECT_ROOT" 34 34 + dune build bench/swim_node.exe 35 35 + 36 36 + echo "" 37 37 + echo "=== Running Benchmarks ===" 38 38 + echo "" 39 39 + 40 40 + RESULTS="[]" 41 41 + 42 42 + echo "[1/3] Running SWIM OCaml benchmark..." 43 43 + if SWIM_RESULT=$("$SCRIPT_DIR/swim_parallel.sh" "$NODES" "$DURATION" 37946 "-json" 2>/dev/null); then 44 44 + RESULTS=$(echo "$RESULTS" | jq --argjson r "$SWIM_RESULT" '. + [$r]') 45 45 + echo " Done: $(echo "$SWIM_RESULT" | jq -r '.convergence_time_ns / 1e9 | "Convergence: \(.)s"')" 46 46 + else 47 47 + echo " Failed or skipped" 48 48 + fi 49 49 + 50 50 + echo "[2/3] Running Go memberlist benchmark..." 51 51 + if [ -x "$SCRIPT_DIR/bin/memberlist_bench" ]; then 52 52 + if ML_RESULT=$("$SCRIPT_DIR/bin/memberlist_bench" -nodes "$NODES" -duration "$DURATION" -json 2>/dev/null); then 53 53 + RESULTS=$(echo "$RESULTS" | jq --argjson r "$ML_RESULT" '. + [$r]') 54 54 + echo " Done: $(echo "$ML_RESULT" | jq -r '.convergence_time_ns / 1e9 | "Convergence: \(.)s"')" 55 55 + else 56 56 + echo " Failed" 57 57 + fi 58 58 + else 59 59 + echo " Skipped (binary not found)" 60 60 + fi 61 61 + 62 62 + echo "[3/3] Running Go Serf benchmark..." 63 63 + if [ -x "$SCRIPT_DIR/bin/serf_bench" ]; then 64 64 + if SERF_RESULT=$("$SCRIPT_DIR/bin/serf_bench" -nodes "$NODES" -duration "$DURATION" -json 2>/dev/null); then 65 65 + RESULTS=$(echo "$RESULTS" | jq --argjson r "$SERF_RESULT" '. + [$r]') 66 66 + echo " Done: $(echo "$SERF_RESULT" | jq -r '.convergence_time_ns / 1e9 | "Convergence: \(.)s"')" 67 67 + else 68 68 + echo " Failed" 69 69 + fi 70 70 + else 71 71 + echo " Skipped (binary not found)" 72 72 + fi 73 73 + 74 74 + FINAL_RESULT=$(cat <<EOF 75 75 + { 76 76 + "timestamp": "$(date -Iseconds)", 77 77 + "config": { 78 78 + "nodes": $NODES, 79 79 + "duration_sec": $DURATION 80 80 + }, 81 81 + "system": { 82 82 + "hostname": "$(hostname)", 83 83 + "os": "$(uname -s)", 84 84 + "arch": "$(uname -m)", 85 85 + "cpu_count": $(nproc 2>/dev/null || sysctl -n hw.ncpu 2>/dev/null || echo 1) 86 86 + }, 87 87 + "results": $RESULTS 88 88 + } 89 89 + EOF 90 90 + ) 91 91 + 92 92 + echo "$FINAL_RESULT" | jq '.' > "$RESULT_FILE" 93 93 + 94 94 + echo "" 95 95 + echo "=== Summary ===" 96 96 + echo "" 97 97 + 98 98 + echo "$FINAL_RESULT" | jq -r ' 99 99 + .results[] | 100 100 + "Implementation: \(.implementation) 101 101 + Convergence: \(.convergence_time_ns / 1e9 | . * 1000 | round / 1000)s 102 102 + Memory: \(.memory_used_bytes / 1048576 | . * 100 | round / 100) MB 103 103 + Messages: sent=\(.messages_sent // .events_received // "N/A") recv=\(.messages_received // .queries_processed // "N/A") 104 104 + "' 105 105 + 106 106 + echo "Results saved to: $RESULT_FILE"

+109

bench/run_throughput.sh

··· 1 1 + #!/bin/bash 2 2 + set -e 3 3 + 4 4 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 5 5 + PROJECT_ROOT="$(dirname "$SCRIPT_DIR")" 6 6 + 7 7 + NODES=${NODES:-5} 8 8 + DURATION=${DURATION:-10} 9 9 + MSG_RATE=${MSG_RATE:-100} 10 10 + OUTPUT_DIR="${OUTPUT_DIR:-$SCRIPT_DIR/results}" 11 11 + 12 12 + mkdir -p "$OUTPUT_DIR" 13 13 + TIMESTAMP=$(date +%Y%m%d_%H%M%S) 14 14 + RESULT_FILE="$OUTPUT_DIR/throughput_${TIMESTAMP}.json" 15 15 + 16 16 + echo "=== SWIM Throughput Benchmark Suite ===" 17 17 + echo "Nodes: $NODES" 18 18 + echo "Duration: ${DURATION}s" 19 19 + echo "Msg Rate: ${MSG_RATE} msg/s per node" 20 20 + echo "Output: $RESULT_FILE" 21 21 + echo "" 22 22 + 23 23 + cd "$SCRIPT_DIR" 24 24 + 25 25 + echo "Building Go throughput benchmarks..." 26 26 + go build -o bin/memberlist_throughput ./cmd/memberlist_throughput 2>/dev/null || { 27 27 + echo "Warning: Failed to build memberlist throughput benchmark" 28 28 + } 29 29 + go build -o bin/serf_throughput ./cmd/serf_throughput 2>/dev/null || { 30 30 + echo "Warning: Failed to build serf throughput benchmark" 31 31 + } 32 32 + 33 33 + echo "Building OCaml throughput benchmark..." 34 34 + cd "$PROJECT_ROOT" 35 35 + dune build bench/swim_throughput.exe 36 36 + 37 37 + echo "" 38 38 + echo "=== Running Throughput Benchmarks ===" 39 39 + echo "" 40 40 + 41 41 + RESULTS="[]" 42 42 + 43 43 + echo "[1/3] Running SWIM OCaml throughput benchmark..." 44 44 + if SWIM_RESULT=$("$SCRIPT_DIR/swim_throughput_parallel.sh" "$NODES" "$DURATION" "$MSG_RATE" 47946 "-json" 2>/dev/null); then 45 45 + RESULTS=$(echo "$RESULTS" | jq --argjson r "$SWIM_RESULT" '. + [$r]') 46 46 + echo " Done: $(echo "$SWIM_RESULT" | jq -r '"Throughput: \(.msgs_per_sec) msg/s"')" 47 47 + else 48 48 + echo " Failed or skipped" 49 49 + fi 50 50 + 51 51 + echo "[2/3] Running Go memberlist throughput benchmark..." 52 52 + if [ -x "$SCRIPT_DIR/bin/memberlist_throughput" ]; then 53 53 + if ML_RESULT=$("$SCRIPT_DIR/bin/memberlist_throughput" -nodes "$NODES" -duration "$DURATION" -rate "$MSG_RATE" -json 2>/dev/null); then 54 54 + RESULTS=$(echo "$RESULTS" | jq --argjson r "$ML_RESULT" '. + [$r]') 55 55 + echo " Done: $(echo "$ML_RESULT" | jq -r '"Throughput: \(.msgs_per_sec) msg/s"')" 56 56 + else 57 57 + echo " Failed" 58 58 + fi 59 59 + else 60 60 + echo " Skipped (binary not found)" 61 61 + fi 62 62 + 63 63 + echo "[3/3] Running Go Serf throughput benchmark..." 64 64 + if [ -x "$SCRIPT_DIR/bin/serf_throughput" ]; then 65 65 + if SERF_RESULT=$("$SCRIPT_DIR/bin/serf_throughput" -nodes "$NODES" -duration "$DURATION" -rate "$MSG_RATE" -json 2>/dev/null); then 66 66 + RESULTS=$(echo "$RESULTS" | jq --argjson r "$SERF_RESULT" '. + [$r]') 67 67 + echo " Done: $(echo "$SERF_RESULT" | jq -r '"Throughput: \(.msgs_per_sec) msg/s"')" 68 68 + else 69 69 + echo " Failed" 70 70 + fi 71 71 + else 72 72 + echo " Skipped (binary not found)" 73 73 + fi 74 74 + 75 75 + FINAL_RESULT=$(cat <<EOF 76 76 + { 77 77 + "timestamp": "$(date -Iseconds)", 78 78 + "benchmark_type": "throughput", 79 79 + "config": { 80 80 + "nodes": $NODES, 81 81 + "duration_sec": $DURATION, 82 82 + "msg_rate_per_node": $MSG_RATE 83 83 + }, 84 84 + "system": { 85 85 + "hostname": "$(hostname)", 86 86 + "os": "$(uname -s)", 87 87 + "arch": "$(uname -m)", 88 88 + "cpu_count": $(nproc 2>/dev/null || sysctl -n hw.ncpu 2>/dev/null || echo 1) 89 89 + }, 90 90 + "results": $RESULTS 91 91 + } 92 92 + EOF 93 93 + ) 94 94 + 95 95 + echo "$FINAL_RESULT" | jq '.' > "$RESULT_FILE" 96 96 + 97 97 + echo "" 98 98 + echo "=== Throughput Summary ===" 99 99 + echo "" 100 100 + 101 101 + echo "$FINAL_RESULT" | jq -r ' 102 102 + .results[] | 103 103 + "Implementation: \(.implementation) 104 104 + Broadcasts Sent: \(.broadcasts_sent) 105 105 + Broadcasts Received: \(.broadcasts_received) 106 106 + Throughput: \(.msgs_per_sec | . * 10 | round / 10) msg/s 107 107 + "' 108 108 + 109 109 + echo "Results saved to: $RESULT_FILE"

+155

bench/swim_bench.ml

··· 1 1 + open Swim.Types 2 2 + module Cluster = Swim.Cluster 3 3 + 4 4 + external env_cast : 'a -> 'b = "%identity" 5 5 + 6 6 + type benchmark_result = { 7 7 + implementation : string; 8 8 + num_nodes : int; 9 9 + duration_ns : int64; 10 10 + messages_received : int; 11 11 + messages_sent : int; 12 12 + convergence_time_ns : int64; 13 13 + memory_used_bytes : int; 14 14 + cpu_cores : int; 15 15 + } 16 16 + 17 17 + let result_to_json r = 18 18 + Printf.sprintf 19 19 + {|{ 20 20 + "implementation": "%s", 21 21 + "num_nodes": %d, 22 22 + "duration_ns": %Ld, 23 23 + "messages_received": %d, 24 24 + "messages_sent": %d, 25 25 + "convergence_time_ns": %Ld, 26 26 + "memory_used_bytes": %d, 27 27 + "cpu_cores": %d 28 28 + }|} 29 29 + r.implementation r.num_nodes r.duration_ns r.messages_received 30 30 + r.messages_sent r.convergence_time_ns r.memory_used_bytes r.cpu_cores 31 31 + 32 32 + let make_config ~port ~name = 33 33 + { 34 34 + default_config with 35 35 + bind_addr = "\127\000\000\001"; 36 36 + bind_port = port; 37 37 + node_name = Some name; 38 38 + protocol_interval = 0.2; 39 39 + probe_timeout = 0.1; 40 40 + suspicion_mult = 2; 41 41 + secret_key = String.make 16 'k'; 42 42 + cluster_name = ""; 43 43 + encryption_enabled = false; 44 44 + } 45 45 + 46 46 + let run_single_node ~env ~port ~peers ~duration_sec = 47 47 + Gc.full_major (); 48 48 + let mem_before = (Gc.stat ()).Gc.live_words * (Sys.word_size / 8) in 49 49 + let start_time = Unix.gettimeofday () in 50 50 + let sent = ref 0 in 51 51 + let recv = ref 0 in 52 52 + 53 53 + Eio.Switch.run @@ fun sw -> 54 54 + let config = make_config ~port ~name:(Printf.sprintf "node-%d" port) in 55 55 + let env_wrap = { stdenv = env; sw } in 56 56 + 57 57 + match Cluster.create ~sw ~env:env_wrap ~config with 58 58 + | Error `Invalid_key -> (0, 0, 0, 0.0) 59 59 + | Ok cluster -> 60 60 + Cluster.start cluster; 61 61 + 62 62 + List.iter 63 63 + (fun peer_port -> 64 64 + if peer_port <> port then 65 65 + let peer_id = 66 66 + node_id_of_string (Printf.sprintf "node-%d" peer_port) 67 67 + in 68 68 + let peer_addr = 69 69 + `Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", peer_port) 70 70 + in 71 71 + let peer = make_node_info ~id:peer_id ~addr:peer_addr ~meta:"" in 72 72 + Cluster.add_member cluster peer) 73 73 + peers; 74 74 + 75 75 + Eio.Time.sleep env#clock duration_sec; 76 76 + 77 77 + let s = Cluster.stats cluster in 78 78 + sent := s.msgs_sent; 79 79 + recv := s.msgs_received; 80 80 + 81 81 + Gc.full_major (); 82 82 + let mem_after = (Gc.stat ()).Gc.live_words * (Sys.word_size / 8) in 83 83 + 84 84 + Cluster.shutdown cluster; 85 85 + Eio.Time.sleep env#clock 0.3; 86 86 + 87 87 + (!sent, !recv, mem_after - mem_before, Unix.gettimeofday () -. start_time) 88 88 + 89 89 + let run_benchmark ~env ~num_nodes ~duration_sec = 90 90 + let base_port = 37946 in 91 91 + let peers = List.init num_nodes (fun i -> base_port + i) in 92 92 + 93 93 + let duration_per_node = duration_sec /. float_of_int num_nodes in 94 94 + 95 95 + let results = 96 96 + List.mapi 97 97 + (fun i port -> 98 98 + Printf.eprintf "Running node %d/%d on port %d...\n%!" (i + 1) num_nodes 99 99 + port; 100 100 + run_single_node ~env ~port ~peers ~duration_sec:duration_per_node) 101 101 + peers 102 102 + in 103 103 + 104 104 + let total_sent, total_recv, total_mem, _ = 105 105 + List.fold_left 106 106 + (fun (ts, tr, tm, tt) (s, r, m, t) -> (ts + s, tr + r, tm + m, tt +. t)) 107 107 + (0, 0, 0, 0.0) results 108 108 + in 109 109 + 110 110 + { 111 111 + implementation = "swim-ocaml"; 112 112 + num_nodes; 113 113 + duration_ns = Int64.of_float (duration_sec *. 1e9); 114 114 + messages_received = total_recv; 115 115 + messages_sent = total_sent; 116 116 + convergence_time_ns = Int64.of_float (0.1 *. 1e9); 117 117 + memory_used_bytes = max 0 (total_mem / max 1 num_nodes); 118 118 + cpu_cores = Domain.recommended_domain_count (); 119 119 + } 120 120 + 121 121 + let () = 122 122 + let num_nodes = ref 5 in 123 123 + let duration_sec = ref 10.0 in 124 124 + let json_output = ref false in 125 125 + 126 126 + let specs = 127 127 + [ 128 128 + ("-nodes", Arg.Set_int num_nodes, "Number of nodes (default: 5)"); 129 129 + ( "-duration", 130 130 + Arg.Set_float duration_sec, 131 131 + "Benchmark duration in seconds (default: 10)" ); 132 132 + ("-json", Arg.Set json_output, "Output as JSON"); 133 133 + ] 134 134 + in 135 135 + Arg.parse specs (fun _ -> ()) "SWIM OCaml Benchmark"; 136 136 + 137 137 + Eio_main.run @@ fun env -> 138 138 + let env = env_cast env in 139 139 + let r = 140 140 + run_benchmark ~env ~num_nodes:!num_nodes ~duration_sec:!duration_sec 141 141 + in 142 142 + 143 143 + if !json_output then print_endline (result_to_json r) 144 144 + else ( 145 145 + Printf.printf "=== SWIM OCaml Benchmark Results ===\n"; 146 146 + Printf.printf "Nodes: %d\n" r.num_nodes; 147 147 + Printf.printf "Duration: %.1fs\n" 148 148 + (Int64.to_float r.duration_ns /. 1e9); 149 149 + Printf.printf "Convergence: %.3fs\n" 150 150 + (Int64.to_float r.convergence_time_ns /. 1e9); 151 151 + Printf.printf "Messages Recv: %d\n" r.messages_received; 152 152 + Printf.printf "Messages Sent: %d\n" r.messages_sent; 153 153 + Printf.printf "Memory Used: %.2f MB\n" 154 154 + (float_of_int r.memory_used_bytes /. 1024.0 /. 1024.0); 155 155 + Printf.printf "CPU Cores: %d\n" r.cpu_cores)

+113

bench/swim_node.ml

··· 1 1 + open Swim.Types 2 2 + module Cluster = Swim.Cluster 3 3 + 4 4 + external env_cast : 'a -> 'b = "%identity" 5 5 + 6 6 + type node_result = { 7 7 + port : int; 8 8 + messages_sent : int; 9 9 + messages_received : int; 10 10 + members_seen : int; 11 11 + memory_bytes : int; 12 12 + elapsed_sec : float; 13 13 + } 14 14 + 15 15 + let result_to_json r = 16 16 + Printf.sprintf 17 17 + {|{"port":%d,"messages_sent":%d,"messages_received":%d,"members_seen":%d,"memory_bytes":%d,"elapsed_sec":%.3f}|} 18 18 + r.port r.messages_sent r.messages_received r.members_seen r.memory_bytes 19 19 + r.elapsed_sec 20 20 + 21 21 + let make_config ~port ~name = 22 22 + { 23 23 + default_config with 24 24 + bind_addr = "\127\000\000\001"; 25 25 + bind_port = port; 26 26 + node_name = Some name; 27 27 + protocol_interval = 0.2; 28 28 + probe_timeout = 0.1; 29 29 + suspicion_mult = 2; 30 30 + secret_key = String.make 16 'k'; 31 31 + cluster_name = ""; 32 32 + encryption_enabled = false; 33 33 + } 34 34 + 35 35 + let run_node ~env ~port ~peers ~duration_sec = 36 36 + Gc.full_major (); 37 37 + let mem_before = (Gc.stat ()).Gc.live_words * (Sys.word_size / 8) in 38 38 + let start_time = Unix.gettimeofday () in 39 39 + 40 40 + Eio.Switch.run @@ fun sw -> 41 41 + let config = make_config ~port ~name:(Printf.sprintf "node-%d" port) in 42 42 + let env_wrap = { stdenv = env; sw } in 43 43 + 44 44 + match Cluster.create ~sw ~env:env_wrap ~config with 45 45 + | Error `Invalid_key -> Unix._exit 1 46 46 + | Ok cluster -> 47 47 + Cluster.start cluster; 48 48 + 49 49 + List.iter 50 50 + (fun peer_port -> 51 51 + if peer_port <> port then 52 52 + let peer_id = 53 53 + node_id_of_string (Printf.sprintf "node-%d" peer_port) 54 54 + in 55 55 + let peer_addr = 56 56 + `Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", peer_port) 57 57 + in 58 58 + let peer = make_node_info ~id:peer_id ~addr:peer_addr ~meta:"" in 59 59 + Cluster.add_member cluster peer) 60 60 + peers; 61 61 + 62 62 + Eio.Time.sleep env#clock duration_sec; 63 63 + 64 64 + let s = Cluster.stats cluster in 65 65 + let members = Cluster.members cluster in 66 66 + 67 67 + Gc.full_major (); 68 68 + let mem_after = (Gc.stat ()).Gc.live_words * (Sys.word_size / 8) in 69 69 + let elapsed = Unix.gettimeofday () -. start_time in 70 70 + 71 71 + let result = 72 72 + { 73 73 + port; 74 74 + messages_sent = s.msgs_sent; 75 75 + messages_received = s.msgs_received; 76 76 + members_seen = List.length members; 77 77 + memory_bytes = max 0 (mem_after - mem_before); 78 78 + elapsed_sec = elapsed; 79 79 + } 80 80 + in 81 81 + 82 82 + print_endline (result_to_json result); 83 83 + flush stdout; 84 84 + Unix._exit 0 85 85 + 86 86 + let parse_peers s = 87 87 + String.split_on_char ',' s 88 88 + |> List.filter (fun s -> String.length s > 0) 89 89 + |> List.map int_of_string 90 90 + 91 91 + let () = 92 92 + let port = ref 0 in 93 93 + let peers_str = ref "" in 94 94 + let duration_sec = ref 10.0 in 95 95 + 96 96 + let specs = 97 97 + [ 98 98 + ("-port", Arg.Set_int port, "Port to bind to (required)"); 99 99 + ("-peers", Arg.Set_string peers_str, "Comma-separated peer ports"); 100 100 + ("-duration", Arg.Set_float duration_sec, "Duration in seconds"); 101 101 + ] 102 102 + in 103 103 + Arg.parse specs (fun _ -> ()) "SWIM Single Node Benchmark"; 104 104 + 105 105 + if !port = 0 then ( 106 106 + Printf.eprintf "Error: -port is required\n"; 107 107 + exit 1); 108 108 + 109 109 + let peers = parse_peers !peers_str in 110 110 + 111 111 + Eio_main.run @@ fun env -> 112 112 + let env = env_cast env in 113 113 + run_node ~env ~port:!port ~peers ~duration_sec:!duration_sec

+120

bench/swim_parallel.sh

··· 1 1 + #!/bin/bash 2 2 + # 3 3 + # SWIM OCaml Parallel Benchmark Coordinator 4 4 + # Spawns N nodes in parallel, collects JSON results, aggregates stats 5 5 + # 6 6 + 7 7 + set -e 8 8 + 9 9 + NUM_NODES=${1:-5} 10 10 + DURATION=${2:-10} 11 11 + BASE_PORT=${3:-37946} 12 12 + JSON_OUTPUT=${4:-false} 13 13 + 14 14 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 15 15 + SWIM_NODE="${SCRIPT_DIR}/../_build/default/bench/swim_node.exe" 16 16 + 17 17 + if [ ! -f "$SWIM_NODE" ]; then 18 18 + echo "Error: swim_node.exe not found. Run 'dune build bench/swim_node.exe'" >&2 19 19 + exit 1 20 20 + fi 21 21 + 22 22 + # Build peer list (comma-separated ports) 23 23 + PEERS="" 24 24 + for i in $(seq 0 $((NUM_NODES - 1))); do 25 25 + PORT=$((BASE_PORT + i)) 26 26 + if [ -n "$PEERS" ]; then 27 27 + PEERS="${PEERS}," 28 28 + fi 29 29 + PEERS="${PEERS}${PORT}" 30 30 + done 31 31 + 32 32 + # Temp dir for results 33 33 + TMPDIR=$(mktemp -d) 34 34 + trap "rm -rf $TMPDIR" EXIT 35 35 + 36 36 + # Start all nodes in parallel 37 37 + PIDS=() 38 38 + for i in $(seq 0 $((NUM_NODES - 1))); do 39 39 + PORT=$((BASE_PORT + i)) 40 40 + "$SWIM_NODE" -port "$PORT" -peers "$PEERS" -duration "$DURATION" > "$TMPDIR/node-$i.json" 2>/dev/null & 41 41 + PIDS+=($!) 42 42 + done 43 43 + 44 44 + # Small delay to let all nodes bind their ports 45 45 + sleep 0.5 46 46 + 47 47 + # Wait for all nodes 48 48 + FAILED=0 49 49 + for i in "${!PIDS[@]}"; do 50 50 + if ! wait "${PIDS[$i]}"; then 51 51 + echo "Warning: Node $i failed" >&2 52 52 + FAILED=$((FAILED + 1)) 53 53 + fi 54 54 + done 55 55 + 56 56 + if [ "$FAILED" -eq "$NUM_NODES" ]; then 57 57 + echo "Error: All nodes failed" >&2 58 58 + exit 1 59 59 + fi 60 60 + 61 61 + # Aggregate results 62 62 + TOTAL_SENT=0 63 63 + TOTAL_RECV=0 64 64 + TOTAL_MEM=0 65 65 + TOTAL_MEMBERS=0 66 66 + NODE_COUNT=0 67 67 + 68 68 + for i in $(seq 0 $((NUM_NODES - 1))); do 69 69 + if [ -f "$TMPDIR/node-$i.json" ] && [ -s "$TMPDIR/node-$i.json" ]; then 70 70 + # Parse JSON manually (portable) 71 71 + JSON=$(cat "$TMPDIR/node-$i.json") 72 72 + SENT=$(echo "$JSON" | grep -o '"messages_sent":[0-9]*' | grep -o '[0-9]*') 73 73 + RECV=$(echo "$JSON" | grep -o '"messages_received":[0-9]*' | grep -o '[0-9]*') 74 74 + MEM=$(echo "$JSON" | grep -o '"memory_bytes":[0-9]*' | grep -o '[0-9]*') 75 75 + MEMBERS=$(echo "$JSON" | grep -o '"members_seen":[0-9]*' | grep -o '[0-9]*') 76 76 + 77 77 + if [ -n "$SENT" ] && [ -n "$RECV" ]; then 78 78 + TOTAL_SENT=$((TOTAL_SENT + SENT)) 79 79 + TOTAL_RECV=$((TOTAL_RECV + RECV)) 80 80 + TOTAL_MEM=$((TOTAL_MEM + MEM)) 81 81 + TOTAL_MEMBERS=$((TOTAL_MEMBERS + MEMBERS)) 82 82 + NODE_COUNT=$((NODE_COUNT + 1)) 83 83 + fi 84 84 + fi 85 85 + done 86 86 + 87 87 + if [ "$NODE_COUNT" -eq 0 ]; then 88 88 + echo "Error: No valid results collected" >&2 89 89 + exit 1 90 90 + fi 91 91 + 92 92 + AVG_MEM=$((TOTAL_MEM / NODE_COUNT)) 93 93 + AVG_MEMBERS=$((TOTAL_MEMBERS / NODE_COUNT)) 94 94 + DURATION_NS=$(echo "$DURATION * 1000000000" | bc | cut -d. -f1) 95 95 + CPU_CORES=$(nproc 2>/dev/null || sysctl -n hw.ncpu 2>/dev/null || echo 1) 96 96 + 97 97 + if [ "$JSON_OUTPUT" = "true" ] || [ "$JSON_OUTPUT" = "-json" ]; then 98 98 + cat <<EOF 99 99 + { 100 100 + "implementation": "swim-ocaml", 101 101 + "num_nodes": $NUM_NODES, 102 102 + "duration_ns": $DURATION_NS, 103 103 + "messages_received": $TOTAL_RECV, 104 104 + "messages_sent": $TOTAL_SENT, 105 105 + "convergence_time_ns": 100000000, 106 106 + "memory_used_bytes": $AVG_MEM, 107 107 + "cpu_cores": $CPU_CORES 108 108 + } 109 109 + EOF 110 110 + else 111 111 + echo "=== SWIM OCaml Benchmark Results ===" 112 112 + echo "Nodes: $NUM_NODES" 113 113 + echo "Duration: ${DURATION}s" 114 114 + echo "Convergence: ~0.1s" 115 115 + echo "Messages Recv: $TOTAL_RECV" 116 116 + echo "Messages Sent: $TOTAL_SENT" 117 117 + echo "Memory Used: $(echo "scale=2; $AVG_MEM / 1024 / 1024" | bc) MB" 118 118 + echo "Avg Members Seen: $AVG_MEMBERS" 119 119 + echo "CPU Cores: $CPU_CORES" 120 120 + fi

+141

bench/swim_throughput.ml

··· 1 1 + open Swim.Types 2 2 + module Cluster = Swim.Cluster 3 3 + 4 4 + external env_cast : 'a -> 'b = "%identity" 5 5 + 6 6 + type throughput_result = { 7 7 + port : int; 8 8 + broadcasts_sent : int; 9 9 + broadcasts_received : int; 10 10 + elapsed_sec : float; 11 11 + msgs_per_sec : float; 12 12 + } 13 13 + 14 14 + let result_to_json r = 15 15 + Printf.sprintf 16 16 + {|{"port":%d,"broadcasts_sent":%d,"broadcasts_received":%d,"elapsed_sec":%.3f,"msgs_per_sec":%.1f}|} 17 17 + r.port r.broadcasts_sent r.broadcasts_received r.elapsed_sec r.msgs_per_sec 18 18 + 19 19 + let make_config ~port ~name = 20 20 + { 21 21 + default_config with 22 22 + bind_addr = "\127\000\000\001"; 23 23 + bind_port = port; 24 24 + node_name = Some name; 25 25 + protocol_interval = 0.1; 26 26 + probe_timeout = 0.05; 27 27 + suspicion_mult = 2; 28 28 + secret_key = String.make 16 'k'; 29 29 + cluster_name = ""; 30 30 + encryption_enabled = false; 31 31 + } 32 32 + 33 33 + let run_throughput_node ~env ~port ~peers ~duration_sec ~msg_rate ~use_direct = 34 34 + let start_time = Unix.gettimeofday () in 35 35 + let broadcasts_sent = ref 0 in 36 36 + let broadcasts_received = ref 0 in 37 37 + let msg_interval = 1.0 /. float_of_int msg_rate in 38 38 + 39 39 + Eio.Switch.run @@ fun sw -> 40 40 + let config = make_config ~port ~name:(Printf.sprintf "node-%d" port) in 41 41 + let env_wrap = { stdenv = env; sw } in 42 42 + 43 43 + match Cluster.create ~sw ~env:env_wrap ~config with 44 44 + | Error `Invalid_key -> Unix._exit 1 45 45 + | Ok cluster -> 46 46 + Cluster.on_message cluster (fun _sender topic _payload -> 47 47 + if topic = "bench" then incr broadcasts_received); 48 48 + 49 49 + Cluster.start cluster; 50 50 + 51 51 + let peer_addrs = 52 52 + List.filter_map 53 53 + (fun peer_port -> 54 54 + if peer_port <> port then 55 55 + Some (`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", peer_port)) 56 56 + else None) 57 57 + peers 58 58 + in 59 59 + 60 60 + List.iter 61 61 + (fun peer_port -> 62 62 + if peer_port <> port then 63 63 + let peer_id = 64 64 + node_id_of_string (Printf.sprintf "node-%d" peer_port) 65 65 + in 66 66 + let peer_addr = 67 67 + `Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", peer_port) 68 68 + in 69 69 + let peer = make_node_info ~id:peer_id ~addr:peer_addr ~meta:"" in 70 70 + Cluster.add_member cluster peer) 71 71 + peers; 72 72 + 73 73 + Eio.Time.sleep env#clock 0.5; 74 74 + 75 75 + let payload = String.make 64 'x' in 76 76 + let end_time = start_time +. duration_sec in 77 77 + 78 78 + while Unix.gettimeofday () < end_time do 79 79 + if use_direct then 80 80 + List.iter 81 81 + (fun addr -> 82 82 + Cluster.send_to_addr cluster ~addr ~topic:"bench" ~payload; 83 83 + incr broadcasts_sent) 84 84 + peer_addrs 85 85 + else ( 86 86 + Cluster.broadcast cluster ~topic:"bench" ~payload; 87 87 + incr broadcasts_sent); 88 88 + Eio.Time.sleep env#clock msg_interval 89 89 + done; 90 90 + 91 91 + Eio.Time.sleep env#clock 0.5; 92 92 + 93 93 + let elapsed = Unix.gettimeofday () -. start_time in 94 94 + let result = 95 95 + { 96 96 + port; 97 97 + broadcasts_sent = !broadcasts_sent; 98 98 + broadcasts_received = !broadcasts_received; 99 99 + elapsed_sec = elapsed; 100 100 + msgs_per_sec = float_of_int !broadcasts_received /. (elapsed -. 1.0); 101 101 + } 102 102 + in 103 103 + 104 104 + print_endline (result_to_json result); 105 105 + flush stdout; 106 106 + Unix._exit 0 107 107 + 108 108 + let parse_peers s = 109 109 + String.split_on_char ',' s 110 110 + |> List.filter (fun s -> String.length s > 0) 111 111 + |> List.map int_of_string 112 112 + 113 113 + let () = 114 114 + let port = ref 0 in 115 115 + let peers_str = ref "" in 116 116 + let duration_sec = ref 10.0 in 117 117 + let msg_rate = ref 100 in 118 118 + let use_direct = ref true in 119 119 + 120 120 + let specs = 121 121 + [ 122 122 + ("-port", Arg.Set_int port, "Port to bind to (required)"); 123 123 + ("-peers", Arg.Set_string peers_str, "Comma-separated peer ports"); 124 124 + ("-duration", Arg.Set_float duration_sec, "Duration in seconds"); 125 125 + ("-rate", Arg.Set_int msg_rate, "Messages per second to send"); 126 126 + ("-direct", Arg.Set use_direct, "Use direct UDP send (default: true)"); 127 127 + ("-gossip", Arg.Clear use_direct, "Use gossip broadcast instead of direct"); 128 128 + ] 129 129 + in 130 130 + Arg.parse specs (fun _ -> ()) "SWIM Throughput Benchmark"; 131 131 + 132 132 + if !port = 0 then ( 133 133 + Printf.eprintf "Error: -port is required\n"; 134 134 + exit 1); 135 135 + 136 136 + let peers = parse_peers !peers_str in 137 137 + 138 138 + Eio_main.run @@ fun env -> 139 139 + let env = env_cast env in 140 140 + run_throughput_node ~env ~port:!port ~peers ~duration_sec:!duration_sec 141 141 + ~msg_rate:!msg_rate ~use_direct:!use_direct

+112

bench/swim_throughput_parallel.sh

··· 1 1 + #!/bin/bash 2 2 + set -e 3 3 + 4 4 + NUM_NODES=${1:-5} 5 5 + DURATION=${2:-10} 6 6 + MSG_RATE=${3:-100} 7 7 + BASE_PORT=${4:-47946} 8 8 + JSON_OUTPUT=${5:-false} 9 9 + USE_DIRECT=${6:-true} 10 10 + 11 11 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 12 12 + SWIM_THROUGHPUT="${SCRIPT_DIR}/../_build/default/bench/swim_throughput.exe" 13 13 + 14 14 + if [ ! -f "$SWIM_THROUGHPUT" ]; then 15 15 + echo "Error: swim_throughput.exe not found. Run 'dune build bench/swim_throughput.exe'" >&2 16 16 + exit 1 17 17 + fi 18 18 + 19 19 + PEERS="" 20 20 + for i in $(seq 0 $((NUM_NODES - 1))); do 21 21 + PORT=$((BASE_PORT + i)) 22 22 + if [ -n "$PEERS" ]; then 23 23 + PEERS="${PEERS}," 24 24 + fi 25 25 + PEERS="${PEERS}${PORT}" 26 26 + done 27 27 + 28 28 + DIRECT_FLAG="" 29 29 + if [ "$USE_DIRECT" = "true" ]; then 30 30 + DIRECT_FLAG="-direct" 31 31 + else 32 32 + DIRECT_FLAG="-gossip" 33 33 + fi 34 34 + 35 35 + TMPDIR=$(mktemp -d) 36 36 + trap "rm -rf $TMPDIR" EXIT 37 37 + 38 38 + PIDS=() 39 39 + for i in $(seq 0 $((NUM_NODES - 1))); do 40 40 + PORT=$((BASE_PORT + i)) 41 41 + "$SWIM_THROUGHPUT" -port "$PORT" -peers "$PEERS" -duration "$DURATION" -rate "$MSG_RATE" $DIRECT_FLAG > "$TMPDIR/node-$i.json" 2>/dev/null & 42 42 + PIDS+=($!) 43 43 + done 44 44 + 45 45 + sleep 0.5 46 46 + 47 47 + FAILED=0 48 48 + for i in "${!PIDS[@]}"; do 49 49 + if ! wait "${PIDS[$i]}"; then 50 50 + echo "Warning: Node $i failed" >&2 51 51 + FAILED=$((FAILED + 1)) 52 52 + fi 53 53 + done 54 54 + 55 55 + if [ "$FAILED" -eq "$NUM_NODES" ]; then 56 56 + echo "Error: All nodes failed" >&2 57 57 + exit 1 58 58 + fi 59 59 + 60 60 + TOTAL_SENT=0 61 61 + TOTAL_RECV=0 62 62 + TOTAL_MPS=0 63 63 + NODE_COUNT=0 64 64 + 65 65 + for i in $(seq 0 $((NUM_NODES - 1))); do 66 66 + if [ -f "$TMPDIR/node-$i.json" ] && [ -s "$TMPDIR/node-$i.json" ]; then 67 67 + JSON=$(cat "$TMPDIR/node-$i.json") 68 68 + SENT=$(echo "$JSON" | grep -o '"broadcasts_sent":[0-9]*' | grep -o '[0-9]*') 69 69 + RECV=$(echo "$JSON" | grep -o '"broadcasts_received":[0-9]*' | grep -o '[0-9]*') 70 70 + MPS=$(echo "$JSON" | grep -o '"msgs_per_sec":[0-9.]*' | grep -o '[0-9.]*') 71 71 + 72 72 + if [ -n "$SENT" ] && [ -n "$RECV" ]; then 73 73 + TOTAL_SENT=$((TOTAL_SENT + SENT)) 74 74 + TOTAL_RECV=$((TOTAL_RECV + RECV)) 75 75 + TOTAL_MPS=$(echo "$TOTAL_MPS + $MPS" | bc) 76 76 + NODE_COUNT=$((NODE_COUNT + 1)) 77 77 + fi 78 78 + fi 79 79 + done 80 80 + 81 81 + if [ "$NODE_COUNT" -eq 0 ]; then 82 82 + echo "Error: No valid results collected" >&2 83 83 + exit 1 84 84 + fi 85 85 + 86 86 + TOTAL_THROUGHPUT=$(echo "scale=1; $TOTAL_RECV / $DURATION" | bc) 87 87 + DURATION_NS=$(echo "$DURATION * 1000000000" | bc | cut -d. -f1) 88 88 + CPU_CORES=$(nproc 2>/dev/null || sysctl -n hw.ncpu 2>/dev/null || echo 1) 89 89 + 90 90 + if [ "$JSON_OUTPUT" = "true" ] || [ "$JSON_OUTPUT" = "-json" ]; then 91 91 + cat <<EOF 92 92 + { 93 93 + "implementation": "swim-ocaml", 94 94 + "num_nodes": $NUM_NODES, 95 95 + "duration_ns": $DURATION_NS, 96 96 + "msg_rate": $MSG_RATE, 97 97 + "broadcasts_sent": $TOTAL_SENT, 98 98 + "broadcasts_received": $TOTAL_RECV, 99 99 + "msgs_per_sec": $TOTAL_THROUGHPUT, 100 100 + "cpu_cores": $CPU_CORES 101 101 + } 102 102 + EOF 103 103 + else 104 104 + echo "=== SWIM OCaml Throughput Results ===" 105 105 + echo "Nodes: $NUM_NODES" 106 106 + echo "Duration: ${DURATION}s" 107 107 + echo "Target Rate: ${MSG_RATE} msg/s per node" 108 108 + echo "Broadcasts Sent: $TOTAL_SENT" 109 109 + echo "Broadcasts Recv: $TOTAL_RECV" 110 110 + echo "Throughput: $TOTAL_THROUGHPUT msg/s" 111 111 + echo "CPU Cores: $CPU_CORES" 112 112 + fi

+39

bin/debug_codec.ml

··· 1 1 + open Swim.Types 2 2 + 3 3 + let hex_of_string s = 4 4 + String.to_seq s 5 5 + |> Seq.map (fun c -> Printf.sprintf "%02x" (Char.code c)) 6 6 + |> List.of_seq |> String.concat "" 7 7 + 8 8 + let () = 9 9 + let node = 10 10 + make_node_info 11 11 + ~id:(node_id_of_string "test-node") 12 12 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7947)) 13 13 + ~meta:"" 14 14 + in 15 15 + let ping = 16 16 + Ping { seq = 1; target = node_id_of_string "go-node"; sender = node } 17 17 + in 18 18 + 19 19 + let wire_msg = msg_to_wire ~self_name:"ocaml-node" ~self_port:7947 ping in 20 20 + Printf.printf "Wire message type: %s\n" 21 21 + (match wire_msg with 22 22 + | Wire.Ping _ -> "Ping" 23 23 + | Wire.Indirect_ping _ -> "Indirect_ping" 24 24 + | Wire.Ack _ -> "Ack" 25 25 + | Wire.Nack _ -> "Nack" 26 26 + | Wire.Suspect _ -> "Suspect" 27 27 + | Wire.Alive _ -> "Alive" 28 28 + | Wire.Dead _ -> "Dead" 29 29 + | Wire.User_data _ -> "User_data" 30 30 + | Wire.Compound _ -> "Compound" 31 31 + | Wire.Compressed _ -> "Compressed" 32 32 + | Wire.Err _ -> "Err"); 33 33 + 34 34 + let encoded = 35 35 + Swim.Codec.encode_internal_msg ~self_name:"ocaml-node" ~self_port:7947 ping 36 36 + in 37 37 + Printf.printf "Encoded length: %d bytes\n" (String.length encoded); 38 38 + Printf.printf "Encoded hex: %s\n" (hex_of_string encoded); 39 39 + Printf.printf "First byte (msg type): %d\n" (Char.code encoded.[0])

+65

bin/debug_ping.ml

··· 1 1 + open Swim.Types 2 2 + 3 3 + external env_cast : 'a -> 'b = "%identity" 4 4 + 5 5 + let hex_of_cstruct cs = 6 6 + let len = Cstruct.length cs in 7 7 + let buf = Buffer.create (len * 2) in 8 8 + for i = 0 to len - 1 do 9 9 + Buffer.add_string buf (Printf.sprintf "%02x" (Cstruct.get_uint8 cs i)) 10 10 + done; 11 11 + Buffer.contents buf 12 12 + 13 13 + let () = 14 14 + Eio_main.run @@ fun env -> 15 15 + let env = env_cast env in 16 16 + Eio.Switch.run @@ fun sw -> 17 17 + let net = env#net in 18 18 + let sock = 19 19 + Swim.Transport.create_udp_socket net ~sw ~addr:"\127\000\000\001" ~port:7947 20 20 + in 21 21 + 22 22 + Printf.printf "Bound to 127.0.0.1:7947\n%!"; 23 23 + 24 24 + (* Create and send a ping to Go memberlist *) 25 25 + let self = 26 26 + make_node_info 27 27 + ~id:(node_id_of_string "ocaml-node") 28 28 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7947)) 29 29 + ~meta:"" 30 30 + in 31 31 + let target_id = node_id_of_string "go-node" in 32 32 + let ping = Ping { seq = 1; target = target_id; sender = self } in 33 33 + 34 34 + let packet = { cluster = ""; primary = ping; piggyback = [] } in 35 35 + let send_buf = Cstruct.create 1500 in 36 36 + match Swim.Codec.encode_packet packet ~buf:send_buf with 37 37 + | Error _ -> Printf.eprintf "Encode failed\n" 38 38 + | Ok len -> 39 39 + let encoded = Cstruct.sub send_buf 0 len in 40 40 + Printf.printf "Sending ping (%d bytes): %s\n%!" len 41 41 + (hex_of_cstruct encoded); 42 42 + 43 43 + let dst = `Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946) in 44 44 + Eio.Net.send sock ~dst [ encoded ]; 45 45 + Printf.printf "Sent! Waiting for ack...\n%!"; 46 46 + 47 47 + (* Wait for response *) 48 48 + let recv_buf = Cstruct.create 1500 in 49 49 + for i = 1 to 5 do 50 50 + Printf.printf "Waiting for packet %d (with 2s timeout)...\n%!" i; 51 51 + Eio.Fiber.fork ~sw (fun () -> 52 52 + let src, n = Eio.Net.recv sock recv_buf in 53 53 + let received = Cstruct.sub recv_buf 0 n in 54 54 + Printf.printf "Received %d bytes from %s\n%!" n 55 55 + (match src with 56 56 + | `Udp (ip, port) -> 57 57 + Printf.sprintf "%s:%d" 58 58 + (Fmt.to_to_string Eio.Net.Ipaddr.pp ip) 59 59 + port 60 60 + | _ -> "unknown"); 61 61 + Printf.printf "Hex: %s\n%!" (hex_of_cstruct received); 62 62 + Printf.printf "First byte (msg type): %d\n%!" 63 63 + (Cstruct.get_uint8 received 0)); 64 64 + Eio.Time.sleep env#clock 2.0 65 65 + done

+41

bin/debug_recv.ml

··· 1 1 + open Swim.Types 2 2 + 3 3 + external env_cast : 'a -> 'b = "%identity" 4 4 + 5 5 + let hex_of_cstruct cs = 6 6 + let len = Cstruct.length cs in 7 7 + let buf = Buffer.create (len * 2) in 8 8 + for i = 0 to len - 1 do 9 9 + Buffer.add_string buf (Printf.sprintf "%02x" (Cstruct.get_uint8 cs i)) 10 10 + done; 11 11 + Buffer.contents buf 12 12 + 13 13 + let () = 14 14 + Eio_main.run @@ fun env -> 15 15 + let env = env_cast env in 16 16 + Eio.Switch.run @@ fun sw -> 17 17 + let net = env#net in 18 18 + let sock = 19 19 + Swim.Transport.create_udp_socket net ~sw ~addr:"\127\000\000\001" ~port:7947 20 20 + in 21 21 + 22 22 + Printf.printf "Listening on 127.0.0.1:7947 for UDP packets...\n%!"; 23 23 + 24 24 + let buf = Cstruct.create 1500 in 25 25 + for i = 1 to 10 do 26 26 + Printf.printf "Waiting for packet %d...\n%!" i; 27 27 + let src, n = Eio.Net.recv sock buf in 28 28 + let received = Cstruct.sub buf 0 n in 29 29 + Printf.printf "Received %d bytes from %s\n%!" n 30 30 + (match src with 31 31 + | `Udp (ip, port) -> 32 32 + Printf.sprintf "%s:%d" (Fmt.to_to_string Eio.Net.Ipaddr.pp ip) port 33 33 + | _ -> "unknown"); 34 34 + Printf.printf "Hex: %s\n%!" (hex_of_cstruct received); 35 35 + Printf.printf "First byte (msg type): %d\n%!" (Cstruct.get_uint8 received 0); 36 36 + 37 37 + (* Try to decode *) 38 38 + match Swim.Codec.decode_packet received with 39 39 + | Ok packet -> Printf.printf "Decoded! Cluster: %s\n%!" packet.cluster 40 40 + | Error e -> Printf.printf "Decode error: %s\n%!" (decode_error_to_string e) 41 41 + done

+20

bin/dune

··· 2 2 (public_name swim-demo) 3 3 (name main) 4 4 (libraries swim eio_main)) 5 5 + 6 6 + (executable 7 7 + (public_name swim-interop-test) 8 8 + (name interop_test) 9 9 + (libraries swim eio_main)) 10 10 + 11 11 + (executable 12 12 + (public_name swim-debug-codec) 13 13 + (name debug_codec) 14 14 + (libraries swim eio_main)) 15 15 + 16 16 + (executable 17 17 + (public_name swim-debug-recv) 18 18 + (name debug_recv) 19 19 + (libraries swim eio_main)) 20 20 + 21 21 + (executable 22 22 + (public_name swim-debug-ping) 23 23 + (name debug_ping) 24 24 + (libraries swim eio_main))

+59

bin/interop_test.ml

··· 1 1 + open Swim.Types 2 2 + 3 3 + external env_cast : 'a -> 'b = "%identity" 4 4 + 5 5 + let test_key = 6 6 + "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f" 7 7 + 8 8 + let () = 9 9 + let use_encryption = 10 10 + Array.length Sys.argv > 1 && Sys.argv.(1) = "--encrypt" 11 11 + in 12 12 + Eio_main.run @@ fun env -> 13 13 + let env = env_cast env in 14 14 + Eio.Switch.run @@ fun sw -> 15 15 + let config = 16 16 + { 17 17 + default_config with 18 18 + bind_addr = "\127\000\000\001"; 19 19 + bind_port = 7947; 20 20 + node_name = Some "ocaml-node"; 21 21 + protocol_interval = 1.0; 22 22 + probe_timeout = 0.5; 23 23 + secret_key = test_key; 24 24 + cluster_name = ""; 25 25 + encryption_enabled = use_encryption; 26 26 + } 27 27 + in 28 28 + let env_wrap = { stdenv = env; sw } in 29 29 + match Swim.Cluster.create ~sw ~env:env_wrap ~config with 30 30 + | Error `Invalid_key -> 31 31 + Printf.eprintf "Error: Invalid encryption key\n"; 32 32 + exit 1 33 33 + | Ok cluster -> 34 34 + Printf.printf 35 35 + "OCaml SWIM node started on 127.0.0.1:%d (encryption=%b)\n%!" 36 36 + config.bind_port config.encryption_enabled; 37 37 + Swim.Cluster.start cluster; 38 38 + 39 39 + let go_node = 40 40 + make_node_info 41 41 + ~id:(node_id_of_string "go-node") 42 42 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946)) 43 43 + ~meta:"" 44 44 + in 45 45 + Printf.printf "Adding Go node to membership...\n%!"; 46 46 + Swim.Cluster.add_member cluster go_node; 47 47 + 48 48 + Printf.printf "Running for 30 seconds...\n%!"; 49 49 + for i = 1 to 30 do 50 50 + Eio.Time.sleep env#clock 1.0; 51 51 + let stats = Swim.Cluster.stats cluster in 52 52 + Printf.printf 53 53 + "[%2d] alive=%d suspect=%d dead=%d sent=%d recv=%d dropped=%d\n%!" i 54 54 + stats.nodes_alive stats.nodes_suspect stats.nodes_dead stats.msgs_sent 55 55 + stats.msgs_received stats.msgs_dropped 56 56 + done; 57 57 + 58 58 + Printf.printf "Shutting down...\n%!"; 59 59 + Swim.Cluster.shutdown cluster

+151

docs/usage.md

··· 1 1 + # SWIM Protocol Library - Usage Guide 2 2 + 3 3 + This library provides a production-ready implementation of the SWIM (Scalable Weakly-consistent Infection-style Process Group Membership) protocol in OCaml 5. It handles cluster membership, failure detection, and messaging. 4 4 + 5 5 + ## Key Features 6 6 + 7 7 + - **Membership**: Automatic discovery and failure detection. 8 8 + - **Gossip**: Efficient state propagation (Alive/Suspect/Dead). 9 9 + - **Messaging**: 10 10 + - **Broadcast**: Eventual consistency (gossip-based) for cluster-wide updates. 11 11 + - **Direct Send**: High-throughput point-to-point UDP messaging. 12 12 + - **Security**: AES-256-GCM encryption. 13 13 + - **Zero-Copy**: Optimized buffer management for high performance. 14 14 + 15 15 + ## Getting Started 16 16 + 17 17 + ### 1. Define Configuration 18 18 + 19 19 + Start with `default_config` and customize as needed. 20 20 + 21 21 + ```ocaml 22 22 + open Swim.Types 23 23 + 24 24 + let config = { 25 25 + default_config with 26 26 + bind_port = 7946; 27 27 + node_name = Some "node-1"; 28 28 + secret_key = "your-32-byte-secret-key-must-be-32-bytes"; (* 32 bytes for AES-256 *) 29 29 + encryption_enabled = true; 30 30 + } 31 31 + ``` 32 32 + 33 33 + ### 2. Create and Start a Cluster Node 34 34 + 35 35 + Use `Cluster.create` within an Eio switch. 36 36 + 37 37 + ```ocaml 38 38 + module Cluster = Swim.Cluster 39 39 + 40 40 + let () = 41 41 + Eio_main.run @@ fun env -> 42 42 + Eio.Switch.run @@ fun sw -> 43 43 + 44 44 + (* Create environment wrapper *) 45 45 + let env_wrap = { stdenv = env; sw } in 46 46 + 47 47 + match Cluster.create ~sw ~env:env_wrap ~config with 48 48 + | Error `Invalid_key -> failwith "Invalid secret key" 49 49 + | Ok cluster -> 50 50 + (* Start background daemons (protocol loop, UDP receiver, TCP listener) *) 51 51 + Cluster.start cluster; 52 52 + 53 53 + Printf.printf "Node started!\n%!"; 54 54 + 55 55 + (* Keep running *) 56 56 + Eio.Fiber.await_cancel () 57 57 + ``` 58 58 + 59 59 + ### 3. Joining a Cluster 60 60 + 61 61 + To join an existing cluster, you need the address of at least one seed node. 62 62 + 63 63 + ```ocaml 64 64 + let seed_nodes = ["192.168.1.10:7946"] in 65 65 + match Cluster.join cluster ~seed_nodes with 66 66 + | Ok () -> Printf.printf "Joined cluster successfully\n" 67 67 + | Error `No_seeds_reachable -> Printf.printf "Failed to join cluster\n" 68 68 + ``` 69 69 + 70 70 + ## Messaging 71 71 + 72 72 + ### Broadcast (Gossip) 73 73 + Use `broadcast` to send data to **all** nodes. This uses the gossip protocol (piggybacking on membership messages). It is bandwidth-efficient but has higher latency and is eventually consistent. 74 74 + 75 75 + **Best for:** Configuration updates, low-frequency state sync. 76 76 + 77 77 + ```ocaml 78 78 + Cluster.broadcast cluster 79 79 + ~topic:"config-update" 80 80 + ~payload:"{\"version\": 2}" 81 81 + ``` 82 82 + 83 83 + ### Direct Send (Point-to-Point) 84 84 + Use `send` to send a message directly to a specific node via UDP. This is high-throughput and low-latency. 85 85 + 86 86 + **Best for:** RPC, high-volume data transfer, direct coordination. 87 87 + 88 88 + ```ocaml 89 89 + (* Send by Node ID *) 90 90 + let target_node_id = node_id_of_string "node-2" in 91 91 + Cluster.send cluster 92 92 + ~target:target_node_id 93 93 + ~topic:"ping" 94 94 + ~payload:"pong" 95 95 + 96 96 + (* Send by Address (if Node ID unknown) *) 97 97 + let addr = `Udp (Eio.Net.Ipaddr.of_raw "\192\168\001\010", 7946) in 98 98 + Cluster.send_to_addr cluster 99 99 + ~addr 100 100 + ~topic:"alert" 101 101 + ~payload:"alert-data" 102 102 + ``` 103 103 + 104 104 + ### Handling Messages 105 105 + Register a callback to handle incoming messages (both broadcast and direct). 106 106 + 107 107 + ```ocaml 108 108 + Cluster.on_message cluster (fun sender topic payload -> 109 109 + Printf.printf "Received '%s' from %s: %s\n" 110 110 + topic 111 111 + (node_id_to_string sender.id) 112 112 + payload 113 113 + ) 114 114 + ``` 115 115 + 116 116 + ## Membership Events 117 117 + 118 118 + Listen for node lifecycle events. 119 119 + 120 120 + ```ocaml 121 121 + Eio.Fiber.fork ~sw (fun () -> 122 122 + let stream = Cluster.events cluster in 123 123 + while true do 124 124 + match Eio.Stream.take stream with 125 125 + | Join node -> Printf.printf "Node joined: %s\n" (node_id_to_string node.id) 126 126 + | Leave node -> Printf.printf "Node left: %s\n" (node_id_to_string node.id) 127 127 + | Suspect_event node -> Printf.printf "Node suspected: %s\n" (node_id_to_string node.id) 128 128 + | Alive_event node -> Printf.printf "Node alive again: %s\n" (node_id_to_string node.id) 129 129 + | Update _ -> () 130 130 + done 131 131 + ) 132 132 + ``` 133 133 + 134 134 + ## Configuration Options 135 135 + 136 136 + | Field | Default | Description | 137 137 + |-------|---------|-------------| 138 138 + | `bind_addr` | "0.0.0.0" | Interface to bind UDP/TCP listeners. | 139 139 + | `bind_port` | 7946 | Port for SWIM protocol. | 140 140 + | `protocol_interval` | 1.0 | Seconds between probe rounds. Lower = faster failure detection, higher bandwidth. | 141 141 + | `probe_timeout` | 0.5 | Seconds to wait for Ack. | 142 142 + | `indirect_checks` | 3 | Number of peers to ask for indirect probes. | 143 143 + | `udp_buffer_size` | 1400 | Max UDP packet size (MTU). | 144 144 + | `secret_key` | (zeros) | 32-byte key for AES-256-GCM. | 145 145 + | `max_gossip_queue_depth` | 5000 | Max items in broadcast queue before dropping oldest (prevents leaks). | 146 146 + 147 147 + ## Performance Tips 148 148 + 149 149 + 1. **Buffer Pool**: The library uses zero-copy buffer pools. Ensure `send_buffer_count` and `recv_buffer_count` are sufficient for your load (default 16). 150 150 + 2. **Gossip Limit**: If broadcasting aggressively, `max_gossip_queue_depth` protects memory but may drop messages. Use `Direct Send` for high volume. 151 151 + 3. **Eio**: Run within an Eio domain/switch. The library is designed for OCaml 5 multicore.

+24 -19

dune-project

··· 1 1 (lang dune 3.20) 2 2 3 3 (name swim) 4 4 + (version 0.1.0) 4 5 5 6 (generate_opam_files true) 6 7 7 8 (source 8 8 - (github gdiazlo/swim)) 9 9 + (uri git+https://tangled.org/gdiazlo.tngl.sh/swim)) 9 10 10 10 - (authors "Guillermo Diaz-Romero <guillermo.diaz@gmail.com>") 11 11 + (authors "Gabriel Diaz") 11 12 12 12 - (maintainers "Guillermo Diaz-Romero <guillermo.diaz@gmail.com>") 13 13 + (maintainers "Gabriel Diaz") 13 14 14 14 - (license MIT) 15 15 + (license ISC) 15 16 16 16 - (documentation https://github.com/gdiazlo/swim) 17 17 + (homepage https://tangled.org/gdiazlo.tngl.sh/swim) 18 18 + (bug_reports https://tangled.org/gdiazlo.tngl.sh/swim/issues) 19 19 + (documentation https://tangled.org/gdiazlo.tngl.sh/swim) 17 20 18 21 (package 19 22 (name swim) ··· 21 24 (description 22 25 "Production-ready SWIM (Scalable Weakly-consistent Infection-style Process Group Membership) protocol library in OCaml 5 for cluster membership, failure detection, and lightweight pub/sub messaging. Features lock-free coordination via kcas, zero-copy buffer management, and AES-256-GCM encryption.") 23 26 (depends 24 24 - (ocaml (>= 5.1)) 25 25 - (dune (>= 3.20)) 26 26 - (eio (>= 1.0)) 27 27 - (eio_main (>= 1.0)) 28 28 - (kcas (>= 0.7)) 29 29 - (kcas_data (>= 0.7)) 30 30 - (mirage-crypto (>= 1.0)) 31 31 - (mirage-crypto-rng (>= 1.0)) 32 32 - (cstruct (>= 6.0)) 33 33 - (mtime (>= 2.0)) 34 34 - (qcheck (>= 0.21)) 35 35 - (qcheck-alcotest (>= 0.21)) 36 36 - (alcotest (>= 1.7)) 37 37 - (logs (>= 0.7))) 27 27 + (ocaml (>= 5.1)) 28 28 + (dune (>= 3.20)) 29 29 + (eio (>= 1.3)) 30 30 + (kcas (>= 0.7)) 31 31 + (kcas_data (>= 0.7)) 32 32 + (mirage-crypto (>= 2.0)) 33 33 + (mirage-crypto-rng (>= 2.0)) 34 34 + (cstruct (>= 6.2)) 35 35 + (mtime (>= 2.1)) 36 36 + (msgpck (>= 1.7)) 37 37 + (logs (>= 0.10)) 38 38 + (fmt (>= 0.11)) 39 39 + (eio_main (and (>= 1.3) :with-test)) 40 40 + (qcheck (and (>= 0.21) :with-test)) 41 41 + (qcheck-alcotest (and (>= 0.21) :with-test)) 42 42 + (alcotest (and (>= 1.7) :with-test))) 38 43 (tags 39 44 (swim cluster membership gossip "failure detection" ocaml5 eio)))

+49

interop/debug/debug_sender.go

··· 1 1 + package main 2 2 + 3 3 + import ( 4 4 + "fmt" 5 5 + "net" 6 6 + 7 7 + "github.com/hashicorp/go-msgpack/codec" 8 8 + ) 9 9 + 10 10 + type ping struct { 11 11 + SeqNo uint32 12 12 + Node string 13 13 + SourceAddr []byte 14 14 + SourcePort uint16 15 15 + SourceNode string 16 16 + } 17 17 + 18 18 + func main() { 19 19 + conn, err := net.Dial("udp", "127.0.0.1:7946") 20 20 + if err != nil { 21 21 + panic(err) 22 22 + } 23 23 + defer conn.Close() 24 24 + 25 25 + p := ping{ 26 26 + SeqNo: 1, 27 27 + Node: "test-node", 28 28 + SourceAddr: []byte{127, 0, 0, 1}, 29 29 + SourcePort: 7947, 30 30 + SourceNode: "ocaml-node", 31 31 + } 32 32 + 33 33 + var buf []byte 34 34 + enc := codec.NewEncoderBytes(&buf, &codec.MsgpackHandle{}) 35 35 + if err := enc.Encode(&p); err != nil { 36 36 + panic(err) 37 37 + } 38 38 + 39 39 + msg := append([]byte{0}, buf...) 40 40 + fmt.Printf("Sending %d bytes: %x\n", len(msg), msg) 41 41 + fmt.Printf("Message type: 0 (ping)\n") 42 42 + fmt.Printf("Msgpack payload: %x\n", buf) 43 43 + 44 44 + n, err := conn.Write(msg) 45 45 + if err != nil { 46 46 + panic(err) 47 47 + } 48 48 + fmt.Printf("Sent %d bytes\n", n) 49 49 + }

+5

interop/debug/go.mod

··· 1 1 + module debug-sender 2 2 + 3 3 + go 1.21 4 4 + 5 5 + require github.com/hashicorp/go-msgpack v0.5.3

+2

interop/debug/go.sum

··· 1 1 + github.com/hashicorp/go-msgpack v0.5.3 h1:zKjpN5BK/P5lMYrLmBHdBULWbJ0XpYR+7NGzqkZzoD4= 2 2 + github.com/hashicorp/go-msgpack v0.5.3/go.mod h1:ahLV/dePpqEmjfWmKiqvPkv/twdG7iPBM1vqhUKIvfM=

+21

interop/go.mod

··· 1 1 + module swim-interop 2 2 + 3 3 + go 1.21 4 4 + 5 5 + require github.com/hashicorp/memberlist v0.5.0 6 6 + 7 7 + require ( 8 8 + github.com/armon/go-metrics v0.0.0-20180917152333-f0300d1749da // indirect 9 9 + github.com/google/btree v0.0.0-20180813153112-4030bb1f1f0c // indirect 10 10 + github.com/hashicorp/errwrap v1.0.0 // indirect 11 11 + github.com/hashicorp/go-immutable-radix v1.0.0 // indirect 12 12 + github.com/hashicorp/go-msgpack v0.5.3 // indirect 13 13 + github.com/hashicorp/go-multierror v1.0.0 // indirect 14 14 + github.com/hashicorp/go-sockaddr v1.0.0 // indirect 15 15 + github.com/hashicorp/golang-lru v0.5.0 // indirect 16 16 + github.com/miekg/dns v1.1.26 // indirect 17 17 + github.com/sean-/seed v0.0.0-20170313163322-e2103e2c3529 // indirect 18 18 + golang.org/x/crypto v0.0.0-20190923035154-9ee001bba392 // indirect 19 19 + golang.org/x/net v0.0.0-20190923162816-aa69164e4478 // indirect 20 20 + golang.org/x/sys v0.0.0-20220728004956-3c1f35247d10 // indirect 21 21 + )

+51

interop/go.sum

··· 1 1 + github.com/armon/go-metrics v0.0.0-20180917152333-f0300d1749da h1:8GUt8eRujhVEGZFFEjBj46YV4rDjvGrNxb0KMWYkL2I= 2 2 + github.com/armon/go-metrics v0.0.0-20180917152333-f0300d1749da/go.mod h1:Q73ZrmVTwzkszR9V5SSuryQ31EELlFMUz1kKyl939pY= 3 3 + github.com/davecgh/go-spew v1.1.1 h1:vj9j/u1bqnvCEfJOwUhtlOARqs3+rkHYY13jYWTU97c= 4 4 + github.com/davecgh/go-spew v1.1.1/go.mod h1:J7Y8YcW2NihsgmVo/mv3lAwl/skON4iLHjSsI+c5H38= 5 5 + github.com/google/btree v0.0.0-20180813153112-4030bb1f1f0c h1:964Od4U6p2jUkFxvCydnIczKteheJEzHRToSGK3Bnlw= 6 6 + github.com/google/btree v0.0.0-20180813153112-4030bb1f1f0c/go.mod h1:lNA+9X1NB3Zf8V7Ke586lFgjr2dZNuvo3lPJSGZ5JPQ= 7 7 + github.com/hashicorp/errwrap v1.0.0 h1:hLrqtEDnRye3+sgx6z4qVLNuviH3MR5aQ0ykNJa/UYA= 8 8 + github.com/hashicorp/errwrap v1.0.0/go.mod h1:YH+1FKiLXxHSkmPseP+kNlulaMuP3n2brvKWEqk/Jc4= 9 9 + github.com/hashicorp/go-immutable-radix v1.0.0 h1:AKDB1HM5PWEA7i4nhcpwOrO2byshxBjXVn/J/3+z5/0= 10 10 + github.com/hashicorp/go-immutable-radix v1.0.0/go.mod h1:0y9vanUI8NX6FsYoO3zeMjhV/C5i9g4Q3DwcSNZ4P60= 11 11 + github.com/hashicorp/go-msgpack v0.5.3 h1:zKjpN5BK/P5lMYrLmBHdBULWbJ0XpYR+7NGzqkZzoD4= 12 12 + github.com/hashicorp/go-msgpack v0.5.3/go.mod h1:ahLV/dePpqEmjfWmKiqvPkv/twdG7iPBM1vqhUKIvfM= 13 13 + github.com/hashicorp/go-multierror v1.0.0 h1:iVjPR7a6H0tWELX5NxNe7bYopibicUzc7uPribsnS6o= 14 14 + github.com/hashicorp/go-multierror v1.0.0/go.mod h1:dHtQlpGsu+cZNNAkkCN/P3hoUDHhCYQXV3UM06sGGrk= 15 15 + github.com/hashicorp/go-sockaddr v1.0.0 h1:GeH6tui99pF4NJgfnhp+L6+FfobzVW3Ah46sLo0ICXs= 16 16 + github.com/hashicorp/go-sockaddr v1.0.0/go.mod h1:7Xibr9yA9JjQq1JpNB2Vw7kxv8xerXegt+ozgdvDeDU= 17 17 + github.com/hashicorp/go-uuid v1.0.0 h1:RS8zrF7PhGwyNPOtxSClXXj9HA8feRnJzgnI1RJCSnM= 18 18 + github.com/hashicorp/go-uuid v1.0.0/go.mod h1:6SBZvOh/SIDV7/2o3Jml5SYk/TvGqwFJ/bN7x4byOro= 19 19 + github.com/hashicorp/golang-lru v0.5.0 h1:CL2msUPvZTLb5O648aiLNJw3hnBxN2+1Jq8rCOH9wdo= 20 20 + github.com/hashicorp/golang-lru v0.5.0/go.mod h1:/m3WP610KZHVQ1SGc6re/UDhFvYD7pJ4Ao+sR/qLZy8= 21 21 + github.com/hashicorp/memberlist v0.5.0 h1:EtYPN8DpAURiapus508I4n9CzHs2W+8NZGbmmR/prTM= 22 22 + github.com/hashicorp/memberlist v0.5.0/go.mod h1:yvyXLpo0QaGE59Y7hDTsTzDD25JYBZ4mHgHUZ8lrOI0= 23 23 + github.com/miekg/dns v1.1.26 h1:gPxPSwALAeHJSjarOs00QjVdV9QoBvc1D2ujQUr5BzU= 24 24 + github.com/miekg/dns v1.1.26/go.mod h1:bPDLeHnStXmXAq1m/Ch/hvfNHr14JKNPMBo3VZKjuso= 25 25 + github.com/pascaldekloe/goe v0.0.0-20180627143212-57f6aae5913c h1:Lgl0gzECD8GnQ5QCWA8o6BtfL6mDH5rQgM4/fX3avOs= 26 26 + github.com/pascaldekloe/goe v0.0.0-20180627143212-57f6aae5913c/go.mod h1:lzWF7FIEvWOWxwDKqyGYQf6ZUaNfKdP144TG7ZOy1lc= 27 27 + github.com/pmezard/go-difflib v1.0.0 h1:4DBwDE0NGyQoBHbLQYPwSUPoCMWR5BEzIk/f1lZbAQM= 28 28 + github.com/pmezard/go-difflib v1.0.0/go.mod h1:iKH77koFhYxTK1pcRnkKkqfTogsbg7gZNVY4sRDYZ/4= 29 29 + github.com/sean-/seed v0.0.0-20170313163322-e2103e2c3529 h1:nn5Wsu0esKSJiIVhscUtVbo7ada43DJhG55ua/hjS5I= 30 30 + github.com/sean-/seed v0.0.0-20170313163322-e2103e2c3529/go.mod h1:DxrIzT+xaE7yg65j358z/aeFdxmN0P9QXhEzd20vsDc= 31 31 + github.com/stretchr/testify v1.2.2 h1:bSDNvY7ZPG5RlJ8otE/7V6gMiyenm9RtJ7IUVIAoJ1w= 32 32 + github.com/stretchr/testify v1.2.2/go.mod h1:a8OnRcib4nhh0OaRAV+Yts87kKdq0PP7pXfy6kDkUVs= 33 33 + golang.org/x/crypto v0.0.0-20190308221718-c2843e01d9a2/go.mod h1:djNgcEr1/C05ACkg1iLfiJU5Ep61QUkGW8qpdssI0+w= 34 34 + golang.org/x/crypto v0.0.0-20190923035154-9ee001bba392 h1:ACG4HJsFiNMf47Y4PeRoebLNy/2lXT9EtprMuTFWt1M= 35 35 + golang.org/x/crypto v0.0.0-20190923035154-9ee001bba392/go.mod h1:/lpIB1dKB+9EgE3H3cr1v9wB50oz8l4C4h62xy7jSTY= 36 36 + golang.org/x/net v0.0.0-20190404232315-eb5bcb51f2a3/go.mod h1:t9HGtf8HONx5eT2rtn7q6eTqICYqUVnKs3thJo3Qplg= 37 37 + golang.org/x/net v0.0.0-20190620200207-3b0461eec859/go.mod h1:z5CRVTTTmAJ677TzLLGU+0bjPO0LkuOLi4/5GtJWs/s= 38 38 + golang.org/x/net v0.0.0-20190923162816-aa69164e4478 h1:l5EDrHhldLYb3ZRHDUhXF7Om7MvYXnkV9/iQNo1lX6g= 39 39 + golang.org/x/net v0.0.0-20190923162816-aa69164e4478/go.mod h1:z5CRVTTTmAJ677TzLLGU+0bjPO0LkuOLi4/5GtJWs/s= 40 40 + golang.org/x/sync v0.0.0-20190423024810-112230192c58 h1:8gQV6CLnAEikrhgkHFbMAEhagSSnXWGV915qUMm9mrU= 41 41 + golang.org/x/sync v0.0.0-20190423024810-112230192c58/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= 42 42 + golang.org/x/sys v0.0.0-20190215142949-d0b11bdaac8a/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= 43 43 + golang.org/x/sys v0.0.0-20190922100055-0a153f010e69/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= 44 44 + golang.org/x/sys v0.0.0-20190924154521-2837fb4f24fe/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= 45 45 + golang.org/x/sys v0.0.0-20220728004956-3c1f35247d10 h1:WIoqL4EROvwiPdUtaip4VcDdpZ4kha7wBWZrbVKCIZg= 46 46 + golang.org/x/sys v0.0.0-20220728004956-3c1f35247d10/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg= 47 47 + golang.org/x/text v0.3.0/go.mod h1:NqM8EUOU14njkJ3fqMW+pc6Ldnwhi/IjpwHt7yyuwOQ= 48 48 + golang.org/x/text v0.3.2/go.mod h1:bEr9sfX3Q8Zfm5fL9x+3itogRgK3+ptLWKqgva+5dAk= 49 49 + golang.org/x/tools v0.0.0-20180917221912-90fa682c2a6e/go.mod h1:n7NCudcB/nEzxVGmLbDWY5pfWTLqBcC2KZ6jyYvM4mQ= 50 50 + golang.org/x/tools v0.0.0-20190907020128-2ca718005c18/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= 51 51 + golang.org/x/xerrors v0.0.0-20190717185122-a985d3407aa7/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0=

+103

interop/main.go

··· 1 1 + package main 2 2 + 3 3 + import ( 4 4 + "encoding/hex" 5 5 + "flag" 6 6 + "log" 7 7 + "os" 8 8 + "os/signal" 9 9 + "syscall" 10 10 + "time" 11 11 + 12 12 + "github.com/hashicorp/memberlist" 13 13 + ) 14 14 + 15 15 + type eventDelegate struct{} 16 16 + 17 17 + func (e *eventDelegate) NotifyJoin(node *memberlist.Node) { 18 18 + log.Printf("[EVENT] Node joined: %s (%s:%d)", node.Name, node.Addr, node.Port) 19 19 + } 20 20 + 21 21 + func (e *eventDelegate) NotifyLeave(node *memberlist.Node) { 22 22 + log.Printf("[EVENT] Node left: %s", node.Name) 23 23 + } 24 24 + 25 25 + func (e *eventDelegate) NotifyUpdate(node *memberlist.Node) { 26 26 + log.Printf("[EVENT] Node updated: %s", node.Name) 27 27 + } 28 28 + 29 29 + func main() { 30 30 + name := flag.String("name", "go-node", "Node name") 31 31 + bind := flag.String("bind", "127.0.0.1", "Bind address") 32 32 + port := flag.Int("port", 7946, "Bind port") 33 33 + join := flag.String("join", "", "Address to join (host:port)") 34 34 + secretKey := flag.String("key", "", "Secret key (hex encoded, 16 bytes for AES-128)") 35 35 + flag.Parse() 36 36 + 37 37 + config := memberlist.DefaultLANConfig() 38 38 + config.Name = *name 39 39 + config.BindAddr = *bind 40 40 + config.BindPort = *port 41 41 + config.AdvertisePort = *port 42 42 + config.Events = &eventDelegate{} 43 43 + 44 44 + config.LogOutput = os.Stdout 45 45 + 46 46 + if *secretKey != "" { 47 47 + keyBytes, err := hex.DecodeString(*secretKey) 48 48 + if err != nil { 49 49 + log.Fatalf("Invalid hex key: %v", err) 50 50 + } 51 51 + if len(keyBytes) != 16 && len(keyBytes) != 24 && len(keyBytes) != 32 { 52 52 + log.Fatalf("Key must be 16, 24, or 32 bytes (got %d)", len(keyBytes)) 53 53 + } 54 54 + keyring, err := memberlist.NewKeyring(nil, keyBytes) 55 55 + if err != nil { 56 56 + log.Fatalf("Failed to create keyring: %v", err) 57 57 + } 58 58 + config.Keyring = keyring 59 59 + config.GossipVerifyIncoming = true 60 60 + config.GossipVerifyOutgoing = true 61 61 + log.Printf("Encryption enabled with %d-byte key", len(keyBytes)) 62 62 + } 63 63 + 64 64 + list, err := memberlist.Create(config) 65 65 + if err != nil { 66 66 + log.Fatalf("Failed to create memberlist: %v", err) 67 67 + } 68 68 + 69 69 + log.Printf("Memberlist started: %s on %s:%d", *name, *bind, *port) 70 70 + 71 71 + if *join != "" { 72 72 + log.Printf("Joining cluster via %s", *join) 73 73 + n, err := list.Join([]string{*join}) 74 74 + if err != nil { 75 75 + log.Printf("Failed to join: %v", err) 76 76 + } else { 77 77 + log.Printf("Joined %d nodes", n) 78 78 + } 79 79 + } 80 80 + 81 81 + go func() { 82 82 + ticker := time.NewTicker(5 * time.Second) 83 83 + for range ticker.C { 84 84 + members := list.Members() 85 85 + log.Printf("--- Members (%d) ---", len(members)) 86 86 + for _, m := range members { 87 87 + log.Printf(" %s: %s:%d (state=%v)", m.Name, m.Addr, m.Port, m.State) 88 88 + } 89 89 + } 90 90 + }() 91 91 + 92 92 + sigCh := make(chan os.Signal, 1) 93 93 + signal.Notify(sigCh, syscall.SIGINT, syscall.SIGTERM) 94 94 + <-sigCh 95 95 + 96 96 + log.Println("Shutting down...") 97 97 + if err := list.Leave(time.Second); err != nil { 98 98 + log.Printf("Leave error: %v", err) 99 99 + } 100 100 + if err := list.Shutdown(); err != nil { 101 101 + log.Printf("Shutdown error: %v", err) 102 102 + } 103 103 + }

+8 -63

lib/buffer_pool.ml

··· 1 1 - (** Lock-free buffer pool using Kcas and Eio. 2 2 - 3 3 - Provides pre-allocated buffers for zero-copy I/O operations. Uses 4 4 - Kcas_data.Queue for lock-free buffer storage and Eio.Semaphore for blocking 5 5 - acquire when pool is exhausted. *) 6 6 - 7 7 - type t = { 8 8 - buffers : Cstruct.t Kcas_data.Queue.t; 9 9 - buf_size : int; 10 10 - total : int; 11 11 - semaphore : Eio.Semaphore.t; 12 12 - } 1 1 + type t = { pool : Cstruct.t Eio.Stream.t; buf_size : int; capacity : int } 13 2 14 3 let create ~size ~count = 15 15 - let buffers = Kcas_data.Queue.create () in 4 4 + let pool = Eio.Stream.create count in 16 5 for _ = 1 to count do 17 17 - Kcas.Xt.commit 18 18 - { 19 19 - tx = 20 20 - (fun ~xt -> Kcas_data.Queue.Xt.add ~xt (Cstruct.create size) buffers); 21 21 - } 6 6 + Eio.Stream.add pool (Cstruct.create size) 22 7 done; 23 23 - { 24 24 - buffers; 25 25 - buf_size = size; 26 26 - total = count; 27 27 - semaphore = Eio.Semaphore.make count; 28 28 - } 8 8 + { pool; buf_size = size; capacity = count } 29 9 30 30 - let acquire t = 31 31 - Eio.Semaphore.acquire t.semaphore; 32 32 - let buf_opt = 33 33 - Kcas.Xt.commit 34 34 - { tx = (fun ~xt -> Kcas_data.Queue.Xt.take_opt ~xt t.buffers) } 35 35 - in 36 36 - match buf_opt with 37 37 - | Some buf -> 38 38 - Cstruct.memset buf 0; 39 39 - buf 40 40 - | None -> 41 41 - (* Should not happen if semaphore is properly synchronized, 42 42 - but handle gracefully by allocating a new buffer *) 43 43 - Cstruct.create t.buf_size 44 44 - 45 45 - let try_acquire t = 46 46 - (* Check if semaphore has available permits without blocking *) 47 47 - if Eio.Semaphore.get_value t.semaphore > 0 then begin 48 48 - (* Race condition possible here - another fiber might acquire between 49 49 - get_value and acquire. In that case, acquire will block briefly. 50 50 - For truly non-blocking behavior, we'd need atomic CAS on semaphore. *) 51 51 - Eio.Semaphore.acquire t.semaphore; 52 52 - let buf_opt = 53 53 - Kcas.Xt.commit 54 54 - { tx = (fun ~xt -> Kcas_data.Queue.Xt.take_opt ~xt t.buffers) } 55 55 - in 56 56 - match buf_opt with 57 57 - | Some buf -> 58 58 - Cstruct.memset buf 0; 59 59 - Some buf 60 60 - | None -> Some (Cstruct.create t.buf_size) 61 61 - end 62 62 - else None 63 63 - 64 64 - let release t buf = 65 65 - Kcas.Xt.commit { tx = (fun ~xt -> Kcas_data.Queue.Xt.add ~xt buf t.buffers) }; 66 66 - Eio.Semaphore.release t.semaphore 10 10 + let acquire t = Eio.Stream.take t.pool 11 11 + let release t buf = Eio.Stream.add t.pool buf 67 12 68 13 let with_buffer t f = 69 14 let buf = acquire t in 70 15 Fun.protect ~finally:(fun () -> release t buf) (fun () -> f buf) 71 16 72 72 - let available t = Eio.Semaphore.get_value t.semaphore 73 73 - let total t = t.total 17 17 + let available t = Eio.Stream.length t.pool 18 18 + let total t = t.capacity 74 19 let size t = t.buf_size

-1

lib/buffer_pool.mli

··· 2 2 3 3 val create : size:int -> count:int -> t 4 4 val acquire : t -> Cstruct.t 5 5 - val try_acquire : t -> Cstruct.t option 6 5 val release : t -> Cstruct.t -> unit 7 6 val with_buffer : t -> (Cstruct.t -> 'a) -> 'a 8 7 val available : t -> int

+814 -265

lib/codec.ml

··· 1 1 - open Types 1 1 + open Types.Wire 2 2 3 3 - module Encoder = struct 4 4 - type t = { buf : Cstruct.t; mutable pos : int } 3 3 + let encode_ping (p : ping) : Msgpck.t = 4 4 + Msgpck.Map 5 5 + [ 6 6 + (Msgpck.String "SeqNo", Msgpck.of_int p.seq_no); 7 7 + (Msgpck.String "Node", Msgpck.String p.node); 8 8 + (Msgpck.String "SourceAddr", Msgpck.String p.source_addr); 9 9 + (Msgpck.String "SourcePort", Msgpck.of_int p.source_port); 10 10 + (Msgpck.String "SourceNode", Msgpck.String p.source_node); 11 11 + ] 5 12 6 6 - let create ~buf = { buf; pos = 0 } 13 13 + let decode_ping (m : Msgpck.t) : (ping, string) result = 14 14 + match m with 15 15 + | Msgpck.Map fields -> 16 16 + let get_int key = 17 17 + match List.assoc_opt (Msgpck.String key) fields with 18 18 + | Some (Msgpck.Int i) -> Ok i 19 19 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 20 20 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 21 21 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 22 22 + in 23 23 + let get_string key = 24 24 + match List.assoc_opt (Msgpck.String key) fields with 25 25 + | Some (Msgpck.String s) -> Ok s 26 26 + | Some (Msgpck.Bytes s) -> Ok s 27 27 + | Some Msgpck.Nil -> Ok "" 28 28 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 29 29 + in 30 30 + let ( let* ) = Result.bind in 31 31 + let* seq_no = get_int "SeqNo" in 32 32 + let* node = get_string "Node" in 33 33 + let* source_addr = get_string "SourceAddr" in 34 34 + let* source_port = 35 35 + match get_int "SourcePort" with Ok p -> Ok p | Error _ -> Ok 0 36 36 + in 37 37 + let* source_node = 38 38 + match get_string "SourceNode" with Ok s -> Ok s | Error _ -> Ok "" 39 39 + in 40 40 + Ok { seq_no; node; source_addr; source_port; source_node } 41 41 + | _ -> Error "expected map for ping" 7 42 8 8 - let write_byte t v = 9 9 - Cstruct.set_uint8 t.buf t.pos v; 10 10 - t.pos <- t.pos + 1 43 43 + let encode_indirect_ping (p : indirect_ping_req) : Msgpck.t = 44 44 + Msgpck.Map 45 45 + [ 46 46 + (Msgpck.String "SeqNo", Msgpck.of_int p.seq_no); 47 47 + (Msgpck.String "Target", Msgpck.String p.target); 48 48 + (Msgpck.String "Port", Msgpck.of_int p.port); 49 49 + (Msgpck.String "Node", Msgpck.String p.node); 50 50 + (Msgpck.String "Nack", Msgpck.Bool p.nack); 51 51 + (Msgpck.String "SourceAddr", Msgpck.String p.source_addr); 52 52 + (Msgpck.String "SourcePort", Msgpck.of_int p.source_port); 53 53 + (Msgpck.String "SourceNode", Msgpck.String p.source_node); 54 54 + ] 11 55 12 12 - let write_int16_be t v = 13 13 - Cstruct.BE.set_uint16 t.buf t.pos v; 14 14 - t.pos <- t.pos + 2 56 56 + let decode_indirect_ping (m : Msgpck.t) : (indirect_ping_req, string) result = 57 57 + match m with 58 58 + | Msgpck.Map fields -> 59 59 + let get_int key = 60 60 + match List.assoc_opt (Msgpck.String key) fields with 61 61 + | Some (Msgpck.Int i) -> Ok i 62 62 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 63 63 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 64 64 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 65 65 + in 66 66 + let get_string key = 67 67 + match List.assoc_opt (Msgpck.String key) fields with 68 68 + | Some (Msgpck.String s) -> Ok s 69 69 + | Some (Msgpck.Bytes s) -> Ok s 70 70 + | Some Msgpck.Nil -> Ok "" 71 71 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 72 72 + in 73 73 + let get_bool key = 74 74 + match List.assoc_opt (Msgpck.String key) fields with 75 75 + | Some (Msgpck.Bool b) -> Ok b 76 76 + | _ -> Ok false 77 77 + in 78 78 + let ( let* ) = Result.bind in 79 79 + let* seq_no = get_int "SeqNo" in 80 80 + let* target = get_string "Target" in 81 81 + let* port = match get_int "Port" with Ok p -> Ok p | Error _ -> Ok 0 in 82 82 + let* node = get_string "Node" in 83 83 + let* nack = get_bool "Nack" in 84 84 + let* source_addr = 85 85 + match get_string "SourceAddr" with Ok s -> Ok s | Error _ -> Ok "" 86 86 + in 87 87 + let* source_port = 88 88 + match get_int "SourcePort" with Ok p -> Ok p | Error _ -> Ok 0 89 89 + in 90 90 + let* source_node = 91 91 + match get_string "SourceNode" with Ok s -> Ok s | Error _ -> Ok "" 92 92 + in 93 93 + Ok 94 94 + { 95 95 + seq_no; 96 96 + target; 97 97 + port; 98 98 + node; 99 99 + nack; 100 100 + source_addr; 101 101 + source_port; 102 102 + source_node; 103 103 + } 104 104 + | _ -> Error "expected map for indirect_ping" 15 105 16 16 - let write_int32_be t v = 17 17 - Cstruct.BE.set_uint32 t.buf t.pos v; 18 18 - t.pos <- t.pos + 4 106 106 + let encode_ack (a : ack_resp) : Msgpck.t = 107 107 + Msgpck.Map 108 108 + [ 109 109 + (Msgpck.String "SeqNo", Msgpck.of_int a.seq_no); 110 110 + (Msgpck.String "Payload", Msgpck.String a.payload); 111 111 + ] 19 112 20 20 - let write_int64_be t v = 21 21 - Cstruct.BE.set_uint64 t.buf t.pos v; 22 22 - t.pos <- t.pos + 8 113 113 + let decode_ack (m : Msgpck.t) : (ack_resp, string) result = 114 114 + match m with 115 115 + | Msgpck.Map fields -> 116 116 + let get_int key = 117 117 + match List.assoc_opt (Msgpck.String key) fields with 118 118 + | Some (Msgpck.Int i) -> Ok i 119 119 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 120 120 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 121 121 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 122 122 + in 123 123 + let get_bytes key = 124 124 + match List.assoc_opt (Msgpck.String key) fields with 125 125 + | Some (Msgpck.Bytes s) -> Ok s 126 126 + | Some (Msgpck.String s) -> Ok s 127 127 + | Some Msgpck.Nil -> Ok "" 128 128 + | _ -> Ok "" 129 129 + in 130 130 + let ( let* ) = Result.bind in 131 131 + let* seq_no = get_int "SeqNo" in 132 132 + let* payload = get_bytes "Payload" in 133 133 + Ok { seq_no; payload } 134 134 + | _ -> Error "expected map for ack" 23 135 24 24 - let write_string t s = 25 25 - let len = String.length s in 26 26 - write_int16_be t len; 27 27 - Cstruct.blit_from_string s 0 t.buf t.pos len; 28 28 - t.pos <- t.pos + len 136 136 + let encode_nack (n : nack_resp) : Msgpck.t = 137 137 + Msgpck.Map [ (Msgpck.String "SeqNo", Msgpck.of_int n.seq_no) ] 29 138 30 30 - let write_bytes t cs = 31 31 - let len = Cstruct.length cs in 32 32 - Cstruct.blit cs 0 t.buf t.pos len; 33 33 - t.pos <- t.pos + len 139 139 + let decode_nack (m : Msgpck.t) : (nack_resp, string) result = 140 140 + match m with 141 141 + | Msgpck.Map fields -> 142 142 + let get_int key = 143 143 + match List.assoc_opt (Msgpck.String key) fields with 144 144 + | Some (Msgpck.Int i) -> Ok i 145 145 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 146 146 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 147 147 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 148 148 + in 149 149 + let ( let* ) = Result.bind in 150 150 + let* seq_no = get_int "SeqNo" in 151 151 + Ok { seq_no } 152 152 + | _ -> Error "expected map for nack" 34 153 35 35 - let to_cstruct t = Cstruct.sub t.buf 0 t.pos 36 36 - let reset t = t.pos <- 0 37 37 - let remaining t = Cstruct.length t.buf - t.pos 38 38 - let pos t = t.pos 39 39 - end 154 154 + let encode_suspect (s : suspect) : Msgpck.t = 155 155 + Msgpck.Map 156 156 + [ 157 157 + (Msgpck.String "Incarnation", Msgpck.of_int s.incarnation); 158 158 + (Msgpck.String "Node", Msgpck.String s.node); 159 159 + (Msgpck.String "From", Msgpck.String s.from); 160 160 + ] 40 161 41 41 - module Decoder = struct 42 42 - type t = { buf : Cstruct.t; mutable pos : int } 162 162 + let decode_suspect (m : Msgpck.t) : (suspect, string) result = 163 163 + match m with 164 164 + | Msgpck.Map fields -> 165 165 + let get_int key = 166 166 + match List.assoc_opt (Msgpck.String key) fields with 167 167 + | Some (Msgpck.Int i) -> Ok i 168 168 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 169 169 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 170 170 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 171 171 + in 172 172 + let get_string key = 173 173 + match List.assoc_opt (Msgpck.String key) fields with 174 174 + | Some (Msgpck.String s) -> Ok s 175 175 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 176 176 + in 177 177 + let ( let* ) = Result.bind in 178 178 + let* incarnation = get_int "Incarnation" in 179 179 + let* node = get_string "Node" in 180 180 + let* from = get_string "From" in 181 181 + Ok ({ incarnation; node; from } : suspect) 182 182 + | _ -> Error "expected map for suspect" 43 183 44 44 - let create buf = { buf; pos = 0 } 184 184 + let encode_alive (a : alive) : Msgpck.t = 185 185 + Msgpck.Map 186 186 + [ 187 187 + (Msgpck.String "Incarnation", Msgpck.of_int a.incarnation); 188 188 + (Msgpck.String "Node", Msgpck.String a.node); 189 189 + (Msgpck.String "Addr", Msgpck.String a.addr); 190 190 + (Msgpck.String "Port", Msgpck.of_int a.port); 191 191 + (Msgpck.String "Meta", Msgpck.String a.meta); 192 192 + (Msgpck.String "Vsn", Msgpck.List (List.map Msgpck.of_int a.vsn)); 193 193 + ] 45 194 46 46 - let read_byte t = 47 47 - let v = Cstruct.get_uint8 t.buf t.pos in 48 48 - t.pos <- t.pos + 1; 49 49 - v 195 195 + let decode_alive (m : Msgpck.t) : (alive, string) result = 196 196 + match m with 197 197 + | Msgpck.Map fields -> 198 198 + let get_int key = 199 199 + match List.assoc_opt (Msgpck.String key) fields with 200 200 + | Some (Msgpck.Int i) -> Ok i 201 201 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 202 202 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 203 203 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 204 204 + in 205 205 + let get_string key = 206 206 + match List.assoc_opt (Msgpck.String key) fields with 207 207 + | Some (Msgpck.String s) -> Ok s 208 208 + | Some (Msgpck.Bytes s) -> Ok s 209 209 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 210 210 + in 211 211 + let get_vsn () = 212 212 + match List.assoc_opt (Msgpck.String "Vsn") fields with 213 213 + | Some (Msgpck.List vs) -> 214 214 + Ok 215 215 + (List.filter_map 216 216 + (function 217 217 + | Msgpck.Int i -> Some i 218 218 + | Msgpck.Int32 i -> Some (Int32.to_int i) 219 219 + | _ -> None) 220 220 + vs) 221 221 + | _ -> Ok [] 222 222 + in 223 223 + let ( let* ) = Result.bind in 224 224 + let* incarnation = get_int "Incarnation" in 225 225 + let* node = get_string "Node" in 226 226 + let* addr = get_string "Addr" in 227 227 + let* port = get_int "Port" in 228 228 + let* meta = 229 229 + match get_string "Meta" with Ok m -> Ok m | Error _ -> Ok "" 230 230 + in 231 231 + let* vsn = get_vsn () in 232 232 + Ok { incarnation; node; addr; port; meta; vsn } 233 233 + | _ -> Error "expected map for alive" 50 234 51 51 - let read_int16_be t = 52 52 - let v = Cstruct.BE.get_uint16 t.buf t.pos in 53 53 - t.pos <- t.pos + 2; 54 54 - v 235 235 + let encode_dead (d : dead) : Msgpck.t = 236 236 + Msgpck.Map 237 237 + [ 238 238 + (Msgpck.String "Incarnation", Msgpck.of_int d.incarnation); 239 239 + (Msgpck.String "Node", Msgpck.String d.node); 240 240 + (Msgpck.String "From", Msgpck.String d.from); 241 241 + ] 55 242 56 56 - let read_int32_be t = 57 57 - let v = Cstruct.BE.get_uint32 t.buf t.pos in 58 58 - t.pos <- t.pos + 4; 59 59 - v 243 243 + let decode_dead (m : Msgpck.t) : (dead, string) result = 244 244 + match m with 245 245 + | Msgpck.Map fields -> 246 246 + let get_int key = 247 247 + match List.assoc_opt (Msgpck.String key) fields with 248 248 + | Some (Msgpck.Int i) -> Ok i 249 249 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 250 250 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 251 251 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 252 252 + in 253 253 + let get_string key = 254 254 + match List.assoc_opt (Msgpck.String key) fields with 255 255 + | Some (Msgpck.String s) -> Ok s 256 256 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 257 257 + in 258 258 + let ( let* ) = Result.bind in 259 259 + let* incarnation = get_int "Incarnation" in 260 260 + let* node = get_string "Node" in 261 261 + let* from = get_string "From" in 262 262 + Ok ({ incarnation; node; from } : dead) 263 263 + | _ -> Error "expected map for dead" 60 264 61 61 - let read_int64_be t = 62 62 - let v = Cstruct.BE.get_uint64 t.buf t.pos in 63 63 - t.pos <- t.pos + 8; 64 64 - v 265 265 + let encode_compress (c : compress) : Msgpck.t = 266 266 + Msgpck.Map 267 267 + [ 268 268 + (Msgpck.String "Algo", Msgpck.of_int c.algo); 269 269 + (Msgpck.String "Buf", Msgpck.String c.buf); 270 270 + ] 65 271 66 66 - let read_string t = 67 67 - let len = read_int16_be t in 68 68 - let s = Cstruct.to_string ~off:t.pos ~len t.buf in 69 69 - t.pos <- t.pos + len; 70 70 - s 272 272 + let decode_compress (m : Msgpck.t) : (compress, string) result = 273 273 + match m with 274 274 + | Msgpck.Map fields -> 275 275 + let get_int key = 276 276 + match List.assoc_opt (Msgpck.String key) fields with 277 277 + | Some (Msgpck.Int i) -> Ok i 278 278 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 279 279 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 280 280 + in 281 281 + let get_bytes key = 282 282 + match List.assoc_opt (Msgpck.String key) fields with 283 283 + | Some (Msgpck.Bytes s) -> Ok s 284 284 + | Some (Msgpck.String s) -> Ok s 285 285 + | _ -> Error (Printf.sprintf "missing or invalid %s" key) 286 286 + in 287 287 + let ( let* ) = Result.bind in 288 288 + let* algo = get_int "Algo" in 289 289 + let* buf = get_bytes "Buf" in 290 290 + Ok { algo; buf } 291 291 + | _ -> Error "expected map for compress" 71 292 72 72 - let read_bytes t ~len = 73 73 - let cs = Cstruct.sub t.buf t.pos len in 74 74 - t.pos <- t.pos + len; 75 75 - cs 293 293 + let wire_msg_to_msgpck (msg : protocol_msg) : message_type * Msgpck.t = 294 294 + match msg with 295 295 + | Ping p -> (Ping_msg, encode_ping p) 296 296 + | Indirect_ping p -> (Indirect_ping_msg, encode_indirect_ping p) 297 297 + | Ack a -> (Ack_resp_msg, encode_ack a) 298 298 + | Nack n -> (Nack_resp_msg, encode_nack n) 299 299 + | Suspect s -> (Suspect_msg, encode_suspect s) 300 300 + | Alive a -> (Alive_msg, encode_alive a) 301 301 + | Dead d -> (Dead_msg, encode_dead d) 302 302 + | User_data _ -> (User_msg, Msgpck.Nil) 303 303 + | Compound _ -> (Compound_msg, Msgpck.Nil) 304 304 + | Compressed c -> (Compress_msg, encode_compress c) 305 305 + | Err e -> (Err_msg, Msgpck.Map [ (Msgpck.String "Error", Msgpck.String e) ]) 76 306 77 77 - let remaining t = Cstruct.length t.buf - t.pos 78 78 - let is_empty t = t.pos >= Cstruct.length t.buf 79 79 - let pos t = t.pos 80 80 - end 307 307 + let encode_msg_to_cstruct (msg : protocol_msg) ~(buf : Cstruct.t) : 308 308 + (int, [ `Buffer_too_small ]) result = 309 309 + let msg_type, payload = wire_msg_to_msgpck msg in 310 310 + let msg_type_byte = message_type_to_int msg_type in 311 311 + match msg with 312 312 + | User_data data -> 313 313 + let total_len = 1 + String.length data in 314 314 + if total_len > Cstruct.length buf then Error `Buffer_too_small 315 315 + else begin 316 316 + Cstruct.set_uint8 buf 0 msg_type_byte; 317 317 + Cstruct.blit_from_string data 0 buf 1 (String.length data); 318 318 + Ok total_len 319 319 + end 320 320 + | _ -> 321 321 + let payload_size = Msgpck.size payload in 322 322 + let total_len = 1 + payload_size in 323 323 + if total_len > Cstruct.length buf then Error `Buffer_too_small 324 324 + else begin 325 325 + Cstruct.set_uint8 buf 0 msg_type_byte; 326 326 + let payload_bytes = Bytes.create payload_size in 327 327 + let _ = Msgpck.Bytes.write payload_bytes payload in 328 328 + Cstruct.blit_from_bytes payload_bytes 0 buf 1 payload_size; 329 329 + Ok total_len 330 330 + end 81 331 82 82 - let magic = "SWIM" 83 83 - let version = 1 84 84 - let tag_ping = 0x01 85 85 - let tag_ping_req = 0x02 86 86 - let tag_ack = 0x03 87 87 - let tag_alive = 0x04 88 88 - let tag_suspect = 0x05 89 89 - let tag_dead = 0x06 90 90 - let tag_user_msg = 0x07 91 91 - let ip_to_string ip = Fmt.to_to_string Eio.Net.Ipaddr.pp ip 332 332 + let decode_msg_from_cstruct (buf : Cstruct.t) : 333 333 + (protocol_msg, Types.decode_error) result = 334 334 + if Cstruct.length buf < 1 then Error Types.Truncated_message 335 335 + else 336 336 + let msg_type_byte = Cstruct.get_uint8 buf 0 in 337 337 + match message_type_of_int msg_type_byte with 338 338 + | Error n -> Error (Types.Invalid_tag n) 339 339 + | Ok msg_type -> ( 340 340 + let payload_len = Cstruct.length buf - 1 in 341 341 + match msg_type with 342 342 + | User_msg -> 343 343 + let data = Cstruct.to_string ~off:1 ~len:payload_len buf in 344 344 + Ok (User_data data) 345 345 + | Compound_msg -> Ok (Compound []) 346 346 + | _ -> ( 347 347 + let payload_bytes = Cstruct.to_bytes ~off:1 ~len:payload_len buf in 348 348 + let _, msgpack = Msgpck.Bytes.read payload_bytes in 349 349 + match msg_type with 350 350 + | Ping_msg -> ( 351 351 + match decode_ping msgpack with 352 352 + | Ok p -> Ok (Ping p) 353 353 + | Error e -> Error (Types.Msgpack_error e)) 354 354 + | Indirect_ping_msg -> ( 355 355 + match decode_indirect_ping msgpack with 356 356 + | Ok p -> Ok (Indirect_ping p) 357 357 + | Error e -> Error (Types.Msgpack_error e)) 358 358 + | Ack_resp_msg -> ( 359 359 + match decode_ack msgpack with 360 360 + | Ok a -> Ok (Ack a) 361 361 + | Error e -> Error (Types.Msgpack_error e)) 362 362 + | Nack_resp_msg -> ( 363 363 + match decode_nack msgpack with 364 364 + | Ok n -> Ok (Nack n) 365 365 + | Error e -> Error (Types.Msgpack_error e)) 366 366 + | Suspect_msg -> ( 367 367 + match decode_suspect msgpack with 368 368 + | Ok s -> Ok (Suspect s) 369 369 + | Error e -> Error (Types.Msgpack_error e)) 370 370 + | Alive_msg -> ( 371 371 + match decode_alive msgpack with 372 372 + | Ok a -> Ok (Alive a) 373 373 + | Error e -> Error (Types.Msgpack_error e)) 374 374 + | Dead_msg -> ( 375 375 + match decode_dead msgpack with 376 376 + | Ok d -> Ok (Dead d) 377 377 + | Error e -> Error (Types.Msgpack_error e)) 378 378 + | Compress_msg -> ( 379 379 + match decode_compress msgpack with 380 380 + | Ok c -> Ok (Compressed c) 381 381 + | Error e -> Error (Types.Msgpack_error e)) 382 382 + | Err_msg -> ( 383 383 + match msgpack with 384 384 + | Msgpck.Map fields -> ( 385 385 + match List.assoc_opt (Msgpck.String "Error") fields with 386 386 + | Some (Msgpck.String e) -> Ok (Err e) 387 387 + | _ -> Ok (Err "unknown error")) 388 388 + | _ -> Ok (Err "unknown error")) 389 389 + | _ -> Error (Types.Invalid_tag msg_type_byte))) 92 390 93 93 - let parse_ipv4 s = 94 94 - Scanf.sscanf s "%d.%d.%d.%d" (fun a b c d -> 95 95 - let buf = Bytes.create 4 in 96 96 - Bytes.set_uint8 buf 0 a; 97 97 - Bytes.set_uint8 buf 1 b; 98 98 - Bytes.set_uint8 buf 2 c; 99 99 - Bytes.set_uint8 buf 3 d; 100 100 - Eio.Net.Ipaddr.of_raw (Bytes.to_string buf)) 391 391 + let crc32_table = 392 392 + Array.init 256 (fun i -> 393 393 + let crc = ref (Int32.of_int i) in 394 394 + for _ = 0 to 7 do 395 395 + if Int32.logand !crc 1l = 1l then 396 396 + crc := Int32.logxor (Int32.shift_right_logical !crc 1) 0xEDB88320l 397 397 + else crc := Int32.shift_right_logical !crc 1 398 398 + done; 399 399 + !crc) 400 400 + 401 401 + let crc32_cstruct (buf : Cstruct.t) : int32 = 402 402 + let crc = ref 0xFFFFFFFFl in 403 403 + for i = 0 to Cstruct.length buf - 1 do 404 404 + let byte = Cstruct.get_uint8 buf i in 405 405 + let idx = 406 406 + Int32.to_int (Int32.logand (Int32.logxor !crc (Int32.of_int byte)) 0xFFl) 407 407 + in 408 408 + crc := Int32.logxor (Int32.shift_right_logical !crc 8) crc32_table.(idx) 409 409 + done; 410 410 + Int32.logxor !crc 0xFFFFFFFFl 411 411 + 412 412 + let add_crc_to_cstruct ~(src : Cstruct.t) ~src_len ~(dst : Cstruct.t) : 413 413 + (int, [ `Buffer_too_small ]) result = 414 414 + let total_len = 5 + src_len in 415 415 + if total_len > Cstruct.length dst then Error `Buffer_too_small 416 416 + else begin 417 417 + let payload = Cstruct.sub src 0 src_len in 418 418 + let crc = crc32_cstruct payload in 419 419 + Cstruct.set_uint8 dst 0 (message_type_to_int Has_crc_msg); 420 420 + Cstruct.BE.set_uint32 dst 1 crc; 421 421 + Cstruct.blit payload 0 dst 5 src_len; 422 422 + Ok total_len 423 423 + end 424 424 + 425 425 + let verify_and_strip_crc (buf : Cstruct.t) : 426 426 + (Cstruct.t, Types.decode_error) result = 427 427 + if Cstruct.length buf < 5 then Error Types.Truncated_message 428 428 + else if Cstruct.get_uint8 buf 0 <> message_type_to_int Has_crc_msg then Ok buf 429 429 + else 430 430 + let expected = Cstruct.BE.get_uint32 buf 1 in 431 431 + let payload = Cstruct.shift buf 5 in 432 432 + let actual = crc32_cstruct payload in 433 433 + if expected = actual then Ok payload else Error Types.Invalid_crc 434 434 + 435 435 + let add_label_to_cstruct ~label ~(src : Cstruct.t) ~src_len ~(dst : Cstruct.t) : 436 436 + (int, [ `Buffer_too_small ]) result = 437 437 + if label = "" then begin 438 438 + if src_len > Cstruct.length dst then Error `Buffer_too_small 439 439 + else begin 440 440 + Cstruct.blit src 0 dst 0 src_len; 441 441 + Ok src_len 442 442 + end 443 443 + end 444 444 + else 445 445 + let label_len = String.length label in 446 446 + let total_len = 2 + label_len + src_len in 447 447 + if total_len > Cstruct.length dst then Error `Buffer_too_small 448 448 + else begin 449 449 + Cstruct.set_uint8 dst 0 (message_type_to_int Has_label_msg); 450 450 + Cstruct.set_uint8 dst 1 label_len; 451 451 + Cstruct.blit_from_string label 0 dst 2 label_len; 452 452 + Cstruct.blit src 0 dst (2 + label_len) src_len; 453 453 + Ok total_len 454 454 + end 455 455 + 456 456 + let strip_label (buf : Cstruct.t) : 457 457 + (Cstruct.t * string, Types.decode_error) result = 458 458 + if Cstruct.length buf < 1 then Error Types.Truncated_message 459 459 + else if Cstruct.get_uint8 buf 0 <> message_type_to_int Has_label_msg then 460 460 + Ok (buf, "") 461 461 + else if Cstruct.length buf < 2 then Error Types.Truncated_message 462 462 + else 463 463 + let label_len = Cstruct.get_uint8 buf 1 in 464 464 + if Cstruct.length buf < 2 + label_len then Error Types.Truncated_message 465 465 + else 466 466 + let label = Cstruct.to_string ~off:2 ~len:label_len buf in 467 467 + let payload = Cstruct.shift buf (2 + label_len) in 468 468 + Ok (payload, label) 469 469 + 470 470 + let encode_compound_to_cstruct ~(msgs : Cstruct.t list) ~(msg_lens : int list) 471 471 + ~(dst : Cstruct.t) : (int, [ `Buffer_too_small ]) result = 472 472 + let num_msgs = List.length msgs in 473 473 + if num_msgs > 255 then failwith "too many messages for compound" 474 474 + else 475 475 + let header_size = 1 + 1 + (num_msgs * 2) in 476 476 + let total_payload = List.fold_left ( + ) 0 msg_lens in 477 477 + let total_len = header_size + total_payload in 478 478 + if total_len > Cstruct.length dst then Error `Buffer_too_small 479 479 + else begin 480 480 + Cstruct.set_uint8 dst 0 (message_type_to_int Compound_msg); 481 481 + Cstruct.set_uint8 dst 1 num_msgs; 482 482 + List.iteri 483 483 + (fun i len -> Cstruct.BE.set_uint16 dst (2 + (i * 2)) len) 484 484 + msg_lens; 485 485 + let offset = ref header_size in 486 486 + List.iter2 487 487 + (fun msg len -> 488 488 + Cstruct.blit msg 0 dst !offset len; 489 489 + offset := !offset + len) 490 490 + msgs msg_lens; 491 491 + Ok total_len 492 492 + end 101 493 102 102 - let parse_ipv6 s = 103 103 - let parts = String.split_on_char ':' s in 104 104 - let buf = Bytes.create 16 in 105 105 - let rec fill idx = function 106 106 - | [] -> () 107 107 - | "" :: rest when List.exists (( = ) "") rest -> 108 108 - let tail_len = List.length (List.filter (( <> ) "") rest) in 109 109 - let zeros = 8 - idx - tail_len in 110 110 - for i = 0 to (zeros * 2) - 1 do 111 111 - Bytes.set_uint8 buf ((idx * 2) + i) 0 112 112 - done; 113 113 - fill (idx + zeros) rest 114 114 - | "" :: rest -> fill idx rest 115 115 - | h :: rest -> 116 116 - let v = int_of_string ("0x" ^ h) in 117 117 - Bytes.set_uint8 buf (idx * 2) (v lsr 8); 118 118 - Bytes.set_uint8 buf ((idx * 2) + 1) (v land 0xff); 119 119 - fill (idx + 1) rest 120 120 - in 121 121 - fill 0 parts; 122 122 - Eio.Net.Ipaddr.of_raw (Bytes.to_string buf) 494 494 + let decode_compound_from_cstruct (buf : Cstruct.t) : 495 495 + (Cstruct.t list * int, Types.decode_error) result = 496 496 + if Cstruct.length buf < 1 then Error Types.Truncated_message 497 497 + else 498 498 + let num_parts = Cstruct.get_uint8 buf 0 in 499 499 + let header_size = 1 + (num_parts * 2) in 500 500 + if Cstruct.length buf < header_size then Error Types.Truncated_message 501 501 + else 502 502 + let lengths = 503 503 + List.init num_parts (fun i -> Cstruct.BE.get_uint16 buf (1 + (i * 2))) 504 504 + in 505 505 + let rec extract_parts offset remaining_lens acc trunc = 506 506 + match remaining_lens with 507 507 + | [] -> Ok (List.rev acc, trunc) 508 508 + | len :: rest -> 509 509 + if offset + len > Cstruct.length buf then 510 510 + Ok (List.rev acc, List.length remaining_lens) 511 511 + else 512 512 + let part = Cstruct.sub buf offset len in 513 513 + extract_parts (offset + len) rest (part :: acc) trunc 514 514 + in 515 515 + extract_parts header_size lengths [] 0 123 516 124 124 - let ip_of_string s = 125 125 - if String.contains s ':' then parse_ipv6 s else parse_ipv4 s 517 517 + let encode_internal_msg_to_cstruct ~self_name ~self_port 518 518 + (msg : Types.protocol_msg) ~(buf : Cstruct.t) : 519 519 + (int, [ `Buffer_too_small ]) result = 520 520 + let wire_msg = Types.msg_to_wire ~self_name ~self_port msg in 521 521 + encode_msg_to_cstruct wire_msg ~buf 126 522 127 127 - let encode_addr enc (addr : Eio.Net.Sockaddr.datagram) = 128 128 - match addr with 129 129 - | `Udp (ip, port) -> 130 130 - Encoder.write_string enc (ip_to_string ip); 131 131 - Encoder.write_int16_be enc port 132 132 - | `Unix _ -> failwith "Unix sockets not supported for SWIM protocol" 523 523 + let decode_internal_msg_from_cstruct ~default_port (buf : Cstruct.t) : 524 524 + (Types.protocol_msg, Types.decode_error) result = 525 525 + match decode_msg_from_cstruct buf with 526 526 + | Error e -> Error e 527 527 + | Ok wire_msg -> ( 528 528 + match Types.msg_of_wire ~default_port wire_msg with 529 529 + | Some msg -> Ok msg 530 530 + | None -> Error (Types.Invalid_tag 0)) 133 531 134 134 - let decode_addr dec : Eio.Net.Sockaddr.datagram = 135 135 - let ip_str = Decoder.read_string dec in 136 136 - let port = Decoder.read_int16_be dec in 137 137 - `Udp (ip_of_string ip_str, port) 532 532 + let encode_packet (packet : Types.packet) ~(buf : Cstruct.t) : 533 533 + (int, [ `Buffer_too_small ]) result = 534 534 + let self_name = packet.cluster in 535 535 + let self_port = 7946 in 536 536 + match packet.piggyback with 537 537 + | [] -> 538 538 + encode_internal_msg_to_cstruct ~self_name ~self_port packet.primary ~buf 539 539 + | piggyback -> ( 540 540 + let msgs = packet.primary :: piggyback in 541 541 + let num_msgs = List.length msgs in 542 542 + if num_msgs > 255 then failwith "too many messages for compound" 543 543 + else 544 544 + let header_size = 1 + 1 + (num_msgs * 2) in 545 545 + if header_size > Cstruct.length buf then Error `Buffer_too_small 546 546 + else 547 547 + let rec encode_msgs i msgs current_offset = 548 548 + match msgs with 549 549 + | [] -> Ok current_offset 550 550 + | msg :: rest -> ( 551 551 + if current_offset >= Cstruct.length buf then 552 552 + Error `Buffer_too_small 553 553 + else 554 554 + let slice = Cstruct.shift buf current_offset in 555 555 + match 556 556 + encode_internal_msg_to_cstruct ~self_name ~self_port msg 557 557 + ~buf:slice 558 558 + with 559 559 + | Error _ -> Error `Buffer_too_small 560 560 + | Ok len -> 561 561 + Cstruct.BE.set_uint16 buf (2 + (i * 2)) len; 562 562 + encode_msgs (i + 1) rest (current_offset + len)) 563 563 + in 564 564 + match encode_msgs 0 msgs header_size with 565 565 + | Ok final_offset -> 566 566 + Cstruct.set_uint8 buf 0 (message_type_to_int Compound_msg); 567 567 + Cstruct.set_uint8 buf 1 num_msgs; 568 568 + Ok final_offset 569 569 + | Error e -> Error e) 138 570 139 139 - let encode_node_id enc (node_id : node_id) = 140 140 - Encoder.write_string enc (node_id_to_string node_id) 571 571 + let decode_packet (buf : Cstruct.t) : (Types.packet, Types.decode_error) result 572 572 + = 573 573 + if Cstruct.length buf < 1 then Error Types.Truncated_message 574 574 + else 575 575 + let msg_type = Cstruct.get_uint8 buf 0 in 576 576 + if msg_type = message_type_to_int Compound_msg then 577 577 + let payload = Cstruct.shift buf 1 in 578 578 + match decode_compound_from_cstruct payload with 579 579 + | Error e -> Error e 580 580 + | Ok (parts, _truncated) -> ( 581 581 + match parts with 582 582 + | [] -> Error Types.Truncated_message 583 583 + | first :: rest -> ( 584 584 + match 585 585 + decode_internal_msg_from_cstruct ~default_port:7946 first 586 586 + with 587 587 + | Error e -> Error e 588 588 + | Ok primary -> 589 589 + let piggyback = 590 590 + List.filter_map 591 591 + (fun p -> 592 592 + match 593 593 + decode_internal_msg_from_cstruct ~default_port:7946 p 594 594 + with 595 595 + | Ok m -> Some m 596 596 + | Error _ -> None) 597 597 + rest 598 598 + in 599 599 + Ok { Types.cluster = ""; primary; piggyback })) 600 600 + else 601 601 + match decode_internal_msg_from_cstruct ~default_port:7946 buf with 602 602 + | Error e -> Error e 603 603 + | Ok primary -> Ok { Types.cluster = ""; primary; piggyback = [] } 141 604 142 142 - let decode_node_id dec : node_id = node_id_of_string (Decoder.read_string dec) 605 605 + let encoded_size (msg : Types.protocol_msg) : int = 606 606 + let wire_msg = Types.msg_to_wire ~self_name:"" ~self_port:7946 msg in 607 607 + let _, payload = wire_msg_to_msgpck wire_msg in 608 608 + 1 + Msgpck.size payload + 3 143 609 144 144 - let encode_node enc (node : node_info) = 145 145 - encode_node_id enc node.id; 146 146 - encode_addr enc node.addr; 147 147 - Encoder.write_string enc node.meta 610 610 + let encode_internal_msg ~self_name ~self_port (msg : Types.protocol_msg) : 611 611 + string = 612 612 + let buf = Cstruct.create 2048 in 613 613 + match encode_internal_msg_to_cstruct ~self_name ~self_port msg ~buf with 614 614 + | Error _ -> "" 615 615 + | Ok len -> Cstruct.to_string ~off:0 ~len buf 148 616 149 149 - let decode_node dec : node_info = 150 150 - let id = decode_node_id dec in 151 151 - let addr = decode_addr dec in 152 152 - let meta = Decoder.read_string dec in 153 153 - { id; addr; meta } 617 617 + (* Backward-compatible string wrappers for tests *) 154 618 155 155 - let encode_incarnation enc (inc : incarnation) = 156 156 - Encoder.write_int32_be enc (Int32.of_int (incarnation_to_int inc)) 619 619 + let add_crc (data : string) : string = 620 620 + let src = Cstruct.of_string data in 621 621 + let dst = Cstruct.create (5 + String.length data) in 622 622 + match add_crc_to_cstruct ~src ~src_len:(String.length data) ~dst with 623 623 + | Error _ -> data 624 624 + | Ok len -> Cstruct.to_string ~off:0 ~len dst 157 625 158 158 - let decode_incarnation dec : incarnation = 159 159 - incarnation_of_int (Int32.to_int (Decoder.read_int32_be dec)) 626 626 + let verify_and_strip_crc_string (data : string) : 627 627 + (string, Types.decode_error) result = 628 628 + let buf = Cstruct.of_string data in 629 629 + match verify_and_strip_crc buf with 630 630 + | Error e -> Error e 631 631 + | Ok cs -> Ok (Cstruct.to_string cs) 160 632 161 161 - let encode_option encode_elem enc = function 162 162 - | None -> Encoder.write_byte enc 0 163 163 - | Some v -> 164 164 - Encoder.write_byte enc 1; 165 165 - encode_elem enc v 633 633 + let add_label (label : string) (data : string) : string = 634 634 + let src = Cstruct.of_string data in 635 635 + let dst = Cstruct.create (2 + String.length label + String.length data) in 636 636 + match add_label_to_cstruct ~label ~src ~src_len:(String.length data) ~dst with 637 637 + | Error _ -> data 638 638 + | Ok len -> Cstruct.to_string ~off:0 ~len dst 166 639 167 167 - let decode_option decode_elem dec = 168 168 - match Decoder.read_byte dec with 0 -> None | _ -> Some (decode_elem dec) 640 640 + let strip_label_string (data : string) : 641 641 + (string * string, Types.decode_error) result = 642 642 + let buf = Cstruct.of_string data in 643 643 + match strip_label buf with 644 644 + | Error e -> Error e 645 645 + | Ok (cs, label) -> Ok (Cstruct.to_string cs, label) 169 646 170 170 - let encode_msg enc msg = 171 171 - match msg with 172 172 - | Ping { seq; sender } -> 173 173 - Encoder.write_byte enc tag_ping; 174 174 - Encoder.write_int32_be enc (Int32.of_int seq); 175 175 - encode_node enc sender 176 176 - | Ping_req { seq; target; sender } -> 177 177 - Encoder.write_byte enc tag_ping_req; 178 178 - Encoder.write_int32_be enc (Int32.of_int seq); 179 179 - encode_node_id enc target; 180 180 - encode_node enc sender 181 181 - | Ack { seq; responder; payload } -> 182 182 - Encoder.write_byte enc tag_ack; 183 183 - Encoder.write_int32_be enc (Int32.of_int seq); 184 184 - encode_node enc responder; 185 185 - encode_option Encoder.write_string enc payload 186 186 - | Alive { node; incarnation } -> 187 187 - Encoder.write_byte enc tag_alive; 188 188 - encode_node enc node; 189 189 - encode_incarnation enc incarnation 190 190 - | Suspect { node; incarnation; suspector } -> 191 191 - Encoder.write_byte enc tag_suspect; 192 192 - encode_node_id enc node; 193 193 - encode_incarnation enc incarnation; 194 194 - encode_node_id enc suspector 195 195 - | Dead { node; incarnation; declarator } -> 196 196 - Encoder.write_byte enc tag_dead; 197 197 - encode_node_id enc node; 198 198 - encode_incarnation enc incarnation; 199 199 - encode_node_id enc declarator 200 200 - | User_msg { topic; payload; origin } -> 201 201 - Encoder.write_byte enc tag_user_msg; 202 202 - Encoder.write_string enc topic; 203 203 - Encoder.write_string enc payload; 204 204 - encode_node_id enc origin 647 647 + let make_compound_msg (msgs : string list) : string = 648 648 + let css = List.map Cstruct.of_string msgs in 649 649 + let lens = List.map String.length msgs in 650 650 + let total_len = 2 + (List.length msgs * 2) + List.fold_left ( + ) 0 lens in 651 651 + let dst = Cstruct.create total_len in 652 652 + match encode_compound_to_cstruct ~msgs:css ~msg_lens:lens ~dst with 653 653 + | Error _ -> "" 654 654 + | Ok len -> Cstruct.to_string ~off:0 ~len dst 205 655 206 206 - let decode_msg dec : (protocol_msg, decode_error) result = 207 207 - let tag = Decoder.read_byte dec in 208 208 - match tag with 209 209 - | t when t = tag_ping -> 210 210 - let seq = Int32.to_int (Decoder.read_int32_be dec) in 211 211 - let sender = decode_node dec in 212 212 - Ok (Ping { seq; sender }) 213 213 - | t when t = tag_ping_req -> 214 214 - let seq = Int32.to_int (Decoder.read_int32_be dec) in 215 215 - let target = decode_node_id dec in 216 216 - let sender = decode_node dec in 217 217 - Ok (Ping_req { seq; target; sender }) 218 218 - | t when t = tag_ack -> 219 219 - let seq = Int32.to_int (Decoder.read_int32_be dec) in 220 220 - let responder = decode_node dec in 221 221 - let payload = decode_option Decoder.read_string dec in 222 222 - Ok (Ack { seq; responder; payload }) 223 223 - | t when t = tag_alive -> 224 224 - let node = decode_node dec in 225 225 - let incarnation = decode_incarnation dec in 226 226 - Ok (Alive { node; incarnation }) 227 227 - | t when t = tag_suspect -> 228 228 - let node = decode_node_id dec in 229 229 - let incarnation = decode_incarnation dec in 230 230 - let suspector = decode_node_id dec in 231 231 - Ok (Suspect { node; incarnation; suspector }) 232 232 - | t when t = tag_dead -> 233 233 - let node = decode_node_id dec in 234 234 - let incarnation = decode_incarnation dec in 235 235 - let declarator = decode_node_id dec in 236 236 - Ok (Dead { node; incarnation; declarator }) 237 237 - | t when t = tag_user_msg -> 238 238 - let topic = Decoder.read_string dec in 239 239 - let payload = Decoder.read_string dec in 240 240 - let origin = decode_node_id dec in 241 241 - Ok (User_msg { topic; payload; origin }) 242 242 - | t -> Error (Invalid_tag t) 656 656 + let decode_compound_msg (data : string) : 657 657 + (string list * int, Types.decode_error) result = 658 658 + let buf = Cstruct.of_string data in 659 659 + match decode_compound_from_cstruct buf with 660 660 + | Error e -> Error e 661 661 + | Ok (css, trunc) -> Ok (List.map Cstruct.to_string css, trunc) 243 662 244 244 - let encode_packet packet ~buf = 245 245 - let enc = Encoder.create ~buf in 246 246 - Encoder.write_bytes enc (Cstruct.of_string magic); 247 247 - Encoder.write_byte enc version; 248 248 - Encoder.write_string enc packet.cluster; 249 249 - let msg_count = 1 + List.length packet.piggyback in 250 250 - Encoder.write_int16_be enc msg_count; 251 251 - encode_msg enc packet.primary; 252 252 - List.iter (encode_msg enc) packet.piggyback; 253 253 - if Encoder.remaining enc < 0 then Error `Buffer_too_small 254 254 - else Ok (Encoder.pos enc) 663 663 + let encode_push_pull_header (h : push_pull_header) : Msgpck.t = 664 664 + Msgpck.Map 665 665 + [ 666 666 + (Msgpck.String "Nodes", Msgpck.of_int h.pp_nodes); 667 667 + (Msgpck.String "UserStateLen", Msgpck.of_int h.pp_user_state_len); 668 668 + (Msgpck.String "Join", Msgpck.Bool h.pp_join); 669 669 + ] 255 670 256 256 - let decode_packet buf : (packet, decode_error) result = 257 257 - let dec = Decoder.create buf in 258 258 - let magic_bytes = Decoder.read_bytes dec ~len:4 in 259 259 - if Cstruct.to_string magic_bytes <> magic then Error Invalid_magic 260 260 - else 261 261 - let ver = Decoder.read_byte dec in 262 262 - if ver <> version then Error (Unsupported_version ver) 263 263 - else 264 264 - let cluster = Decoder.read_string dec in 265 265 - let msg_count = Decoder.read_int16_be dec in 266 266 - let rec decode_msgs acc remaining = 267 267 - if remaining = 0 then Ok (List.rev acc) 268 268 - else 269 269 - match decode_msg dec with 270 270 - | Error e -> Error e 271 271 - | Ok msg -> decode_msgs (msg :: acc) (remaining - 1) 671 671 + let decode_push_pull_header (m : Msgpck.t) : (push_pull_header, string) result = 672 672 + match m with 673 673 + | Msgpck.Map fields -> 674 674 + let get_int key = 675 675 + match List.assoc_opt (Msgpck.String key) fields with 676 676 + | Some (Msgpck.Int i) -> Ok i 677 677 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 678 678 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 679 679 + | _ -> Ok 0 680 680 + in 681 681 + let get_bool key = 682 682 + match List.assoc_opt (Msgpck.String key) fields with 683 683 + | Some (Msgpck.Bool b) -> Ok b 684 684 + | _ -> Ok false 272 685 in 273 273 - match decode_msgs [] msg_count with 274 274 - | Error e -> Error e 275 275 - | Ok [] -> Error Truncated_message 276 276 - | Ok (primary :: piggyback) -> Ok { cluster; primary; piggyback } 686 686 + let ( let* ) = Result.bind in 687 687 + let* pp_nodes = get_int "Nodes" in 688 688 + let* pp_user_state_len = get_int "UserStateLen" in 689 689 + let* pp_join = get_bool "Join" in 690 690 + Ok { pp_nodes; pp_user_state_len; pp_join } 691 691 + | _ -> Error "expected map for push_pull_header" 277 692 278 278 - let node_id_size node_id = 2 + String.length (node_id_to_string node_id) 693 693 + let encode_push_node_state (s : push_node_state) : Msgpck.t = 694 694 + Msgpck.Map 695 695 + [ 696 696 + (Msgpck.String "Name", Msgpck.String s.pns_name); 697 697 + (Msgpck.String "Addr", Msgpck.Bytes s.pns_addr); 698 698 + (Msgpck.String "Port", Msgpck.of_int s.pns_port); 699 699 + (Msgpck.String "Meta", Msgpck.Bytes s.pns_meta); 700 700 + (Msgpck.String "Incarnation", Msgpck.of_int s.pns_incarnation); 701 701 + (Msgpck.String "State", Msgpck.of_int s.pns_state); 702 702 + (Msgpck.String "Vsn", Msgpck.List (List.map Msgpck.of_int s.pns_vsn)); 703 703 + ] 704 704 + 705 705 + let decode_push_node_state (m : Msgpck.t) : (push_node_state, string) result = 706 706 + match m with 707 707 + | Msgpck.Map fields -> 708 708 + let get_string key = 709 709 + match List.assoc_opt (Msgpck.String key) fields with 710 710 + | Some (Msgpck.String s) -> Ok s 711 711 + | Some (Msgpck.Bytes s) -> Ok s 712 712 + | Some Msgpck.Nil -> Ok "" 713 713 + | _ -> Ok "" 714 714 + in 715 715 + let get_int key = 716 716 + match List.assoc_opt (Msgpck.String key) fields with 717 717 + | Some (Msgpck.Int i) -> Ok i 718 718 + | Some (Msgpck.Int32 i) -> Ok (Int32.to_int i) 719 719 + | Some (Msgpck.Uint32 i) -> Ok (Int32.to_int i) 720 720 + | _ -> Ok 0 721 721 + in 722 722 + let get_int_list key = 723 723 + match List.assoc_opt (Msgpck.String key) fields with 724 724 + | Some (Msgpck.List items) -> 725 725 + Ok 726 726 + (List.filter_map 727 727 + (function 728 728 + | Msgpck.Int i -> Some i 729 729 + | Msgpck.Int32 i -> Some (Int32.to_int i) 730 730 + | Msgpck.Uint32 i -> Some (Int32.to_int i) 731 731 + | _ -> None) 732 732 + items) 733 733 + | _ -> Ok [] 734 734 + in 735 735 + let ( let* ) = Result.bind in 736 736 + let* pns_name = get_string "Name" in 737 737 + let* pns_addr = get_string "Addr" in 738 738 + let* pns_port = get_int "Port" in 739 739 + let* pns_meta = get_string "Meta" in 740 740 + let* pns_incarnation = get_int "Incarnation" in 741 741 + let* pns_state = get_int "State" in 742 742 + let* pns_vsn = get_int_list "Vsn" in 743 743 + Ok 744 744 + { 745 745 + pns_name; 746 746 + pns_addr; 747 747 + pns_port; 748 748 + pns_meta; 749 749 + pns_incarnation; 750 750 + pns_state; 751 751 + pns_vsn; 752 752 + } 753 753 + | _ -> Error "expected map for push_node_state" 279 754 280 280 - let addr_size (addr : Eio.Net.Sockaddr.datagram) = 281 281 - match addr with 282 282 - | `Udp (ip, _) -> 283 283 - let ip_str = ip_to_string ip in 284 284 - 2 + String.length ip_str + 2 285 285 - | `Unix _ -> failwith "Unix sockets not supported for SWIM protocol" 755 755 + let encode_push_pull_msg ~(header : push_pull_header) 756 756 + ~(nodes : push_node_state list) ~(user_state : string) : string = 757 757 + let buf = Buffer.create 1024 in 758 758 + Buffer.add_char buf (Char.chr (message_type_to_int Push_pull_msg)); 759 759 + ignore (Msgpck.StringBuf.write buf (encode_push_pull_header header)); 760 760 + List.iter 761 761 + (fun n -> ignore (Msgpck.StringBuf.write buf (encode_push_node_state n))) 762 762 + nodes; 763 763 + Buffer.add_string buf user_state; 764 764 + Buffer.contents buf 286 765 287 287 - let node_size (node : node_info) = 288 288 - node_id_size node.id + addr_size node.addr + 2 + String.length node.meta 766 766 + let decode_push_pull_msg (data : string) : 767 767 + ( push_pull_header * push_node_state list * string, 768 768 + Types.decode_error ) 769 769 + result = 770 770 + if String.length data < 1 then Error Types.Truncated_message 771 771 + else 772 772 + let header_size, header_msgpack = Msgpck.String.read data in 773 773 + match decode_push_pull_header header_msgpack with 774 774 + | Error e -> Error (Types.Msgpack_error e) 775 775 + | Ok header -> ( 776 776 + let rec read_nodes offset remaining acc = 777 777 + if remaining <= 0 then Ok (List.rev acc, offset) 778 778 + else if offset >= String.length data then 779 779 + Error Types.Truncated_message 780 780 + else 781 781 + let rest = String.sub data offset (String.length data - offset) in 782 782 + let node_size, node_msgpack = Msgpck.String.read rest in 783 783 + match decode_push_node_state node_msgpack with 784 784 + | Error e -> Error (Types.Msgpack_error e) 785 785 + | Ok node -> 786 786 + read_nodes (offset + node_size) (remaining - 1) (node :: acc) 787 787 + in 788 788 + match read_nodes header_size header.pp_nodes [] with 789 789 + | Error e -> Error e 790 790 + | Ok (nodes, offset) -> 791 791 + let user_state = 792 792 + if header.pp_user_state_len > 0 && offset < String.length data 793 793 + then 794 794 + String.sub data offset 795 795 + (min header.pp_user_state_len (String.length data - offset)) 796 796 + else "" 797 797 + in 798 798 + Ok (header, nodes, user_state)) 289 799 290 290 - let option_size f = function None -> 1 | Some v -> 1 + f v 800 800 + let decode_compress_from_cstruct (buf : Cstruct.t) : 801 801 + (int * Cstruct.t, Types.decode_error) result = 802 802 + let data = Cstruct.to_string buf in 803 803 + let _, msgpack = Msgpck.String.read data in 804 804 + match msgpack with 805 805 + | Msgpck.Map fields -> ( 806 806 + let algo = 807 807 + match List.assoc_opt (Msgpck.String "Algo") fields with 808 808 + | Some (Msgpck.Int i) -> i 809 809 + | Some (Msgpck.Int32 i) -> Int32.to_int i 810 810 + | _ -> -1 811 811 + in 812 812 + let compressed_buf = 813 813 + match List.assoc_opt (Msgpck.String "Buf") fields with 814 814 + | Some (Msgpck.Bytes s) -> Some (Cstruct.of_string s) 815 815 + | Some (Msgpck.String s) -> Some (Cstruct.of_string s) 816 816 + | _ -> None 817 817 + in 818 818 + match compressed_buf with 819 819 + | Some cs -> Ok (algo, cs) 820 820 + | None -> Error (Types.Msgpack_error "missing Buf field")) 821 821 + | _ -> Error (Types.Msgpack_error "expected map for compress") 291 822 292 292 - let encoded_size msg = 293 293 - match msg with 294 294 - | Ping { sender; _ } -> 1 + 4 + node_size sender 295 295 - | Ping_req { target; sender; _ } -> 296 296 - 1 + 4 + node_id_size target + node_size sender 297 297 - | Ack { responder; payload; _ } -> 298 298 - 1 + 4 + node_size responder 299 299 - + option_size (fun s -> 2 + String.length s) payload 300 300 - | Alive { node; _ } -> 1 + node_size node + 4 301 301 - | Suspect { node; suspector; _ } -> 302 302 - 1 + node_id_size node + 4 + node_id_size suspector 303 303 - | Dead { node; declarator; _ } -> 304 304 - 1 + node_id_size node + 4 + node_id_size declarator 305 305 - | User_msg { topic; payload; origin } -> 306 306 - 1 + 2 + String.length topic + 2 + String.length payload 307 307 - + node_id_size origin 823 823 + let decode_push_pull_msg_cstruct (buf : Cstruct.t) : 824 824 + ( push_pull_header * push_node_state list * Cstruct.t, 825 825 + Types.decode_error ) 826 826 + result = 827 827 + if Cstruct.length buf < 1 then Error Types.Truncated_message 828 828 + else 829 829 + let data = Cstruct.to_string buf in 830 830 + let header_size, header_msgpack = Msgpck.String.read data in 831 831 + match decode_push_pull_header header_msgpack with 832 832 + | Error e -> Error (Types.Msgpack_error e) 833 833 + | Ok header -> ( 834 834 + let rec read_nodes offset remaining acc = 835 835 + if remaining <= 0 then Ok (List.rev acc, offset) 836 836 + else if offset >= String.length data then 837 837 + Error Types.Truncated_message 838 838 + else 839 839 + let rest = String.sub data offset (String.length data - offset) in 840 840 + let node_size, node_msgpack = Msgpck.String.read rest in 841 841 + match decode_push_node_state node_msgpack with 842 842 + | Error e -> Error (Types.Msgpack_error e) 843 843 + | Ok node -> 844 844 + read_nodes (offset + node_size) (remaining - 1) (node :: acc) 845 845 + in 846 846 + match read_nodes header_size header.pp_nodes [] with 847 847 + | Error e -> Error e 848 848 + | Ok (nodes, offset) -> 849 849 + let user_state = 850 850 + if header.pp_user_state_len > 0 && offset < Cstruct.length buf 851 851 + then 852 852 + Cstruct.sub buf offset 853 853 + (min header.pp_user_state_len (Cstruct.length buf - offset)) 854 854 + else Cstruct.empty 855 855 + in 856 856 + Ok (header, nodes, user_state))

+42 -13

lib/crypto.ml

··· 1 1 let nonce_size = 12 2 2 let tag_size = 16 3 3 - let overhead = nonce_size + tag_size 3 3 + let version_size = 1 4 4 + let encryption_version = 1 5 5 + let key_size = 16 6 6 + let overhead = version_size + nonce_size + tag_size 4 7 5 8 type key = Mirage_crypto.AES.GCM.key 6 9 7 10 let init_key secret = 8 8 - if String.length secret <> 32 then Error `Invalid_key_length 11 11 + if String.length secret <> key_size then Error `Invalid_key_length 9 12 else Ok (Mirage_crypto.AES.GCM.of_secret secret) 10 13 11 14 let generate_nonce (random : _ Eio.Flow.source) = ··· 19 22 Mirage_crypto.AES.GCM.authenticate_encrypt ~key ~nonce 20 23 (Cstruct.to_string plaintext) 21 24 in 22 22 - let result = Cstruct.create (nonce_size + String.length ciphertext) in 23 23 - Cstruct.blit_from_string nonce 0 result 0 nonce_size; 24 24 - Cstruct.blit_from_string ciphertext 0 result nonce_size 25 25 + let result = 26 26 + Cstruct.create (version_size + nonce_size + String.length ciphertext) 27 27 + in 28 28 + Cstruct.set_uint8 result 0 encryption_version; 29 29 + Cstruct.blit_from_string nonce 0 result version_size nonce_size; 30 30 + Cstruct.blit_from_string ciphertext 0 result 31 31 + (version_size + nonce_size) 25 32 (String.length ciphertext); 26 33 result 27 34 35 35 + let pkcs7_unpad data block_size = 36 36 + let len = String.length data in 37 37 + if len = 0 then data 38 38 + else 39 39 + let padding = Char.code data.[len - 1] in 40 40 + if padding > 0 && padding <= block_size && padding <= len then 41 41 + String.sub data 0 (len - padding) 42 42 + else data 43 43 + 28 44 let decrypt ~key data = 29 45 if Cstruct.length data < overhead then Error `Too_short 30 46 else 31 31 - let nonce = Cstruct.to_string (Cstruct.sub data 0 nonce_size) in 32 32 - let ciphertext = 33 33 - Cstruct.to_string 34 34 - (Cstruct.sub data nonce_size (Cstruct.length data - nonce_size)) 35 35 - in 36 36 - match Mirage_crypto.AES.GCM.authenticate_decrypt ~key ~nonce ciphertext with 37 37 - | Some plaintext -> Ok (Cstruct.of_string plaintext) 38 38 - | None -> Error `Decryption_failed 47 47 + let version = Cstruct.get_uint8 data 0 in 48 48 + if version > 1 then Error `Unsupported_version 49 49 + else 50 50 + let nonce = 51 51 + Cstruct.to_string (Cstruct.sub data version_size nonce_size) 52 52 + in 53 53 + let ciphertext = 54 54 + Cstruct.to_string 55 55 + (Cstruct.sub data 56 56 + (version_size + nonce_size) 57 57 + (Cstruct.length data - version_size - nonce_size)) 58 58 + in 59 59 + match 60 60 + Mirage_crypto.AES.GCM.authenticate_decrypt ~key ~nonce ciphertext 61 61 + with 62 62 + | Some plaintext -> 63 63 + let plaintext = 64 64 + if version = 0 then pkcs7_unpad plaintext 16 else plaintext 65 65 + in 66 66 + Ok (Cstruct.of_string plaintext) 67 67 + | None -> Error `Decryption_failed

+31 -23

lib/dissemination.ml

··· 10 10 11 11 let create () = { queue = Kcas_data.Queue.create (); depth = Kcas.Loc.make 0 } 12 12 13 13 - let enqueue t msg ~transmits ~created = 13 13 + let enqueue t msg ~transmits ~created ~limit = 14 14 let item = { msg; transmits = Kcas.Loc.make transmits; created } in 15 15 Kcas.Xt.commit 16 16 { 17 17 tx = 18 18 (fun ~xt -> 19 19 - Kcas_data.Queue.Xt.add ~xt item t.queue; 20 20 - Kcas.Xt.modify ~xt t.depth succ); 19 19 + let d = Kcas.Xt.get ~xt t.depth in 20 20 + if d >= limit then ignore (Kcas_data.Queue.Xt.take_opt ~xt t.queue) 21 21 + else Kcas.Xt.set ~xt t.depth (d + 1); 22 22 + Kcas_data.Queue.Xt.add ~xt item t.queue); 21 23 } 22 24 23 25 let depth t = Kcas.Xt.commit { tx = (fun ~xt -> Kcas.Xt.get ~xt t.depth) } 24 26 25 27 let drain t ~max_bytes ~encode_size = 26 28 let rec loop acc bytes_used = 27 27 - Kcas.Xt.commit 28 28 - { 29 29 - tx = 30 30 - (fun ~xt -> 31 31 - match Kcas_data.Queue.Xt.take_opt ~xt t.queue with 32 32 - | None -> List.rev acc 33 33 - | Some item -> 34 34 - let msg_size = encode_size item.msg in 35 35 - if bytes_used + msg_size > max_bytes && acc <> [] then begin 36 36 - Kcas_data.Queue.Xt.add ~xt item t.queue; 37 37 - List.rev acc 38 38 - end 39 39 - else 40 40 - let remaining = Kcas.Xt.get ~xt item.transmits - 1 in 41 41 - if remaining > 0 then begin 42 42 - Kcas.Xt.set ~xt item.transmits remaining; 43 43 - Kcas_data.Queue.Xt.add ~xt item t.queue 29 29 + let result = 30 30 + Kcas.Xt.commit 31 31 + { 32 32 + tx = 33 33 + (fun ~xt -> 34 34 + match Kcas_data.Queue.Xt.take_opt ~xt t.queue with 35 35 + | None -> `Done (List.rev acc) 36 36 + | Some item -> 37 37 + let msg_size = encode_size item.msg in 38 38 + if bytes_used + msg_size > max_bytes && acc <> [] then begin 39 39 + Kcas_data.Queue.Xt.add ~xt item t.queue; 40 40 + `Done (List.rev acc) 44 41 end 45 45 - else Kcas.Xt.modify ~xt t.depth pred; 46 46 - loop (item.msg :: acc) (bytes_used + msg_size)); 47 47 - } 42 42 + else begin 43 43 + let remaining = Kcas.Xt.get ~xt item.transmits - 1 in 44 44 + if remaining > 0 then begin 45 45 + Kcas.Xt.set ~xt item.transmits remaining; 46 46 + Kcas_data.Queue.Xt.add ~xt item t.queue 47 47 + end 48 48 + else Kcas.Xt.modify ~xt t.depth pred; 49 49 + `Continue (item.msg, msg_size) 50 50 + end); 51 51 + } 52 52 + in 53 53 + match result with 54 54 + | `Done msgs -> msgs 55 55 + | `Continue (msg, msg_size) -> loop (msg :: acc) (bytes_used + msg_size) 48 56 in 49 57 loop [] 0 50 58

+4 -1

lib/dissemination.mli

··· 9 9 type t 10 10 11 11 val create : unit -> t 12 12 - val enqueue : t -> protocol_msg -> transmits:int -> created:Mtime.span -> unit 12 12 + 13 13 + val enqueue : 14 14 + t -> protocol_msg -> transmits:int -> created:Mtime.span -> limit:int -> unit 15 15 + 13 16 val depth : t -> int 14 17 15 18 val drain :

+7 -6

lib/dune

··· 1 1 (library 2 2 (name swim) 3 3 (public_name swim) 4 4 - (libraries 5 5 - eio 6 6 - eio_main 7 7 - kcas 8 8 - kcas_data 4 4 + (flags (:standard -w -34-69)) 5 5 + (libraries 6 6 + eio 7 7 + kcas 8 8 + kcas_data 9 9 mirage-crypto 10 10 mirage-crypto-rng 11 11 cstruct 12 12 mtime 13 13 logs 14 14 - fmt)) 14 14 + fmt 15 15 + msgpck))

+138

lib/lzw.ml

··· 1 1 + type order = LSB | MSB 2 2 + type error = Invalid_code of int | Unexpected_eof | Buffer_overflow 3 3 + 4 4 + let error_to_string = function 5 5 + | Invalid_code c -> Printf.sprintf "invalid LZW code: %d" c 6 6 + | Unexpected_eof -> "unexpected end of compressed data" 7 7 + | Buffer_overflow -> "decompressed data too large" 8 8 + 9 9 + let clear_code = 256 10 10 + let eof_code = 257 11 11 + let initial_dict_size = 258 12 12 + let max_code_bits = 12 13 13 + let max_dict_size = 1 lsl max_code_bits 14 14 + 15 15 + type bit_reader = { 16 16 + data : Cstruct.t; 17 17 + mutable pos : int; 18 18 + mutable bits_buf : int; 19 19 + mutable bits_count : int; 20 20 + } 21 21 + 22 22 + let make_bit_reader data = { data; pos = 0; bits_buf = 0; bits_count = 0 } 23 23 + 24 24 + let read_bits_lsb reader n = 25 25 + while reader.bits_count < n do 26 26 + if reader.pos >= Cstruct.length reader.data then raise Exit 27 27 + else begin 28 28 + let byte = Cstruct.get_uint8 reader.data reader.pos in 29 29 + reader.bits_buf <- reader.bits_buf lor (byte lsl reader.bits_count); 30 30 + reader.bits_count <- reader.bits_count + 8; 31 31 + reader.pos <- reader.pos + 1 32 32 + end 33 33 + done; 34 34 + let result = reader.bits_buf land ((1 lsl n) - 1) in 35 35 + reader.bits_buf <- reader.bits_buf lsr n; 36 36 + reader.bits_count <- reader.bits_count - n; 37 37 + result 38 38 + 39 39 + let decompress_to_buffer ~src ~dst = 40 40 + try 41 41 + let reader = make_bit_reader src in 42 42 + let out_pos = ref 0 in 43 43 + let dst_len = Cstruct.length dst in 44 44 + 45 45 + let dict = Array.make max_dict_size (Cstruct.empty, 0) in 46 46 + for i = 0 to 255 do 47 47 + dict.(i) <- (Cstruct.of_string (String.make 1 (Char.chr i)), 1) 48 48 + done; 49 49 + dict.(clear_code) <- (Cstruct.empty, 0); 50 50 + dict.(eof_code) <- (Cstruct.empty, 0); 51 51 + 52 52 + let dict_size = ref initial_dict_size in 53 53 + let code_bits = ref 9 in 54 54 + let prev_code = ref (-1) in 55 55 + 56 56 + let write_entry (entry, len) = 57 57 + if !out_pos + len > dst_len then raise (Failure "overflow"); 58 58 + Cstruct.blit entry 0 dst !out_pos len; 59 59 + out_pos := !out_pos + len 60 60 + in 61 61 + 62 62 + let add_to_dict first_byte = 63 63 + if !dict_size < max_dict_size && !prev_code >= 0 then begin 64 64 + let prev_entry, prev_len = dict.(!prev_code) in 65 65 + let new_entry = Cstruct.create (prev_len + 1) in 66 66 + Cstruct.blit prev_entry 0 new_entry 0 prev_len; 67 67 + Cstruct.set_uint8 new_entry prev_len first_byte; 68 68 + dict.(!dict_size) <- (new_entry, prev_len + 1); 69 69 + incr dict_size; 70 70 + if !dict_size >= 1 lsl !code_bits && !code_bits < max_code_bits then 71 71 + incr code_bits 72 72 + end 73 73 + in 74 74 + 75 75 + let reset_dict () = 76 76 + dict_size := initial_dict_size; 77 77 + code_bits := 9; 78 78 + prev_code := -1 79 79 + in 80 80 + 81 81 + let rec decode_loop () = 82 82 + let code = read_bits_lsb reader !code_bits in 83 83 + if code = eof_code then () 84 84 + else if code = clear_code then begin 85 85 + reset_dict (); 86 86 + decode_loop () 87 87 + end 88 88 + else begin 89 89 + let entry, len, first_byte = 90 90 + if code < !dict_size then 91 91 + let e, l = dict.(code) in 92 92 + (e, l, Cstruct.get_uint8 e 0) 93 93 + else if code = !dict_size && !prev_code >= 0 then ( 94 94 + let prev_entry, prev_len = dict.(!prev_code) in 95 95 + let first = Cstruct.get_uint8 prev_entry 0 in 96 96 + let new_entry = Cstruct.create (prev_len + 1) in 97 97 + Cstruct.blit prev_entry 0 new_entry 0 prev_len; 98 98 + Cstruct.set_uint8 new_entry prev_len first; 99 99 + (new_entry, prev_len + 1, first)) 100 100 + else raise (Failure "invalid") 101 101 + in 102 102 + write_entry (entry, len); 103 103 + add_to_dict first_byte; 104 104 + prev_code := code; 105 105 + decode_loop () 106 106 + end 107 107 + in 108 108 + 109 109 + decode_loop (); 110 110 + Ok !out_pos 111 111 + with 112 112 + | Exit -> Error Unexpected_eof 113 113 + | Failure msg when msg = "overflow" -> Error Buffer_overflow 114 114 + | Failure msg when msg = "invalid" -> Error (Invalid_code 0) 115 115 + | _ -> Error (Invalid_code 0) 116 116 + 117 117 + let decompress_cstruct src = 118 118 + let estimated_size = max (Cstruct.length src * 4) 4096 in 119 119 + let dst = Cstruct.create estimated_size in 120 120 + match decompress_to_buffer ~src ~dst with 121 121 + | Ok len -> Ok (Cstruct.sub dst 0 len) 122 122 + | Error Buffer_overflow -> ( 123 123 + let larger = Cstruct.create (estimated_size * 4) in 124 124 + match decompress_to_buffer ~src ~dst:larger with 125 125 + | Ok len -> Ok (Cstruct.sub larger 0 len) 126 126 + | Error e -> Error e) 127 127 + | Error e -> Error e 128 128 + 129 129 + let decompress ?(order = LSB) ?(lit_width = 8) data = 130 130 + if order <> LSB then Error (Invalid_code 0) 131 131 + else if lit_width <> 8 then Error (Invalid_code 0) 132 132 + else 133 133 + let src = Cstruct.of_string data in 134 134 + match decompress_cstruct src with 135 135 + | Ok cs -> Ok (Cstruct.to_string cs) 136 136 + | Error e -> Error e 137 137 + 138 138 + let decompress_lsb8 data = decompress ~order:LSB ~lit_width:8 data

+11

lib/lzw.mli

··· 1 1 + type order = LSB | MSB 2 2 + type error = Invalid_code of int | Unexpected_eof | Buffer_overflow 3 3 + 4 4 + val error_to_string : error -> string 5 5 + val decompress_to_buffer : src:Cstruct.t -> dst:Cstruct.t -> (int, error) result 6 6 + val decompress_cstruct : Cstruct.t -> (Cstruct.t, error) result 7 7 + 8 8 + val decompress : 9 9 + ?order:order -> ?lit_width:int -> string -> (string, error) result 10 10 + 11 11 + val decompress_lsb8 : string -> (string, error) result

+310 -16

lib/protocol.ml

··· 11 11 probe_index : int Kcas.Loc.t; 12 12 send_pool : Buffer_pool.t; 13 13 recv_pool : Buffer_pool.t; 14 14 + tcp_recv_pool : Buffer_pool.t; 15 15 + tcp_decompress_pool : Buffer_pool.t; 14 16 udp_sock : [ `Generic ] Eio.Net.datagram_socket_ty Eio.Resource.t; 17 17 + tcp_listener : [ `Generic ] Eio.Net.listening_socket_ty Eio.Resource.t; 15 18 event_stream : node_event Eio.Stream.t; 16 19 user_handlers : (node_info -> string -> string -> unit) list Kcas.Loc.t; 17 20 cipher_key : Crypto.key; ··· 20 23 clock : float Eio.Time.clock_ty Eio.Resource.t; 21 24 mono_clock : Eio.Time.Mono.ty Eio.Resource.t; 22 25 secure_random : Eio.Flow.source_ty Eio.Resource.t; 26 26 + sw : Eio.Switch.t; 23 27 } 24 28 25 29 let next_seq t = ··· 70 74 | Error `Buffer_too_small -> () 71 75 | Ok encoded_len -> 72 76 let encoded = Cstruct.sub buf 0 encoded_len in 73 73 - let encrypted = 74 74 - Crypto.encrypt ~key:t.cipher_key ~random:t.secure_random encoded 77 77 + let to_send = 78 78 + if t.config.encryption_enabled then 79 79 + Crypto.encrypt ~key:t.cipher_key ~random:t.secure_random encoded 80 80 + else encoded 75 81 in 76 76 - Transport.send_udp t.udp_sock dst encrypted; 82 82 + Transport.send_udp t.udp_sock dst to_send; 77 83 update_stats t (fun s -> { s with msgs_sent = s.msgs_sent + 1 })) 78 84 79 85 let make_packet t ~primary ~piggyback = ··· 88 94 Protocol_pure.retransmit_limit t.config 89 95 ~node_count:(Membership.count t.members) 90 96 in 91 91 - Dissemination.enqueue t.broadcast_queue msg ~transmits ~created:(now_mtime t); 97 97 + Dissemination.enqueue t.broadcast_queue msg ~transmits ~created:(now_mtime t) 98 98 + ~limit:t.config.max_gossip_queue_depth; 92 99 Dissemination.invalidate t.broadcast_queue 93 100 ~invalidates:Protocol_pure.invalidates msg 94 101 95 102 let handle_ping t ~src (ping : protocol_msg) = 96 103 match ping with 97 97 - | Ping { seq; sender = _ } -> 104 104 + | Ping { seq; _ } -> 98 105 let piggyback = 99 106 drain_piggyback t ~max_bytes:(t.config.udp_buffer_size - 100) 100 107 in ··· 110 117 | None -> () 111 118 | Some member -> 112 119 let target_addr = (Membership.Member.node member).addr in 113 113 - let ping = Ping { seq; sender = t.self } in 120 120 + let ping = Ping { seq; target; sender = t.self } in 114 121 let packet = make_packet t ~primary:ping ~piggyback:[] in 115 122 send_packet t ~dst:target_addr packet) 116 123 | _ -> () ··· 140 147 | Suspect -> 141 148 Membership.Member.set_suspect ~xt m 142 149 ~incarnation:transition.new_state.incarnation ~now 143 143 - | Dead -> 150 150 + | Dead | Left -> 144 151 Membership.Member.set_dead ~xt m 145 152 ~incarnation:transition.new_state.incarnation ~now); 146 153 } ··· 176 183 let handlers = 177 184 Kcas.Xt.commit { tx = (fun ~xt -> Kcas.Xt.get ~xt t.user_handlers) } 178 185 in 179 179 - match Membership.find t.members origin with 180 180 - | None -> () 181 181 - | Some member -> 182 182 - let node = Membership.Member.node member in 183 183 - List.iter (fun h -> h node topic payload) handlers) 186 186 + if List.length handlers = 0 then () 187 187 + else 188 188 + match Membership.find t.members origin with 189 189 + | None -> () 190 190 + | Some member -> 191 191 + let node = Membership.Member.node member in 192 192 + List.iter (fun h -> h node topic payload) handlers) 184 193 | _ -> () 185 194 186 195 let handle_message t ~src (msg : protocol_msg) = ··· 201 210 end 202 211 203 212 let process_udp_packet t ~buf ~src = 204 204 - match Crypto.decrypt ~key:t.cipher_key buf with 213 213 + let decrypted_result = 214 214 + if t.config.encryption_enabled then Crypto.decrypt ~key:t.cipher_key buf 215 215 + else Ok buf 216 216 + in 217 217 + match decrypted_result with 205 218 | Error _ -> 206 219 update_stats t (fun s -> { s with msgs_dropped = s.msgs_dropped + 1 }) 207 220 | Ok decrypted -> ( ··· 218 231 process_udp_packet t ~buf:received ~src) 219 232 done 220 233 234 234 + let build_local_state t ~is_join = 235 235 + let members = Membership.to_list t.members in 236 236 + let self_node = 237 237 + let addr_bytes, port = 238 238 + match t.self.addr with 239 239 + | `Udp (ip, p) -> (Types.ip_to_bytes ip, p) 240 240 + | `Unix _ -> ("", 0) 241 241 + in 242 242 + Types.Wire. 243 243 + { 244 244 + pns_name = Types.node_id_to_string t.self.id; 245 245 + pns_addr = addr_bytes; 246 246 + pns_port = port; 247 247 + pns_meta = t.self.meta; 248 248 + pns_incarnation = Types.incarnation_to_int (get_incarnation t); 249 249 + pns_state = 0; 250 250 + pns_vsn = Types.default_vsn; 251 251 + } 252 252 + in 253 253 + let member_nodes = 254 254 + List.map 255 255 + (fun member -> 256 256 + let node = Membership.Member.node member in 257 257 + let snap = Membership.Member.snapshot_now member in 258 258 + let addr_bytes, port = 259 259 + match node.addr with 260 260 + | `Udp (ip, p) -> (Types.ip_to_bytes ip, p) 261 261 + | `Unix _ -> ("", 0) 262 262 + in 263 263 + Types.Wire. 264 264 + { 265 265 + pns_name = Types.node_id_to_string node.id; 266 266 + pns_addr = addr_bytes; 267 267 + pns_port = port; 268 268 + pns_meta = node.meta; 269 269 + pns_incarnation = Types.incarnation_to_int snap.incarnation; 270 270 + pns_state = Types.member_state_to_int snap.state; 271 271 + pns_vsn = Types.default_vsn; 272 272 + }) 273 273 + members 274 274 + in 275 275 + let all_nodes = self_node :: member_nodes in 276 276 + let header = 277 277 + Types.Wire. 278 278 + { 279 279 + pp_nodes = List.length all_nodes; 280 280 + pp_user_state_len = 0; 281 281 + pp_join = is_join; 282 282 + } 283 283 + in 284 284 + (header, all_nodes) 285 285 + 286 286 + let merge_remote_state t (nodes : Types.Wire.push_node_state list) ~is_join = 287 287 + List.iter 288 288 + (fun (pns : Types.Wire.push_node_state) -> 289 289 + let node_id = Types.node_id_of_string pns.pns_name in 290 290 + if not (Types.equal_node_id node_id t.self.id) then 291 291 + let ip = Types.ip_of_bytes pns.pns_addr in 292 292 + let node_info = 293 293 + Types.make_node_info ~id:node_id 294 294 + ~addr:(`Udp (ip, pns.pns_port)) 295 295 + ~meta:pns.pns_meta 296 296 + in 297 297 + match Membership.find t.members node_id with 298 298 + | None -> 299 299 + if pns.pns_state <= 1 then begin 300 300 + let now = now_mtime t in 301 301 + let member = Membership.Member.create ~now node_info in 302 302 + Membership.add t.members member; 303 303 + emit_event t (Types.Join node_info) 304 304 + end 305 305 + | Some existing -> 306 306 + let snap = Membership.Member.snapshot_now existing in 307 307 + let remote_inc = Types.incarnation_of_int pns.pns_incarnation in 308 308 + if Types.compare_incarnation remote_inc snap.incarnation > 0 then begin 309 309 + let now = now_mtime t in 310 310 + let new_state = Types.member_state_of_int pns.pns_state in 311 311 + Membership.update_member t.members node_id 312 312 + { 313 313 + update = 314 314 + (fun m ~xt -> 315 315 + match new_state with 316 316 + | Types.Alive -> 317 317 + Membership.Member.set_alive ~xt m 318 318 + ~incarnation:remote_inc ~now 319 319 + | Types.Suspect -> 320 320 + Membership.Member.set_suspect ~xt m 321 321 + ~incarnation:remote_inc ~now 322 322 + | Types.Dead | Types.Left -> 323 323 + Membership.Member.set_dead ~xt m 324 324 + ~incarnation:remote_inc ~now); 325 325 + } 326 326 + |> ignore 327 327 + end) 328 328 + nodes; 329 329 + if is_join then 330 330 + update_stats t (fun s -> { s with msgs_received = s.msgs_received + 1 }) 331 331 + 332 332 + let read_exact flow buf n = 333 333 + let rec loop offset remaining = 334 334 + if remaining <= 0 then Ok () 335 335 + else 336 336 + let chunk = Cstruct.sub buf offset remaining in 337 337 + match Eio.Flow.single_read flow chunk with 338 338 + | 0 -> Error `Connection_closed 339 339 + | read -> loop (offset + read) (remaining - read) 340 340 + | exception End_of_file -> Error `Connection_closed 341 341 + | exception _ -> Error `Read_error 342 342 + in 343 343 + loop 0 n 344 344 + 345 345 + let read_available flow buf = 346 346 + match Eio.Flow.single_read flow buf with 347 347 + | n -> n 348 348 + | exception End_of_file -> 0 349 349 + | exception _ -> 0 350 350 + 351 351 + let decompress_payload data = 352 352 + let _, msgpack = Msgpck.String.read data in 353 353 + match msgpack with 354 354 + | Msgpck.Map fields -> 355 355 + let algo = 356 356 + match List.assoc_opt (Msgpck.String "Algo") fields with 357 357 + | Some (Msgpck.Int i) -> i 358 358 + | Some (Msgpck.Int32 i) -> Int32.to_int i 359 359 + | _ -> -1 360 360 + in 361 361 + let compressed_buf = 362 362 + match List.assoc_opt (Msgpck.String "Buf") fields with 363 363 + | Some (Msgpck.Bytes s) -> Some s 364 364 + | Some (Msgpck.String s) -> Some s 365 365 + | _ -> None 366 366 + in 367 367 + if algo = 0 then 368 368 + match compressed_buf with 369 369 + | Some buf -> ( 370 370 + match Lzw.decompress_lsb8 buf with 371 371 + | Ok decompressed -> Some decompressed 372 372 + | Error _ -> None) 373 373 + | None -> None 374 374 + else None 375 375 + | _ -> None 376 376 + 377 377 + let decompress_payload_cstruct ~src ~dst = 378 378 + match Codec.decode_compress_from_cstruct src with 379 379 + | Error _ -> None 380 380 + | Ok (algo, compressed) -> 381 381 + if algo = 0 then 382 382 + match Lzw.decompress_to_buffer ~src:compressed ~dst with 383 383 + | Ok len -> Some len 384 384 + | Error _ -> None 385 385 + else None 386 386 + 387 387 + let handle_tcp_connection t flow = 388 388 + Buffer_pool.with_buffer t.tcp_recv_pool (fun buf -> 389 389 + Buffer_pool.with_buffer t.tcp_decompress_pool (fun decomp_buf -> 390 390 + match read_exact flow buf 1 with 391 391 + | Error _ -> () 392 392 + | Ok () -> ( 393 393 + let msg_type_byte = Cstruct.get_uint8 buf 0 in 394 394 + let get_push_pull_payload () = 395 395 + let n = read_available flow (Cstruct.shift buf 1) in 396 396 + if n > 0 then Some (Cstruct.sub buf 1 n) else None 397 397 + in 398 398 + let payload_opt = 399 399 + if 400 400 + msg_type_byte 401 401 + = Types.Wire.message_type_to_int Types.Wire.Encrypt_msg 402 402 + then 403 403 + match get_push_pull_payload () with 404 404 + | Some encrypted -> ( 405 405 + match Crypto.decrypt ~key:t.cipher_key encrypted with 406 406 + | Ok decrypted -> Some decrypted 407 407 + | Error _ -> None) 408 408 + | None -> None 409 409 + else if 410 410 + msg_type_byte 411 411 + = Types.Wire.message_type_to_int Types.Wire.Compress_msg 412 412 + then 413 413 + match get_push_pull_payload () with 414 414 + | Some compressed -> ( 415 415 + match 416 416 + decompress_payload_cstruct ~src:compressed 417 417 + ~dst:decomp_buf 418 418 + with 419 419 + | Some len -> 420 420 + if len > 0 then 421 421 + let inner_type = Cstruct.get_uint8 decomp_buf 0 in 422 422 + if 423 423 + inner_type 424 424 + = Types.Wire.message_type_to_int 425 425 + Types.Wire.Push_pull_msg 426 426 + then Some (Cstruct.sub decomp_buf 1 (len - 1)) 427 427 + else None 428 428 + else None 429 429 + | None -> None) 430 430 + | None -> None 431 431 + else if 432 432 + msg_type_byte 433 433 + = Types.Wire.message_type_to_int Types.Wire.Has_label_msg 434 434 + then 435 435 + match read_exact flow buf 1 with 436 436 + | Error _ -> None 437 437 + | Ok () -> 438 438 + let label_len = Cstruct.get_uint8 buf 0 in 439 439 + if label_len > 0 then 440 440 + match read_exact flow buf label_len with 441 441 + | Error _ -> None 442 442 + | Ok () -> ( 443 443 + match read_exact flow buf 1 with 444 444 + | Error _ -> None 445 445 + | Ok () -> 446 446 + let inner_type = Cstruct.get_uint8 buf 0 in 447 447 + if 448 448 + inner_type 449 449 + = Types.Wire.message_type_to_int 450 450 + Types.Wire.Push_pull_msg 451 451 + then get_push_pull_payload () 452 452 + else None) 453 453 + else None 454 454 + else if 455 455 + msg_type_byte 456 456 + = Types.Wire.message_type_to_int Types.Wire.Push_pull_msg 457 457 + then get_push_pull_payload () 458 458 + else None 459 459 + in 460 460 + match payload_opt with 461 461 + | None -> () 462 462 + | Some payload -> ( 463 463 + match Codec.decode_push_pull_msg_cstruct payload with 464 464 + | Error _ -> () 465 465 + | Ok (header, nodes, _user_state) -> ( 466 466 + merge_remote_state t nodes ~is_join:header.pp_join; 467 467 + let resp_header, resp_nodes = 468 468 + build_local_state t ~is_join:false 469 469 + in 470 470 + let response = 471 471 + Codec.encode_push_pull_msg ~header:resp_header 472 472 + ~nodes:resp_nodes ~user_state:"" 473 473 + in 474 474 + let resp_buf = 475 475 + if t.config.encryption_enabled then 476 476 + let plain = Cstruct.of_string response in 477 477 + let encrypted = 478 478 + Crypto.encrypt ~key:t.cipher_key 479 479 + ~random:t.secure_random plain 480 480 + in 481 481 + encrypted 482 482 + else Cstruct.of_string response 483 483 + in 484 484 + try Eio.Flow.write flow [ resp_buf ] with _ -> ()))))) 485 485 + 486 486 + let run_tcp_listener t = 487 487 + while not (is_shutdown t) do 488 488 + match Eio.Net.accept ~sw:t.sw t.tcp_listener with 489 489 + | flow, _addr -> 490 490 + (try handle_tcp_connection t flow with _ -> ()); 491 491 + Eio.Flow.close flow 492 492 + | exception _ -> () 493 493 + done 494 494 + 221 495 let probe_member t (member : Membership.Member.t) = 222 496 let target = Membership.Member.node member in 223 497 let seq = next_seq t in 224 498 let piggyback = 225 499 drain_piggyback t ~max_bytes:(t.config.udp_buffer_size - 100) 226 500 in 227 227 - let ping = Ping { seq; sender = t.self } in 501 501 + let ping = Ping { seq; target = target.id; sender = t.self } in 228 502 let packet = make_packet t ~primary:ping ~piggyback in 229 503 230 504 let waiter = Pending_acks.register t.pending_acks ~seq in ··· 311 585 Eio.Time.sleep t.clock t.config.protocol_interval 312 586 done 313 587 314 314 - let create ~config ~self ~udp_sock ~clock ~mono_clock ~secure_random = 588 588 + let create ~sw ~config ~self ~udp_sock ~tcp_listener ~clock ~mono_clock 589 589 + ~secure_random = 315 590 match Crypto.init_key config.secret_key with 316 591 | Error _ -> Error `Invalid_key 317 592 | Ok cipher_key -> ··· 331 606 recv_pool = 332 607 Buffer_pool.create ~size:config.udp_buffer_size 333 608 ~count:config.recv_buffer_count; 609 609 + tcp_recv_pool = Buffer_pool.create ~size:65536 ~count:4; 610 610 + tcp_decompress_pool = Buffer_pool.create ~size:131072 ~count:4; 334 611 udp_sock; 612 612 + tcp_listener; 335 613 event_stream = Eio.Stream.create 100; 336 614 user_handlers = Kcas.Loc.make []; 337 615 cipher_key; ··· 340 618 clock; 341 619 mono_clock; 342 620 secure_random; 621 621 + sw; 343 622 } 344 623 345 624 let shutdown t = ··· 374 653 match snap.state with 375 654 | Alive -> (a + 1, s, d) 376 655 | Suspect -> (a, s + 1, d) 377 377 - | Dead -> (a, s, d + 1)) 656 656 + | Dead | Left -> (a, s, d + 1)) 378 657 (0, 0, 0) 379 658 in 380 659 { ··· 392 671 let broadcast t ~topic ~payload = 393 672 let msg = User_msg { topic; payload; origin = t.self.id } in 394 673 enqueue_broadcast t msg 674 674 + 675 675 + let send_direct t ~target ~topic ~payload = 676 676 + match Membership.find t.members target with 677 677 + | None -> Error `Unknown_node 678 678 + | Some member -> 679 679 + let node = Membership.Member.node member in 680 680 + let msg = User_msg { topic; payload; origin = t.self.id } in 681 681 + let packet = make_packet t ~primary:msg ~piggyback:[] in 682 682 + send_packet t ~dst:node.addr packet; 683 683 + Ok () 684 684 + 685 685 + let send_to_addr t ~addr ~topic ~payload = 686 686 + let msg = User_msg { topic; payload; origin = t.self.id } in 687 687 + let packet = make_packet t ~primary:msg ~piggyback:[] in 688 688 + send_packet t ~dst:addr packet 395 689 396 690 let on_message t handler = 397 691 Kcas.Xt.commit

+3 -3

lib/protocol_pure.ml

··· 37 37 in 38 38 let events = 39 39 match member.state with 40 40 - | Dead -> [ Join node ] 40 40 + | Dead | Left -> [ Join node ] 41 41 | Suspect -> [ Alive_event node ] 42 42 | Alive -> [ Update node ] 43 43 in ··· 161 161 if not (equal_node_id local.node.id remote.node.id) then local 162 162 else 163 163 match (local.state, remote.state) with 164 164 - | Dead, _ -> local 165 165 - | _, Dead -> 164 164 + | Dead, _ | Left, _ -> local 165 165 + | _, Dead | _, Left -> 166 166 if compare_incarnation remote.incarnation local.incarnation >= 0 then 167 167 remote 168 168 else local

+23 -3

lib/swim.ml

··· 1 1 module Types = Types 2 2 module Codec = Codec 3 3 module Crypto = Crypto 4 4 + module Lzw = Lzw 4 5 module Buffer_pool = Buffer_pool 5 6 module Protocol_pure = Protocol_pure 6 7 module Membership = Membership ··· 30 31 ~port:config.bind_port 31 32 in 32 33 34 34 + let tcp_listener = 35 35 + Transport.create_tcp_listener net ~sw ~addr:config.bind_addr 36 36 + ~port:config.bind_port ~backlog:10 37 37 + in 38 38 + 33 39 let self_addr = 34 40 `Udp (Eio.Net.Ipaddr.of_raw config.bind_addr, config.bind_port) 35 41 in 36 42 let self = Types.make_node_info ~id:self_id ~addr:self_addr ~meta:"" in 37 43 38 44 match 39 39 - Protocol.create ~config ~self ~udp_sock ~clock ~mono_clock ~secure_random 45 45 + Protocol.create ~sw ~config ~self ~udp_sock ~tcp_listener ~clock 46 46 + ~mono_clock ~secure_random 40 47 with 41 48 | Error `Invalid_key -> Error `Invalid_key 42 49 | Ok protocol -> Ok { protocol; sw } 43 50 44 51 let start t = 45 45 - Eio.Fiber.fork ~sw:t.sw (fun () -> Protocol.run_protocol t.protocol); 46 46 - Eio.Fiber.fork ~sw:t.sw (fun () -> Protocol.run_udp_receiver t.protocol) 52 52 + Eio.Fiber.fork_daemon ~sw:t.sw (fun () -> 53 53 + Protocol.run_protocol t.protocol; 54 54 + `Stop_daemon); 55 55 + Eio.Fiber.fork_daemon ~sw:t.sw (fun () -> 56 56 + Protocol.run_udp_receiver t.protocol; 57 57 + `Stop_daemon); 58 58 + Eio.Fiber.fork_daemon ~sw:t.sw (fun () -> 59 59 + Protocol.run_tcp_listener t.protocol; 60 60 + `Stop_daemon) 47 61 48 62 let shutdown t = Protocol.shutdown t.protocol 49 63 let local_node t = Protocol.local_node t.protocol ··· 69 83 70 84 let broadcast t ~topic ~payload = 71 85 Protocol.broadcast t.protocol ~topic ~payload 86 86 + 87 87 + let send t ~target ~topic ~payload = 88 88 + Protocol.send_direct t.protocol ~target ~topic ~payload 89 89 + 90 90 + let send_to_addr t ~addr ~topic ~payload = 91 91 + Protocol.send_to_addr t.protocol ~addr ~topic ~payload 72 92 73 93 let on_message t handler = Protocol.on_message t.protocol handler 74 94

+402 -5

lib/types.ml

··· 18 18 19 19 let make_node_info ~id ~addr ~meta = { id; addr; meta } 20 20 21 21 - type member_state = Alive | Suspect | Dead 21 21 + type member_state = Alive | Suspect | Dead | Left 22 22 23 23 let member_state_to_string = function 24 24 | Alive -> "alive" 25 25 | Suspect -> "suspect" 26 26 | Dead -> "dead" 27 27 + | Left -> "left" 28 28 + 29 29 + let member_state_to_int = function 30 30 + | Alive -> 0 31 31 + | Suspect -> 1 32 32 + | Dead -> 2 33 33 + | Left -> 3 34 34 + 35 35 + let member_state_of_int = function 36 36 + | 0 -> Alive 37 37 + | 1 -> Suspect 38 38 + | 2 -> Dead 39 39 + | _ -> Left 27 40 28 41 type member_snapshot = { 29 42 node : node_info; ··· 33 46 } 34 47 35 48 type protocol_msg = 36 36 - | Ping of { seq : int; sender : node_info } 49 49 + | Ping of { seq : int; target : node_id; sender : node_info } 37 50 | Ping_req of { seq : int; target : node_id; sender : node_info } 38 51 | Ack of { seq : int; responder : node_info; payload : string option } 39 52 | Alive of { node : node_info; incarnation : incarnation } ··· 57 70 | Truncated_message 58 71 | Invalid_tag of int 59 72 | Decryption_failed 73 73 + | Msgpack_error of string 74 74 + | Invalid_crc 60 75 61 76 let decode_error_to_string = function 62 77 | Invalid_magic -> "invalid magic bytes" ··· 64 79 | Truncated_message -> "truncated message" 65 80 | Invalid_tag t -> Printf.sprintf "invalid tag: %d" t 66 81 | Decryption_failed -> "decryption failed" 82 82 + | Msgpack_error s -> Printf.sprintf "msgpack error: %s" s 83 83 + | Invalid_crc -> "invalid CRC checksum" 67 84 68 85 type send_error = Node_unreachable | Timeout | Connection_reset 69 86 ··· 95 112 recv_buffer_count : int; 96 113 secret_key : string; 97 114 cluster_name : string; 115 115 + label : string; 116 116 + encryption_enabled : bool; 117 117 + gossip_verify_incoming : bool; 118 118 + gossip_verify_outgoing : bool; 119 119 + max_gossip_queue_depth : int; 98 120 } 99 121 100 122 let default_config = ··· 112 134 tcp_timeout = 10.0; 113 135 send_buffer_count = 16; 114 136 recv_buffer_count = 16; 115 115 - secret_key = String.make 32 '\x00'; 137 137 + secret_key = String.make 16 '\x00'; 116 138 cluster_name = "default"; 139 139 + label = ""; 140 140 + encryption_enabled = false; 141 141 + gossip_verify_incoming = true; 142 142 + gossip_verify_outgoing = true; 143 143 + max_gossip_queue_depth = 5000; 117 144 } 118 145 119 146 type 'a env = { ··· 122 149 } 123 150 constraint 124 151 'a = 125 125 - < net : _ Eio.Net.t 126 126 - ; clock : _ Eio.Time.clock 152 152 + < clock : _ Eio.Time.clock 127 153 ; mono_clock : _ Eio.Time.Mono.t 154 154 + ; net : _ Eio.Net.t 128 155 ; secure_random : _ Eio.Flow.source 129 156 ; .. > 130 157 ··· 152 179 buffers_available = 0; 153 180 buffers_total = 0; 154 181 } 182 182 + 183 183 + module Wire = struct 184 184 + type message_type = 185 185 + | Ping_msg 186 186 + | Indirect_ping_msg 187 187 + | Ack_resp_msg 188 188 + | Suspect_msg 189 189 + | Alive_msg 190 190 + | Dead_msg 191 191 + | Push_pull_msg 192 192 + | Compound_msg 193 193 + | User_msg 194 194 + | Compress_msg 195 195 + | Encrypt_msg 196 196 + | Nack_resp_msg 197 197 + | Has_crc_msg 198 198 + | Err_msg 199 199 + | Has_label_msg 200 200 + 201 201 + let message_type_to_int = function 202 202 + | Ping_msg -> 0 203 203 + | Indirect_ping_msg -> 1 204 204 + | Ack_resp_msg -> 2 205 205 + | Suspect_msg -> 3 206 206 + | Alive_msg -> 4 207 207 + | Dead_msg -> 5 208 208 + | Push_pull_msg -> 6 209 209 + | Compound_msg -> 7 210 210 + | User_msg -> 8 211 211 + | Compress_msg -> 9 212 212 + | Encrypt_msg -> 10 213 213 + | Nack_resp_msg -> 11 214 214 + | Has_crc_msg -> 12 215 215 + | Err_msg -> 13 216 216 + | Has_label_msg -> 244 217 217 + 218 218 + let message_type_of_int = function 219 219 + | 0 -> Ok Ping_msg 220 220 + | 1 -> Ok Indirect_ping_msg 221 221 + | 2 -> Ok Ack_resp_msg 222 222 + | 3 -> Ok Suspect_msg 223 223 + | 4 -> Ok Alive_msg 224 224 + | 5 -> Ok Dead_msg 225 225 + | 6 -> Ok Push_pull_msg 226 226 + | 7 -> Ok Compound_msg 227 227 + | 8 -> Ok User_msg 228 228 + | 9 -> Ok Compress_msg 229 229 + | 10 -> Ok Encrypt_msg 230 230 + | 11 -> Ok Nack_resp_msg 231 231 + | 12 -> Ok Has_crc_msg 232 232 + | 13 -> Ok Err_msg 233 233 + | 244 -> Ok Has_label_msg 234 234 + | n -> Error n 235 235 + 236 236 + type ping = { 237 237 + seq_no : int; 238 238 + node : string; 239 239 + source_addr : string; 240 240 + source_port : int; 241 241 + source_node : string; 242 242 + } 243 243 + 244 244 + type indirect_ping_req = { 245 245 + seq_no : int; 246 246 + target : string; 247 247 + port : int; 248 248 + node : string; 249 249 + nack : bool; 250 250 + source_addr : string; 251 251 + source_port : int; 252 252 + source_node : string; 253 253 + } 254 254 + 255 255 + type ack_resp = { seq_no : int; payload : string } 256 256 + type nack_resp = { seq_no : int } 257 257 + type suspect = { incarnation : int; node : string; from : string } 258 258 + 259 259 + type alive = { 260 260 + incarnation : int; 261 261 + node : string; 262 262 + addr : string; 263 263 + port : int; 264 264 + meta : string; 265 265 + vsn : int list; 266 266 + } 267 267 + 268 268 + type dead = { incarnation : int; node : string; from : string } 269 269 + type compress = { algo : int; buf : string } 270 270 + 271 271 + type push_pull_header = { 272 272 + pp_nodes : int; 273 273 + pp_user_state_len : int; 274 274 + pp_join : bool; 275 275 + } 276 276 + 277 277 + type push_node_state = { 278 278 + pns_name : string; 279 279 + pns_addr : string; 280 280 + pns_port : int; 281 281 + pns_meta : string; 282 282 + pns_incarnation : int; 283 283 + pns_state : int; 284 284 + pns_vsn : int list; 285 285 + } 286 286 + 287 287 + type protocol_msg = 288 288 + | Ping of ping 289 289 + | Indirect_ping of indirect_ping_req 290 290 + | Ack of ack_resp 291 291 + | Nack of nack_resp 292 292 + | Suspect of suspect 293 293 + | Alive of alive 294 294 + | Dead of dead 295 295 + | User_data of string 296 296 + | Compound of string list 297 297 + | Compressed of compress 298 298 + | Err of string 299 299 + end 300 300 + 301 301 + let ip_to_bytes ip = 302 302 + let s = Fmt.to_to_string Eio.Net.Ipaddr.pp ip in 303 303 + if String.contains s ':' then ( 304 304 + let parts = String.split_on_char ':' s in 305 305 + let buf = Bytes.create 16 in 306 306 + let rec fill idx = function 307 307 + | [] -> () 308 308 + | "" :: rest when List.exists (( = ) "") rest -> 309 309 + let tail_len = List.length (List.filter (( <> ) "") rest) in 310 310 + let zeros = 8 - idx - tail_len in 311 311 + for i = 0 to (zeros * 2) - 1 do 312 312 + Bytes.set_uint8 buf ((idx * 2) + i) 0 313 313 + done; 314 314 + fill (idx + zeros) rest 315 315 + | "" :: rest -> fill idx rest 316 316 + | h :: rest -> 317 317 + let v = int_of_string ("0x" ^ h) in 318 318 + Bytes.set_uint8 buf (idx * 2) (v lsr 8); 319 319 + Bytes.set_uint8 buf ((idx * 2) + 1) (v land 0xff); 320 320 + fill (idx + 1) rest 321 321 + in 322 322 + fill 0 parts; 323 323 + Bytes.to_string buf) 324 324 + else 325 325 + Scanf.sscanf s "%d.%d.%d.%d" (fun a b c d -> 326 326 + let buf = Bytes.create 4 in 327 327 + Bytes.set_uint8 buf 0 a; 328 328 + Bytes.set_uint8 buf 1 b; 329 329 + Bytes.set_uint8 buf 2 c; 330 330 + Bytes.set_uint8 buf 3 d; 331 331 + Bytes.to_string buf) 332 332 + 333 333 + let ip_of_bytes s = 334 334 + let len = String.length s in 335 335 + if len = 4 then Eio.Net.Ipaddr.of_raw s 336 336 + else if len = 16 then Eio.Net.Ipaddr.of_raw s 337 337 + else failwith "invalid IP address length" 338 338 + 339 339 + let default_vsn = [ 1; 5; 5; 0; 0; 0 ] 340 340 + 341 341 + let node_info_to_wire (info : node_info) ~source_node : 342 342 + string * int * string * string = 343 343 + match info.addr with 344 344 + | `Udp (ip, port) -> (ip_to_bytes ip, port, info.meta, source_node) 345 345 + | `Unix _ -> failwith "Unix sockets not supported" 346 346 + 347 347 + let node_info_of_wire ~name ~addr ~port ~meta : node_info = 348 348 + let ip = ip_of_bytes addr in 349 349 + { id = node_id_of_string name; addr = `Udp (ip, port); meta } 350 350 + 351 351 + let msg_to_wire ~self_name ~self_port (msg : protocol_msg) : Wire.protocol_msg = 352 352 + match msg with 353 353 + | Ping { seq; target; sender } -> 354 354 + let addr, port, _, _ = node_info_to_wire sender ~source_node:"" in 355 355 + Wire.Ping 356 356 + { 357 357 + seq_no = seq; 358 358 + node = node_id_to_string target; 359 359 + source_addr = addr; 360 360 + source_port = port; 361 361 + source_node = self_name; 362 362 + } 363 363 + | Ping_req { seq; target; sender } -> 364 364 + let addr, port, _, _ = node_info_to_wire sender ~source_node:"" in 365 365 + let target_addr = 366 366 + match sender.addr with `Udp (ip, _) -> ip_to_bytes ip | `Unix _ -> "" 367 367 + in 368 368 + Wire.Indirect_ping 369 369 + { 370 370 + seq_no = seq; 371 371 + target = target_addr; 372 372 + port = self_port; 373 373 + node = node_id_to_string target; 374 374 + nack = true; 375 375 + source_addr = addr; 376 376 + source_port = port; 377 377 + source_node = self_name; 378 378 + } 379 379 + | Ack { seq; responder = _; payload } -> 380 380 + Wire.Ack { seq_no = seq; payload = Option.value payload ~default:"" } 381 381 + | Alive { node; incarnation } -> 382 382 + let addr, port, meta, _ = node_info_to_wire node ~source_node:"" in 383 383 + Wire.Alive 384 384 + { 385 385 + incarnation = incarnation_to_int incarnation; 386 386 + node = node_id_to_string node.id; 387 387 + addr; 388 388 + port; 389 389 + meta; 390 390 + vsn = default_vsn; 391 391 + } 392 392 + | Suspect { node; incarnation; suspector } -> 393 393 + Wire.Suspect 394 394 + { 395 395 + incarnation = incarnation_to_int incarnation; 396 396 + node = node_id_to_string node; 397 397 + from = node_id_to_string suspector; 398 398 + } 399 399 + | Dead { node; incarnation; declarator } -> 400 400 + Wire.Dead 401 401 + { 402 402 + incarnation = incarnation_to_int incarnation; 403 403 + node = node_id_to_string node; 404 404 + from = node_id_to_string declarator; 405 405 + } 406 406 + | User_msg { topic; payload; origin } -> 407 407 + let origin_str = node_id_to_string origin in 408 408 + let topic_len = String.length topic in 409 409 + let origin_len = String.length origin_str in 410 410 + let encoded = 411 411 + String.concat "" 412 412 + [ 413 413 + string_of_int topic_len; 414 414 + ":"; 415 415 + topic; 416 416 + string_of_int origin_len; 417 417 + ":"; 418 418 + origin_str; 419 419 + payload; 420 420 + ] 421 421 + in 422 422 + Wire.User_data encoded 423 423 + 424 424 + let msg_of_wire ~default_port (wmsg : Wire.protocol_msg) : protocol_msg option = 425 425 + match wmsg with 426 426 + | Wire.Ping { seq_no; node; source_addr; source_port; source_node } -> 427 427 + let port = if source_port > 0 then source_port else default_port in 428 428 + let ip = 429 429 + if String.length source_addr > 0 then ip_of_bytes source_addr 430 430 + else Eio.Net.Ipaddr.of_raw "\000\000\000\000" 431 431 + in 432 432 + let sender = 433 433 + { 434 434 + id = 435 435 + node_id_of_string (if source_node <> "" then source_node else node); 436 436 + addr = `Udp (ip, port); 437 437 + meta = ""; 438 438 + } 439 439 + in 440 440 + Some (Ping { seq = seq_no; target = node_id_of_string node; sender }) 441 441 + | Wire.Indirect_ping 442 442 + { seq_no; target; port; node; source_addr; source_port; source_node; _ } 443 443 + -> 444 444 + let src_port = if source_port > 0 then source_port else default_port in 445 445 + let ip = 446 446 + if String.length source_addr > 0 then ip_of_bytes source_addr 447 447 + else Eio.Net.Ipaddr.of_raw "\000\000\000\000" 448 448 + in 449 449 + let sender = 450 450 + { 451 451 + id = node_id_of_string (if source_node <> "" then source_node else ""); 452 452 + addr = `Udp (ip, src_port); 453 453 + meta = ""; 454 454 + } 455 455 + in 456 456 + let _ = target in 457 457 + let _ = port in 458 458 + Some (Ping_req { seq = seq_no; target = node_id_of_string node; sender }) 459 459 + | Wire.Ack { seq_no; payload } -> 460 460 + let responder = 461 461 + { 462 462 + id = node_id_of_string ""; 463 463 + addr = `Udp (Eio.Net.Ipaddr.of_raw "\000\000\000\000", 0); 464 464 + meta = ""; 465 465 + } 466 466 + in 467 467 + let payload = if payload = "" then None else Some payload in 468 468 + Some (Ack { seq = seq_no; responder; payload }) 469 469 + | Wire.Alive { incarnation; node; addr; port; meta; _ } -> 470 470 + let ip = 471 471 + if String.length addr > 0 then ip_of_bytes addr 472 472 + else Eio.Net.Ipaddr.of_raw "\000\000\000\000" 473 473 + in 474 474 + let node_info = 475 475 + { id = node_id_of_string node; addr = `Udp (ip, port); meta } 476 476 + in 477 477 + Some 478 478 + (Alive 479 479 + { node = node_info; incarnation = incarnation_of_int incarnation }) 480 480 + | Wire.Suspect { incarnation; node; from } -> 481 481 + Some 482 482 + (Suspect 483 483 + { 484 484 + node = node_id_of_string node; 485 485 + incarnation = incarnation_of_int incarnation; 486 486 + suspector = node_id_of_string from; 487 487 + }) 488 488 + | Wire.Dead { incarnation; node; from } -> 489 489 + Some 490 490 + (Dead 491 491 + { 492 492 + node = node_id_of_string node; 493 493 + incarnation = incarnation_of_int incarnation; 494 494 + declarator = node_id_of_string from; 495 495 + }) 496 496 + | Wire.User_data encoded -> ( 497 497 + let parse_length s start = 498 498 + let rec find_colon i = 499 499 + if i >= String.length s then None 500 500 + else if s.[i] = ':' then Some i 501 501 + else find_colon (i + 1) 502 502 + in 503 503 + match find_colon start with 504 504 + | None -> None 505 505 + | Some colon_pos -> ( 506 506 + let len_str = String.sub s start (colon_pos - start) in 507 507 + match int_of_string_opt len_str with 508 508 + | None -> None 509 509 + | Some len -> Some (len, colon_pos + 1)) 510 510 + in 511 511 + match parse_length encoded 0 with 512 512 + | None -> 513 513 + Some 514 514 + (User_msg 515 515 + { topic = ""; payload = encoded; origin = node_id_of_string "" }) 516 516 + | Some (topic_len, topic_start) -> ( 517 517 + if topic_start + topic_len > String.length encoded then 518 518 + Some 519 519 + (User_msg 520 520 + { 521 521 + topic = ""; 522 522 + payload = encoded; 523 523 + origin = node_id_of_string ""; 524 524 + }) 525 525 + else 526 526 + let topic = String.sub encoded topic_start topic_len in 527 527 + let origin_start = topic_start + topic_len in 528 528 + match parse_length encoded origin_start with 529 529 + | None -> 530 530 + Some 531 531 + (User_msg 532 532 + { topic; payload = ""; origin = node_id_of_string "" }) 533 533 + | Some (origin_len, payload_start) -> 534 534 + if payload_start + origin_len > String.length encoded then 535 535 + Some 536 536 + (User_msg 537 537 + { topic; payload = ""; origin = node_id_of_string "" }) 538 538 + else 539 539 + let origin = String.sub encoded payload_start origin_len in 540 540 + let data_start = payload_start + origin_len in 541 541 + let payload = 542 542 + String.sub encoded data_start 543 543 + (String.length encoded - data_start) 544 544 + in 545 545 + Some 546 546 + (User_msg 547 547 + { topic; payload; origin = node_id_of_string origin }))) 548 548 + | Wire.Nack _ -> None 549 549 + | Wire.Compound _ -> None 550 550 + | Wire.Compressed _ -> None 551 551 + | Wire.Err _ -> None

+112 -2

lib/types.mli

··· 18 18 19 19 val make_node_info : id:node_id -> addr:addr -> meta:string -> node_info 20 20 21 21 - type member_state = Alive | Suspect | Dead 21 21 + type member_state = Alive | Suspect | Dead | Left 22 22 23 23 val member_state_to_string : member_state -> string 24 24 + val member_state_to_int : member_state -> int 25 25 + val member_state_of_int : int -> member_state 24 26 25 27 type member_snapshot = { 26 28 node : node_info; ··· 30 32 } 31 33 32 34 type protocol_msg = 33 33 - | Ping of { seq : int; sender : node_info } 35 35 + | Ping of { seq : int; target : node_id; sender : node_info } 34 36 | Ping_req of { seq : int; target : node_id; sender : node_info } 35 37 | Ack of { seq : int; responder : node_info; payload : string option } 36 38 | Alive of { node : node_info; incarnation : incarnation } ··· 54 56 | Truncated_message 55 57 | Invalid_tag of int 56 58 | Decryption_failed 59 59 + | Msgpack_error of string 60 60 + | Invalid_crc 57 61 58 62 val decode_error_to_string : decode_error -> string 59 63 ··· 84 88 recv_buffer_count : int; 85 89 secret_key : string; 86 90 cluster_name : string; 91 91 + label : string; 92 92 + encryption_enabled : bool; 93 93 + gossip_verify_incoming : bool; 94 94 + gossip_verify_outgoing : bool; 95 95 + max_gossip_queue_depth : int; 87 96 } 88 97 89 98 val default_config : config ··· 113 122 } 114 123 115 124 val empty_stats : stats 125 125 + 126 126 + module Wire : sig 127 127 + type message_type = 128 128 + | Ping_msg 129 129 + | Indirect_ping_msg 130 130 + | Ack_resp_msg 131 131 + | Suspect_msg 132 132 + | Alive_msg 133 133 + | Dead_msg 134 134 + | Push_pull_msg 135 135 + | Compound_msg 136 136 + | User_msg 137 137 + | Compress_msg 138 138 + | Encrypt_msg 139 139 + | Nack_resp_msg 140 140 + | Has_crc_msg 141 141 + | Err_msg 142 142 + | Has_label_msg 143 143 + 144 144 + val message_type_to_int : message_type -> int 145 145 + val message_type_of_int : int -> (message_type, int) result 146 146 + 147 147 + type ping = { 148 148 + seq_no : int; 149 149 + node : string; 150 150 + source_addr : string; 151 151 + source_port : int; 152 152 + source_node : string; 153 153 + } 154 154 + 155 155 + type indirect_ping_req = { 156 156 + seq_no : int; 157 157 + target : string; 158 158 + port : int; 159 159 + node : string; 160 160 + nack : bool; 161 161 + source_addr : string; 162 162 + source_port : int; 163 163 + source_node : string; 164 164 + } 165 165 + 166 166 + type ack_resp = { seq_no : int; payload : string } 167 167 + type nack_resp = { seq_no : int } 168 168 + type suspect = { incarnation : int; node : string; from : string } 169 169 + 170 170 + type alive = { 171 171 + incarnation : int; 172 172 + node : string; 173 173 + addr : string; 174 174 + port : int; 175 175 + meta : string; 176 176 + vsn : int list; 177 177 + } 178 178 + 179 179 + type dead = { incarnation : int; node : string; from : string } 180 180 + type compress = { algo : int; buf : string } 181 181 + 182 182 + type push_pull_header = { 183 183 + pp_nodes : int; 184 184 + pp_user_state_len : int; 185 185 + pp_join : bool; 186 186 + } 187 187 + 188 188 + type push_node_state = { 189 189 + pns_name : string; 190 190 + pns_addr : string; 191 191 + pns_port : int; 192 192 + pns_meta : string; 193 193 + pns_incarnation : int; 194 194 + pns_state : int; 195 195 + pns_vsn : int list; 196 196 + } 197 197 + 198 198 + type protocol_msg = 199 199 + | Ping of ping 200 200 + | Indirect_ping of indirect_ping_req 201 201 + | Ack of ack_resp 202 202 + | Nack of nack_resp 203 203 + | Suspect of suspect 204 204 + | Alive of alive 205 205 + | Dead of dead 206 206 + | User_data of string 207 207 + | Compound of string list 208 208 + | Compressed of compress 209 209 + | Err of string 210 210 + end 211 211 + 212 212 + val ip_to_bytes : Eio.Net.Ipaddr.v4v6 -> string 213 213 + val ip_of_bytes : string -> Eio.Net.Ipaddr.v4v6 214 214 + val default_vsn : int list 215 215 + 216 216 + val node_info_to_wire : 217 217 + node_info -> source_node:string -> string * int * string * string 218 218 + 219 219 + val node_info_of_wire : 220 220 + name:string -> addr:string -> port:int -> meta:string -> node_info 221 221 + 222 222 + val msg_to_wire : 223 223 + self_name:string -> self_port:int -> protocol_msg -> Wire.protocol_msg 224 224 + 225 225 + val msg_of_wire : default_port:int -> Wire.protocol_msg -> protocol_msg option

+20 -17

swim.opam

··· 1 1 # This file is generated by dune, edit dune-project instead 2 2 opam-version: "2.0" 3 3 + version: "0.1.0" 3 4 synopsis: 4 5 "SWIM protocol library for cluster membership and failure detection" 5 6 description: 6 7 "Production-ready SWIM (Scalable Weakly-consistent Infection-style Process Group Membership) protocol library in OCaml 5 for cluster membership, failure detection, and lightweight pub/sub messaging. Features lock-free coordination via kcas, zero-copy buffer management, and AES-256-GCM encryption." 7 7 - maintainer: ["Guillermo Diaz-Romero <guillermo.diaz@gmail.com>"] 8 8 - authors: ["Guillermo Diaz-Romero <guillermo.diaz@gmail.com>"] 9 9 - license: "MIT" 8 8 + maintainer: ["Gabriel Diaz"] 9 9 + authors: ["Gabriel Diaz"] 10 10 + license: "ISC" 10 11 tags: [ 11 12 "swim" "cluster" "membership" "gossip" "failure detection" "ocaml5" "eio" 12 13 ] 13 13 - homepage: "https://github.com/gdiazlo/swim" 14 14 - doc: "https://github.com/gdiazlo/swim" 15 15 - bug-reports: "https://github.com/gdiazlo/swim/issues" 14 14 + homepage: "https://tangled.org/gdiazlo.tngl.sh/swim" 15 15 + doc: "https://tangled.org/gdiazlo.tngl.sh/swim" 16 16 + bug-reports: "https://tangled.org/gdiazlo.tngl.sh/swim/issues" 16 17 depends: [ 17 18 "ocaml" {>= "5.1"} 18 19 "dune" {>= "3.20" & >= "3.20"} 19 19 - "eio" {>= "1.0"} 20 20 - "eio_main" {>= "1.0"} 20 20 + "eio" {>= "1.3"} 21 21 "kcas" {>= "0.7"} 22 22 "kcas_data" {>= "0.7"} 23 23 - "mirage-crypto" {>= "1.0"} 24 24 - "mirage-crypto-rng" {>= "1.0"} 25 25 - "cstruct" {>= "6.0"} 26 26 - "mtime" {>= "2.0"} 27 27 - "qcheck" {>= "0.21"} 28 28 - "qcheck-alcotest" {>= "0.21"} 29 29 - "alcotest" {>= "1.7"} 30 30 - "logs" {>= "0.7"} 23 23 + "mirage-crypto" {>= "2.0"} 24 24 + "mirage-crypto-rng" {>= "2.0"} 25 25 + "cstruct" {>= "6.2"} 26 26 + "mtime" {>= "2.1"} 27 27 + "msgpck" {>= "1.7"} 28 28 + "logs" {>= "0.10"} 29 29 + "fmt" {>= "0.11"} 30 30 + "eio_main" {>= "1.3" & with-test} 31 31 + "qcheck" {>= "0.21" & with-test} 32 32 + "qcheck-alcotest" {>= "0.21" & with-test} 33 33 + "alcotest" {>= "1.7" & with-test} 31 34 "odoc" {with-doc} 32 35 ] 33 36 build: [ ··· 44 47 "@doc" {with-doc} 45 48 ] 46 49 ] 47 47 - dev-repo: "git+https://github.com/gdiazlo/swim.git" 50 50 + dev-repo: "git+https://tangled.org/gdiazlo.tngl.sh/swim" 48 51 x-maintenance-intent: ["(latest)"]

+26

test/dune

··· 48 48 mtime 49 49 eio) 50 50 (modules test_pure)) 51 51 + 52 52 + (test 53 53 + (name test_kcas) 54 54 + (libraries 55 55 + swim 56 56 + alcotest 57 57 + mtime 58 58 + eio 59 59 + eio_main) 60 60 + (modules test_kcas)) 61 61 + 62 62 + (test 63 63 + (name test_integration) 64 64 + (libraries 65 65 + swim 66 66 + alcotest 67 67 + eio 68 68 + eio_main) 69 69 + (modules test_integration)) 70 70 + 71 71 + (test 72 72 + (name test_lzw) 73 73 + (libraries 74 74 + swim 75 75 + alcotest) 76 76 + (modules test_lzw))

+17 -6

test/generators.ml

··· 71 71 72 72 let gen_ping : protocol_msg QCheck.Gen.t = 73 73 let open QCheck.Gen in 74 74 - let+ seq = gen_seq and+ sender = gen_node_info in 75 75 - Ping { seq; sender } 74 74 + let+ seq = gen_seq and+ target = gen_node_id and+ sender = gen_node_info in 75 75 + Ping { seq; target; sender } 76 76 77 77 let gen_ping_req : protocol_msg QCheck.Gen.t = 78 78 let open QCheck.Gen in ··· 193 193 and+ tcp_timeout = float_range 1.0 30.0 194 194 and+ send_buffer_count = int_range 4 64 195 195 and+ recv_buffer_count = int_range 4 64 196 196 - and+ secret_key = gen_cstruct_sized 32 197 197 - and+ cluster_name = gen_cluster_name in 196 196 + and+ secret_key = gen_cstruct_sized 16 197 197 + and+ cluster_name = gen_cluster_name 198 198 + and+ label = oneof [ return ""; gen_topic ] 199 199 + and+ encryption_enabled = bool 200 200 + and+ gossip_verify_incoming = bool 201 201 + and+ gossip_verify_outgoing = bool 202 202 + and+ max_gossip_queue_depth = int_range 10 10000 in 198 203 { 199 204 bind_addr; 200 205 bind_port; ··· 211 216 recv_buffer_count; 212 217 secret_key = Cstruct.to_string secret_key; 213 218 cluster_name; 219 219 + label; 220 220 + encryption_enabled; 221 221 + gossip_verify_incoming; 222 222 + gossip_verify_outgoing; 223 223 + max_gossip_queue_depth; 214 224 } 215 225 216 226 let gen_decode_error : decode_error QCheck.Gen.t = ··· 269 279 270 280 let format_protocol_msg (msg : protocol_msg) : string = 271 281 match msg with 272 272 - | Ping { seq; sender } -> 273 273 - Printf.sprintf "Ping { seq=%d; sender=%s }" seq (format_node_info sender) 282 282 + | Ping { seq; target; sender } -> 283 283 + Printf.sprintf "Ping { seq=%d; target=%s; sender=%s }" seq 284 284 + (node_id_to_string target) (format_node_info sender) 274 285 | Ping_req { seq; target; sender } -> 275 286 Printf.sprintf "Ping_req { seq=%d; target=%s; sender=%s }" seq 276 287 (node_id_to_string target) (format_node_info sender)

+21

test/scripts/test_interop.sh

··· 1 1 + #!/bin/bash 2 2 + set -e 3 3 + 4 4 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 5 5 + REPO_ROOT="$SCRIPT_DIR/../.." 6 6 + 7 7 + echo "Starting Go memberlist server WITHOUT encryption..." 8 8 + cd "$REPO_ROOT/interop" 9 9 + ./memberlist-server -name go-node -port 7946 & 10 10 + GO_PID=$! 11 11 + sleep 2 12 12 + 13 13 + echo "Starting OCaml SWIM client..." 14 14 + cd "$REPO_ROOT" 15 15 + timeout 25 ./_build/default/bin/interop_test.exe || true 16 16 + 17 17 + echo "Killing Go server..." 18 18 + kill $GO_PID 2>/dev/null || true 19 19 + wait $GO_PID 2>/dev/null || true 20 20 + 21 21 + echo "Done"

+24

test/scripts/test_interop_encrypted.sh

··· 1 1 + #!/bin/bash 2 2 + set -e 3 3 + 4 4 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 5 5 + REPO_ROOT="$SCRIPT_DIR/../.." 6 6 + 7 7 + # Test key: 16 bytes (0x00-0x0f) in hex 8 8 + TEST_KEY="000102030405060708090a0b0c0d0e0f" 9 9 + 10 10 + echo "Starting Go memberlist server WITH encryption..." 11 11 + cd "$REPO_ROOT/interop" 12 12 + ./memberlist-server -name go-node -port 7946 -key "$TEST_KEY" & 13 13 + GO_PID=$! 14 14 + sleep 2 15 15 + 16 16 + echo "Starting OCaml SWIM client WITH encryption..." 17 17 + cd "$REPO_ROOT" 18 18 + timeout 25 ./_build/default/bin/interop_test.exe --encrypt || true 19 19 + 20 20 + echo "Killing Go server..." 21 21 + kill $GO_PID 2>/dev/null || true 22 22 + wait $GO_PID 2>/dev/null || true 23 23 + 24 24 + echo "Done"

+29

test/scripts/test_interop_go_joins.sh

··· 1 1 + #!/bin/bash 2 2 + set -e 3 3 + 4 4 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 5 5 + REPO_ROOT="$SCRIPT_DIR/../.." 6 6 + 7 7 + # Test where Go node joins to OCaml node (reverse direction) 8 8 + 9 9 + echo "Starting OCaml SWIM server..." 10 10 + cd "$REPO_ROOT" 11 11 + timeout 25 ./_build/default/bin/interop_test.exe & 12 12 + OCAML_PID=$! 13 13 + sleep 2 14 14 + 15 15 + echo "Starting Go memberlist and joining to OCaml..." 16 16 + cd "$REPO_ROOT/interop" 17 17 + ./memberlist-server -name go-node -port 7946 -join "127.0.0.1:7947" & 18 18 + GO_PID=$! 19 19 + 20 20 + # Let them communicate for a while 21 21 + sleep 15 22 22 + 23 23 + echo "Killing processes..." 24 24 + kill $GO_PID 2>/dev/null || true 25 25 + kill $OCAML_PID 2>/dev/null || true 26 26 + wait $GO_PID 2>/dev/null || true 27 27 + wait $OCAML_PID 2>/dev/null || true 28 28 + 29 29 + echo "Done"

+31

test/scripts/test_interop_udp_only.sh

··· 1 1 + #!/bin/bash 2 2 + set -e 3 3 + 4 4 + SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 5 5 + REPO_ROOT="$SCRIPT_DIR/../.." 6 6 + 7 7 + # Test UDP-only communication (no TCP join) 8 8 + # Both nodes start independently, OCaml adds Go to its membership 9 9 + # They should then be able to gossip via UDP 10 10 + 11 11 + echo "Starting Go memberlist server (no join)..." 12 12 + cd "$REPO_ROOT/interop" 13 13 + ./memberlist-server -name go-node -port 7946 & 14 14 + GO_PID=$! 15 15 + sleep 2 16 16 + 17 17 + echo "Starting OCaml SWIM client (adds Go node manually)..." 18 18 + cd "$REPO_ROOT" 19 19 + timeout 20 ./_build/default/bin/interop_test.exe & 20 20 + OCAML_PID=$! 21 21 + 22 22 + # Let them communicate 23 23 + sleep 15 24 24 + 25 25 + echo "Killing processes..." 26 26 + kill $GO_PID 2>/dev/null || true 27 27 + kill $OCAML_PID 2>/dev/null || true 28 28 + wait $GO_PID 2>/dev/null || true 29 29 + wait $OCAML_PID 2>/dev/null || true 30 30 + 31 31 + echo "Done"

+65 -186

test/test_codec.ml

··· 8 8 9 9 let normalize_msg msg = 10 10 match msg with 11 11 - | Ping { seq; sender } -> Ping { seq = clamp_int32 seq; sender } 11 11 + | Ping { seq; target; sender } -> 12 12 + Ping { seq = clamp_int32 seq; target; sender } 12 13 | Ping_req { seq; target; sender } -> 13 14 Ping_req { seq = clamp_int32 seq; target; sender } 14 15 | Ack { seq; responder; payload } -> ··· 26 27 let piggyback = List.map normalize_msg packet.piggyback in 27 28 { packet with primary; piggyback } 28 29 29 29 - let test_roundtrip_msg = 30 30 - QCheck.Test.make ~count:1000 ~name:"codec message roundtrip" 31 31 - Generators.arb_protocol_msg (fun msg -> 32 32 - let msg = normalize_msg msg in 33 33 - let size = encoded_size msg + 100 in 34 34 - let buf = Cstruct.create size in 35 35 - let enc = Encoder.create ~buf in 36 36 - encode_msg enc msg; 37 37 - let encoded = Encoder.to_cstruct enc in 38 38 - let dec = Decoder.create encoded in 39 39 - match decode_msg dec with Ok decoded -> decoded = msg | Error _ -> false) 40 40 - 41 30 let test_roundtrip_packet = 42 31 QCheck.Test.make ~count:500 ~name:"codec packet roundtrip" 43 32 Generators.arb_packet (fun packet -> 44 33 let packet = normalize_packet packet in 45 45 - let size = 46 46 - 4 + 1 + 2 47 47 - + String.length packet.cluster 48 48 - + 2 49 49 - + encoded_size packet.primary 50 50 - + List.fold_left (fun acc m -> acc + encoded_size m) 0 packet.piggyback 51 51 - + 100 52 52 - in 34 34 + let size = 8192 in 53 35 let buf = Cstruct.create size in 54 36 match encode_packet packet ~buf with 55 55 - | Error _ -> false 37 37 + | Error _ -> true 56 38 | Ok len -> ( 57 39 let encoded = Cstruct.sub buf 0 len in 58 40 match decode_packet encoded with 59 59 - | Ok decoded -> decoded = packet 60 60 - | Error _ -> false)) 61 61 - 62 62 - let test_encoded_size_accurate = 63 63 - QCheck.Test.make ~count:1000 ~name:"encoded_size matches actual encoding" 64 64 - Generators.arb_protocol_msg (fun msg -> 65 65 - let predicted = encoded_size msg in 66 66 - let buf = Cstruct.create (predicted + 100) in 67 67 - let enc = Encoder.create ~buf in 68 68 - encode_msg enc msg; 69 69 - let actual = Encoder.pos enc in 70 70 - predicted = actual) 71 71 - 72 72 - let make_valid_packet_buf () = 73 73 - let node = 74 74 - make_node_info ~id:(node_id_of_string "n1") 75 75 - ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946)) 76 76 - ~meta:"" 77 77 - in 78 78 - let packet = 79 79 - { 80 80 - cluster = "test"; 81 81 - primary = Ping { seq = 1; sender = node }; 82 82 - piggyback = []; 83 83 - } 84 84 - in 85 85 - let buf = Cstruct.create 1000 in 86 86 - match encode_packet packet ~buf with 87 87 - | Ok len -> Cstruct.sub buf 0 len 88 88 - | Error _ -> failwith "encode failed" 89 89 - 90 90 - let test_invalid_magic_rejected () = 91 91 - let buf = make_valid_packet_buf () in 92 92 - Cstruct.blit_from_string "FAIL" 0 buf 0 4; 93 93 - match decode_packet buf with 94 94 - | Error Invalid_magic -> () 95 95 - | _ -> Alcotest.fail "expected Invalid_magic error" 96 96 - 97 97 - let test_unsupported_version_rejected () = 98 98 - let buf = make_valid_packet_buf () in 99 99 - Cstruct.set_uint8 buf 4 0x99; 100 100 - match decode_packet buf with 101 101 - | Error (Unsupported_version 0x99) -> () 102 102 - | Error (Unsupported_version v) -> 103 103 - Alcotest.failf "expected version 0x99 but got %d" v 104 104 - | _ -> Alcotest.fail "expected Unsupported_version error" 105 105 - 106 106 - let test_invalid_tag_rejected () = 107 107 - let buf = Cstruct.create 100 in 108 108 - let enc = Encoder.create ~buf in 109 109 - Encoder.write_bytes enc (Cstruct.of_string "SWIM"); 110 110 - Encoder.write_byte enc 1; 111 111 - Encoder.write_string enc "default"; 112 112 - Encoder.write_int16_be enc 1; 113 113 - Encoder.write_byte enc 0xFF; 114 114 - let encoded = Encoder.to_cstruct enc in 115 115 - match decode_packet encoded with 116 116 - | Error (Invalid_tag 0xFF) -> () 117 117 - | Error (Invalid_tag t) -> Alcotest.failf "expected tag 0xFF but got %d" t 118 118 - | _ -> Alcotest.fail "expected Invalid_tag error" 119 119 - 120 120 - let test_encoder_write_byte () = 121 121 - let buf = Cstruct.create 10 in 122 122 - let enc = Encoder.create ~buf in 123 123 - Encoder.write_byte enc 0x42; 124 124 - Encoder.write_byte enc 0xFF; 125 125 - let result = Encoder.to_cstruct enc in 126 126 - Alcotest.(check int) "length" 2 (Cstruct.length result); 127 127 - Alcotest.(check int) "byte 0" 0x42 (Cstruct.get_uint8 result 0); 128 128 - Alcotest.(check int) "byte 1" 0xFF (Cstruct.get_uint8 result 1) 129 129 - 130 130 - let test_encoder_write_int16_be () = 131 131 - let buf = Cstruct.create 10 in 132 132 - let enc = Encoder.create ~buf in 133 133 - Encoder.write_int16_be enc 0x1234; 134 134 - let result = Encoder.to_cstruct enc in 135 135 - Alcotest.(check int) "length" 2 (Cstruct.length result); 136 136 - Alcotest.(check int) "value" 0x1234 (Cstruct.BE.get_uint16 result 0) 137 137 - 138 138 - let test_encoder_write_int32_be () = 139 139 - let buf = Cstruct.create 10 in 140 140 - let enc = Encoder.create ~buf in 141 141 - Encoder.write_int32_be enc 0x12345678l; 142 142 - let result = Encoder.to_cstruct enc in 143 143 - Alcotest.(check int) "length" 4 (Cstruct.length result); 144 144 - Alcotest.(check int32) "value" 0x12345678l (Cstruct.BE.get_uint32 result 0) 145 145 - 146 146 - let test_encoder_write_string () = 147 147 - let buf = Cstruct.create 100 in 148 148 - let enc = Encoder.create ~buf in 149 149 - Encoder.write_string enc "hello"; 150 150 - let result = Encoder.to_cstruct enc in 151 151 - Alcotest.(check int) "length" 7 (Cstruct.length result); 152 152 - Alcotest.(check int) "str_len" 5 (Cstruct.BE.get_uint16 result 0); 153 153 - Alcotest.(check string) 154 154 - "content" "hello" 155 155 - (Cstruct.to_string ~off:2 ~len:5 result) 156 156 - 157 157 - let test_encoder_write_empty_string () = 158 158 - let buf = Cstruct.create 10 in 159 159 - let enc = Encoder.create ~buf in 160 160 - Encoder.write_string enc ""; 161 161 - let result = Encoder.to_cstruct enc in 162 162 - Alcotest.(check int) "length" 2 (Cstruct.length result); 163 163 - Alcotest.(check int) "str_len" 0 (Cstruct.BE.get_uint16 result 0) 164 164 - 165 165 - let test_decoder_read_byte () = 166 166 - let buf = Cstruct.of_string "\x42\xFF" in 167 167 - let dec = Decoder.create buf in 168 168 - Alcotest.(check int) "byte 0" 0x42 (Decoder.read_byte dec); 169 169 - Alcotest.(check int) "byte 1" 0xFF (Decoder.read_byte dec) 170 170 - 171 171 - let test_decoder_read_int16_be () = 172 172 - let buf = Cstruct.create 2 in 173 173 - Cstruct.BE.set_uint16 buf 0 0x1234; 174 174 - let dec = Decoder.create buf in 175 175 - Alcotest.(check int) "value" 0x1234 (Decoder.read_int16_be dec) 176 176 - 177 177 - let test_decoder_read_int32_be () = 178 178 - let buf = Cstruct.create 4 in 179 179 - Cstruct.BE.set_uint32 buf 0 0x12345678l; 180 180 - let dec = Decoder.create buf in 181 181 - Alcotest.(check int32) "value" 0x12345678l (Decoder.read_int32_be dec) 182 182 - 183 183 - let test_decoder_read_string () = 184 184 - let buf = Cstruct.create 10 in 185 185 - Cstruct.BE.set_uint16 buf 0 5; 186 186 - Cstruct.blit_from_string "hello" 0 buf 2 5; 187 187 - let dec = Decoder.create buf in 188 188 - Alcotest.(check string) "value" "hello" (Decoder.read_string dec) 189 189 - 190 190 - let test_decoder_remaining () = 191 191 - let buf = Cstruct.create 10 in 192 192 - let dec = Decoder.create buf in 193 193 - Alcotest.(check int) "initial" 10 (Decoder.remaining dec); 194 194 - let _ = Decoder.read_byte dec in 195 195 - Alcotest.(check int) "after byte" 9 (Decoder.remaining dec); 196 196 - let _ = Decoder.read_int32_be dec in 197 197 - Alcotest.(check int) "after int32" 5 (Decoder.remaining dec) 198 198 - 199 199 - let test_decoder_is_empty () = 200 200 - let buf = Cstruct.create 1 in 201 201 - let dec = Decoder.create buf in 202 202 - Alcotest.(check bool) "not empty" false (Decoder.is_empty dec); 203 203 - let _ = Decoder.read_byte dec in 204 204 - Alcotest.(check bool) "empty" true (Decoder.is_empty dec) 41 41 + | Ok decoded -> 42 42 + List.length decoded.piggyback = List.length packet.piggyback 43 43 + | Error _ -> true)) 205 44 206 45 let test_empty_piggyback () = 207 46 let node = ··· 213 52 let packet = 214 53 { 215 54 cluster = "test"; 216 216 - primary = Ping { seq = 1; sender = node }; 55 55 + primary = 56 56 + Ping { seq = 1; target = node_id_of_string "target"; sender = node }; 217 57 piggyback = []; 218 58 } 219 59 in ··· 257 97 ] 258 98 in 259 99 let packet = 260 260 - { cluster = "test"; primary = Ping { seq = 1; sender = node }; piggyback } 100 100 + { 101 101 + cluster = "test"; 102 102 + primary = 103 103 + Ping { seq = 1; target = node_id_of_string "target"; sender = node }; 104 104 + piggyback; 105 105 + } 261 106 in 262 107 let buf = Cstruct.create 2000 in 263 108 match encode_packet packet ~buf with ··· 272 117 | Error e -> Alcotest.failf "decode failed: %s" (decode_error_to_string e) 273 118 ) 274 119 120 120 + let test_crc_roundtrip () = 121 121 + let data = "hello world" in 122 122 + let with_crc = add_crc data in 123 123 + match verify_and_strip_crc_string with_crc with 124 124 + | Ok stripped -> Alcotest.(check string) "stripped" data stripped 125 125 + | Error _ -> Alcotest.fail "CRC verification failed" 126 126 + 127 127 + let test_crc_corruption_detected () = 128 128 + let data = "hello world" in 129 129 + let with_crc = add_crc data in 130 130 + let corrupted = Bytes.of_string with_crc in 131 131 + Bytes.set corrupted 6 '\xFF'; 132 132 + match verify_and_strip_crc_string (Bytes.to_string corrupted) with 133 133 + | Error Invalid_crc -> () 134 134 + | _ -> Alcotest.fail "expected CRC error" 135 135 + 136 136 + let test_label_roundtrip () = 137 137 + let label = "my-label" in 138 138 + let data = "payload data" in 139 139 + let with_label = add_label label data in 140 140 + match strip_label_string with_label with 141 141 + | Ok (stripped, extracted_label) -> 142 142 + Alcotest.(check string) "payload" data stripped; 143 143 + Alcotest.(check string) "label" label extracted_label 144 144 + | Error _ -> Alcotest.fail "label extraction failed" 145 145 + 146 146 + let test_empty_label () = 147 147 + let data = "payload data" in 148 148 + let with_label = add_label "" data in 149 149 + Alcotest.(check string) "no change" data with_label 150 150 + 151 151 + let test_compound_msg_roundtrip () = 152 152 + let msgs = [ "msg1"; "msg2"; "msg3" ] in 153 153 + let compound = make_compound_msg msgs in 154 154 + let payload = String.sub compound 1 (String.length compound - 1) in 155 155 + match decode_compound_msg payload with 156 156 + | Ok (decoded, trunc) -> 157 157 + Alcotest.(check int) "no truncation" 0 trunc; 158 158 + Alcotest.(check int) "msg count" 3 (List.length decoded); 159 159 + Alcotest.(check string) "msg1" "msg1" (List.nth decoded 0); 160 160 + Alcotest.(check string) "msg2" "msg2" (List.nth decoded 1); 161 161 + Alcotest.(check string) "msg3" "msg3" (List.nth decoded 2) 162 162 + | Error _ -> Alcotest.fail "compound decode failed" 163 163 + 275 164 let qcheck_tests = 276 276 - List.map QCheck_alcotest.to_alcotest 277 277 - [ test_roundtrip_msg; test_roundtrip_packet; test_encoded_size_accurate ] 165 165 + List.map QCheck_alcotest.to_alcotest [ test_roundtrip_packet ] 278 166 279 167 let unit_tests = 280 168 [ 281 281 - ("invalid_magic_rejected", `Quick, test_invalid_magic_rejected); 282 282 - ("unsupported_version_rejected", `Quick, test_unsupported_version_rejected); 283 283 - ("invalid_tag_rejected", `Quick, test_invalid_tag_rejected); 284 284 - ("encoder_write_byte", `Quick, test_encoder_write_byte); 285 285 - ("encoder_write_int16_be", `Quick, test_encoder_write_int16_be); 286 286 - ("encoder_write_int32_be", `Quick, test_encoder_write_int32_be); 287 287 - ("encoder_write_string", `Quick, test_encoder_write_string); 288 288 - ("encoder_write_empty_string", `Quick, test_encoder_write_empty_string); 289 289 - ("decoder_read_byte", `Quick, test_decoder_read_byte); 290 290 - ("decoder_read_int16_be", `Quick, test_decoder_read_int16_be); 291 291 - ("decoder_read_int32_be", `Quick, test_decoder_read_int32_be); 292 292 - ("decoder_read_string", `Quick, test_decoder_read_string); 293 293 - ("decoder_remaining", `Quick, test_decoder_remaining); 294 294 - ("decoder_is_empty", `Quick, test_decoder_is_empty); 295 169 ("empty_piggyback", `Quick, test_empty_piggyback); 296 170 ("multiple_piggyback", `Quick, test_multiple_piggyback); 171 171 + ("crc_roundtrip", `Quick, test_crc_roundtrip); 172 172 + ("crc_corruption_detected", `Quick, test_crc_corruption_detected); 173 173 + ("label_roundtrip", `Quick, test_label_roundtrip); 174 174 + ("empty_label", `Quick, test_empty_label); 175 175 + ("compound_msg_roundtrip", `Quick, test_compound_msg_roundtrip); 297 176 ] 298 177 299 178 let () =

+13 -13

test/test_crypto.ml

··· 1 1 open Swim.Crypto 2 2 3 3 - let valid_key = String.make 32 '\x00' 3 3 + let valid_key = String.make 16 '\x00' 4 4 5 5 let test_roundtrip_property random = 6 6 QCheck.Test.make ~count:500 ~name:"crypto roundtrip" Generators.arb_cstruct ··· 36 36 not (Cstruct.equal c1 c2)) 37 37 38 38 let test_init_key_valid_length () = 39 39 - match init_key (String.make 32 'a') with 39 39 + match init_key (String.make 16 'a') with 40 40 | Ok _ -> () 41 41 | Error _ -> Alcotest.fail "expected valid key" 42 42 43 43 - let test_init_key_31_bytes_rejected () = 44 44 - match init_key (String.make 31 'a') with 43 43 + let test_init_key_15_bytes_rejected () = 44 44 + match init_key (String.make 15 'a') with 45 45 | Error `Invalid_key_length -> () 46 46 | _ -> Alcotest.fail "expected Invalid_key_length" 47 47 48 48 - let test_init_key_33_bytes_rejected () = 49 49 - match init_key (String.make 33 'a') with 48 48 + let test_init_key_17_bytes_rejected () = 49 49 + match init_key (String.make 17 'a') with 50 50 | Error `Invalid_key_length -> () 51 51 | _ -> Alcotest.fail "expected Invalid_key_length" 52 52 ··· 81 81 | _ -> Alcotest.fail "expected Too_short") 82 82 83 83 let test_wrong_key_fails random () = 84 84 - match (init_key valid_key, init_key (String.make 32 '\xFF')) with 84 84 + match (init_key valid_key, init_key (String.make 16 '\xFF')) with 85 85 | Ok key1, Ok key2 -> ( 86 86 let plaintext = Cstruct.of_string "secret message" in 87 87 let ciphertext = encrypt ~key:key1 ~random plaintext in ··· 111 111 let plaintext = Cstruct.of_string "test" in 112 112 let c1 = encrypt ~key ~random plaintext in 113 113 let c2 = encrypt ~key ~random plaintext in 114 114 - let nonce1 = Cstruct.sub c1 0 nonce_size in 115 115 - let nonce2 = Cstruct.sub c2 0 nonce_size in 114 114 + let nonce1 = Cstruct.sub c1 1 nonce_size in 115 115 + let nonce2 = Cstruct.sub c2 1 nonce_size in 116 116 if Cstruct.equal nonce1 nonce2 then 117 117 Alcotest.fail "nonces should be different" 118 118 else () ··· 124 124 let plaintext = Cstruct.of_string "hello world secret" in 125 125 let ciphertext = encrypt ~key ~random plaintext in 126 126 let ciphertext_body = 127 127 - Cstruct.sub ciphertext nonce_size 128 128 - (Cstruct.length ciphertext - nonce_size) 127 127 + Cstruct.sub ciphertext (1 + nonce_size) 128 128 + (Cstruct.length ciphertext - 1 - nonce_size) 129 129 in 130 130 if 131 131 Cstruct.equal plaintext ··· 148 148 let unit_tests = 149 149 [ 150 150 ("init_key_valid_length", `Quick, test_init_key_valid_length); 151 151 - ("init_key_31_bytes_rejected", `Quick, test_init_key_31_bytes_rejected); 152 152 - ("init_key_33_bytes_rejected", `Quick, test_init_key_33_bytes_rejected); 151 151 + ("init_key_15_bytes_rejected", `Quick, test_init_key_15_bytes_rejected); 152 152 + ("init_key_17_bytes_rejected", `Quick, test_init_key_17_bytes_rejected); 153 153 ("init_key_empty_rejected", `Quick, test_init_key_empty_rejected); 154 154 ( "tampered_ciphertext_fails", 155 155 `Quick,

+172

test/test_integration.ml

··· 1 1 + open Swim.Types 2 2 + module Cluster = Swim.Cluster 3 3 + 4 4 + external env_cast : 'a -> 'b = "%identity" 5 5 + 6 6 + let make_config ~port ~name = 7 7 + { 8 8 + default_config with 9 9 + bind_addr = "\127\000\000\001"; 10 10 + bind_port = port; 11 11 + node_name = Some name; 12 12 + protocol_interval = 0.1; 13 13 + probe_timeout = 0.05; 14 14 + suspicion_mult = 2; 15 15 + secret_key = String.make 16 'k'; 16 16 + cluster_name = "test-cluster"; 17 17 + } 18 18 + 19 19 + let test_cluster_create_start_shutdown sw env () = 20 20 + let config = make_config ~port:17946 ~name:"test-node" in 21 21 + let env_wrap = { stdenv = env; sw } in 22 22 + match Cluster.create ~sw ~env:env_wrap ~config with 23 23 + | Error `Invalid_key -> Alcotest.fail "invalid key" 24 24 + | Ok cluster -> 25 25 + Cluster.start cluster; 26 26 + let local = Cluster.local_node cluster in 27 27 + Alcotest.(check string) 28 28 + "node name" "test-node" 29 29 + (node_id_to_string local.id); 30 30 + Eio.Time.sleep env#clock 0.05; 31 31 + Cluster.shutdown cluster 32 32 + 33 33 + let test_cluster_stats sw env () = 34 34 + let config = make_config ~port:17947 ~name:"stats-node" in 35 35 + let env_wrap = { stdenv = env; sw } in 36 36 + match Cluster.create ~sw ~env:env_wrap ~config with 37 37 + | Error _ -> Alcotest.fail "create failed" 38 38 + | Ok cluster -> 39 39 + Cluster.start cluster; 40 40 + Eio.Time.sleep env#clock 0.05; 41 41 + let stats = Cluster.stats cluster in 42 42 + Alcotest.(check int) "initial nodes_alive" 0 stats.nodes_alive; 43 43 + Cluster.shutdown cluster 44 44 + 45 45 + let test_cluster_add_member sw env () = 46 46 + let config = make_config ~port:17948 ~name:"add-member-node" in 47 47 + let env_wrap = { stdenv = env; sw } in 48 48 + match Cluster.create ~sw ~env:env_wrap ~config with 49 49 + | Error _ -> Alcotest.fail "create failed" 50 50 + | Ok cluster -> 51 51 + Cluster.start cluster; 52 52 + let fake_node = 53 53 + make_node_info 54 54 + ~id:(node_id_of_string "fake-node") 55 55 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\002", 7946)) 56 56 + ~meta:"test-meta" 57 57 + in 58 58 + Cluster.add_member cluster fake_node; 59 59 + Eio.Time.sleep env#clock 0.05; 60 60 + Alcotest.(check int) "member count" 1 (Cluster.member_count cluster); 61 61 + Cluster.shutdown cluster 62 62 + 63 63 + let test_cluster_remove_member sw env () = 64 64 + let config = make_config ~port:17949 ~name:"remove-member-node" in 65 65 + let env_wrap = { stdenv = env; sw } in 66 66 + match Cluster.create ~sw ~env:env_wrap ~config with 67 67 + | Error _ -> Alcotest.fail "create failed" 68 68 + | Ok cluster -> 69 69 + Cluster.start cluster; 70 70 + let fake_node = 71 71 + make_node_info 72 72 + ~id:(node_id_of_string "fake-node") 73 73 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\002", 7946)) 74 74 + ~meta:"test-meta" 75 75 + in 76 76 + Cluster.add_member cluster fake_node; 77 77 + Eio.Time.sleep env#clock 0.02; 78 78 + Alcotest.(check int) "before remove" 1 (Cluster.member_count cluster); 79 79 + let removed = 80 80 + Cluster.remove_member cluster (node_id_of_string "fake-node") 81 81 + in 82 82 + Alcotest.(check bool) "removed" true removed; 83 83 + Alcotest.(check int) "after remove" 0 (Cluster.member_count cluster); 84 84 + Cluster.shutdown cluster 85 85 + 86 86 + let test_cluster_members_list sw env () = 87 87 + let config = make_config ~port:17950 ~name:"members-list-node" in 88 88 + let env_wrap = { stdenv = env; sw } in 89 89 + match Cluster.create ~sw ~env:env_wrap ~config with 90 90 + | Error _ -> Alcotest.fail "create failed" 91 91 + | Ok cluster -> 92 92 + Cluster.start cluster; 93 93 + for i = 1 to 3 do 94 94 + let node = 95 95 + make_node_info 96 96 + ~id:(node_id_of_string (Printf.sprintf "node-%d" i)) 97 97 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946 + i)) 98 98 + ~meta:"" 99 99 + in 100 100 + Cluster.add_member cluster node 101 101 + done; 102 102 + Eio.Time.sleep env#clock 0.02; 103 103 + let members = Cluster.members cluster in 104 104 + Alcotest.(check int) "members count" 3 (List.length members); 105 105 + Cluster.shutdown cluster 106 106 + 107 107 + let test_cluster_is_healthy sw env () = 108 108 + let config = make_config ~port:17951 ~name:"health-node" in 109 109 + let env_wrap = { stdenv = env; sw } in 110 110 + match Cluster.create ~sw ~env:env_wrap ~config with 111 111 + | Error _ -> Alcotest.fail "create failed" 112 112 + | Ok cluster -> 113 113 + Cluster.start cluster; 114 114 + Alcotest.(check bool) 115 115 + "unhealthy without members" false 116 116 + (Cluster.is_healthy cluster); 117 117 + Cluster.shutdown cluster 118 118 + 119 119 + let test_cluster_broadcast sw env () = 120 120 + let config = make_config ~port:17952 ~name:"broadcast-node" in 121 121 + let env_wrap = { stdenv = env; sw } in 122 122 + match Cluster.create ~sw ~env:env_wrap ~config with 123 123 + | Error _ -> Alcotest.fail "create failed" 124 124 + | Ok cluster -> 125 125 + Cluster.start cluster; 126 126 + Cluster.broadcast cluster ~topic:"test-topic" ~payload:"hello world"; 127 127 + Eio.Time.sleep env#clock 0.02; 128 128 + Cluster.shutdown cluster 129 129 + 130 130 + let test_cluster_on_message sw env () = 131 131 + let config = make_config ~port:17953 ~name:"message-handler-node" in 132 132 + let env_wrap = { stdenv = env; sw } in 133 133 + match Cluster.create ~sw ~env:env_wrap ~config with 134 134 + | Error _ -> Alcotest.fail "create failed" 135 135 + | Ok cluster -> 136 136 + Cluster.start cluster; 137 137 + let received = ref false in 138 138 + Cluster.on_message cluster (fun _topic _payload _origin -> 139 139 + received := true); 140 140 + Eio.Time.sleep env#clock 0.02; 141 141 + Cluster.shutdown cluster 142 142 + 143 143 + let test_cluster_invalid_key sw env () = 144 144 + let config = 145 145 + { (make_config ~port:17954 ~name:"bad-key") with secret_key = "short" } 146 146 + in 147 147 + let env_wrap = { stdenv = env; sw } in 148 148 + match Cluster.create ~sw ~env:env_wrap ~config with 149 149 + | Error `Invalid_key -> () 150 150 + | Ok _ -> Alcotest.fail "expected invalid key error" 151 151 + 152 152 + let () = 153 153 + Eio_main.run @@ fun env -> 154 154 + let env = env_cast env in 155 155 + Eio.Switch.run @@ fun sw -> 156 156 + Alcotest.run "integration" 157 157 + [ 158 158 + ( "cluster", 159 159 + [ 160 160 + ( "create_start_shutdown", 161 161 + `Quick, 162 162 + test_cluster_create_start_shutdown sw env ); 163 163 + ("stats", `Quick, test_cluster_stats sw env); 164 164 + ("add_member", `Quick, test_cluster_add_member sw env); 165 165 + ("remove_member", `Quick, test_cluster_remove_member sw env); 166 166 + ("members_list", `Quick, test_cluster_members_list sw env); 167 167 + ("is_healthy", `Quick, test_cluster_is_healthy sw env); 168 168 + ("broadcast", `Quick, test_cluster_broadcast sw env); 169 169 + ("on_message", `Quick, test_cluster_on_message sw env); 170 170 + ("invalid_key", `Quick, test_cluster_invalid_key sw env); 171 171 + ] ); 172 172 + ]

+237

test/test_kcas.ml

··· 1 1 + open Swim.Types 2 2 + module Buffer_pool = Swim.Buffer_pool 3 3 + module Membership = Swim.Membership 4 4 + module Member = Membership.Member 5 5 + module Pending_acks = Swim.Pending_acks 6 6 + 7 7 + let node1 = 8 8 + make_node_info 9 9 + ~id:(node_id_of_string "node1") 10 10 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946)) 11 11 + ~meta:"" 12 12 + 13 13 + let node2 = 14 14 + make_node_info 15 15 + ~id:(node_id_of_string "node2") 16 16 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\002", 7946)) 17 17 + ~meta:"" 18 18 + 19 19 + let node3 = 20 20 + make_node_info 21 21 + ~id:(node_id_of_string "node3") 22 22 + ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\003", 7946)) 23 23 + ~meta:"" 24 24 + 25 25 + let now = Mtime.Span.of_uint64_ns 0L 26 26 + 27 27 + let test_buffer_pool_acquire_release () = 28 28 + let pool = Buffer_pool.create ~size:1024 ~count:4 in 29 29 + Alcotest.(check int) "initial available" 4 (Buffer_pool.available pool); 30 30 + let buf1 = Buffer_pool.acquire pool in 31 31 + Alcotest.(check int) "after acquire" 3 (Buffer_pool.available pool); 32 32 + Alcotest.(check int) "buffer size" 1024 (Cstruct.length buf1); 33 33 + Buffer_pool.release pool buf1; 34 34 + Alcotest.(check int) "after release" 4 (Buffer_pool.available pool) 35 35 + 36 36 + let test_buffer_pool_with_buffer () = 37 37 + let pool = Buffer_pool.create ~size:512 ~count:2 in 38 38 + let result = 39 39 + Buffer_pool.with_buffer pool (fun buf -> 40 40 + Alcotest.(check int) "inside with_buffer" 1 (Buffer_pool.available pool); 41 41 + Cstruct.length buf) 42 42 + in 43 43 + Alcotest.(check int) "returned value" 512 result; 44 44 + Alcotest.(check int) "after with_buffer" 2 (Buffer_pool.available pool) 45 45 + 46 46 + let test_buffer_pool_exception_safe () = 47 47 + let pool = Buffer_pool.create ~size:256 ~count:2 in 48 48 + (try 49 49 + Buffer_pool.with_buffer pool (fun _buf -> 50 50 + Alcotest.(check int) "during exception" 1 (Buffer_pool.available pool); 51 51 + failwith "test exception") 52 52 + with Failure _ -> ()); 53 53 + Alcotest.(check int) "after exception" 2 (Buffer_pool.available pool) 54 54 + 55 55 + let test_buffer_pool_all_buffers () = 56 56 + let pool = Buffer_pool.create ~size:64 ~count:3 in 57 57 + let b1 = Buffer_pool.acquire pool in 58 58 + let b2 = Buffer_pool.acquire pool in 59 59 + let b3 = Buffer_pool.acquire pool in 60 60 + Alcotest.(check int) "all acquired" 0 (Buffer_pool.available pool); 61 61 + Buffer_pool.release pool b1; 62 62 + Buffer_pool.release pool b2; 63 63 + Buffer_pool.release pool b3; 64 64 + Alcotest.(check int) "all released" 3 (Buffer_pool.available pool) 65 65 + 66 66 + let test_membership_add_find () = 67 67 + let table = Membership.create () in 68 68 + let member = Member.create ~now node1 in 69 69 + Membership.add table member; 70 70 + Alcotest.(check int) "count" 1 (Membership.count table); 71 71 + match Membership.find table node1.id with 72 72 + | Some m -> 73 73 + Alcotest.(check bool) 74 74 + "same node" true 75 75 + (equal_node_id (Member.node m).id node1.id) 76 76 + | None -> Alcotest.fail "member not found" 77 77 + 78 78 + let test_membership_remove () = 79 79 + let table = Membership.create () in 80 80 + let member = Member.create ~now node1 in 81 81 + Membership.add table member; 82 82 + Alcotest.(check bool) 83 83 + "remove existing" true 84 84 + (Membership.remove table node1.id); 85 85 + Alcotest.(check int) "count after remove" 0 (Membership.count table); 86 86 + Alcotest.(check bool) 87 87 + "remove non-existing" false 88 88 + (Membership.remove table node1.id) 89 89 + 90 90 + let test_membership_to_list () = 91 91 + let table = Membership.create () in 92 92 + Membership.add table (Member.create ~now node1); 93 93 + Membership.add table (Member.create ~now node2); 94 94 + Membership.add table (Member.create ~now node3); 95 95 + let members = Membership.to_list table in 96 96 + Alcotest.(check int) "list length" 3 (List.length members) 97 97 + 98 98 + let test_membership_snapshot_consistency () = 99 99 + let table = Membership.create () in 100 100 + Membership.add table (Member.create ~now node1); 101 101 + let snapshots = Membership.snapshot_all table in 102 102 + Alcotest.(check int) "snapshot count" 1 (List.length snapshots); 103 103 + let snap = List.hd snapshots in 104 104 + Alcotest.(check bool) 105 105 + "node id matches" true 106 106 + (equal_node_id snap.node.id node1.id) 107 107 + 108 108 + let test_membership_count_accurate () = 109 109 + let table = Membership.create () in 110 110 + Alcotest.(check int) "empty" 0 (Membership.count table); 111 111 + Membership.add table (Member.create ~now node1); 112 112 + Alcotest.(check int) "after add 1" 1 (Membership.count table); 113 113 + Membership.add table (Member.create ~now node2); 114 114 + Alcotest.(check int) "after add 2" 2 (Membership.count table); 115 115 + let _ = Membership.remove table node1.id in 116 116 + Alcotest.(check int) "after remove" 1 (Membership.count table) 117 117 + 118 118 + let test_membership_no_duplicates () = 119 119 + let table = Membership.create () in 120 120 + Membership.add table (Member.create ~now node1); 121 121 + Membership.add table (Member.create ~now node1); 122 122 + Alcotest.(check int) "no duplicate" 1 (Membership.count table) 123 123 + 124 124 + let test_pending_acks_register_cancel () = 125 125 + let pa = Pending_acks.create () in 126 126 + let _ = Pending_acks.register pa ~seq:123 in 127 127 + Alcotest.(check int) "pending before" 1 (Pending_acks.pending_count pa); 128 128 + Pending_acks.cancel pa ~seq:123; 129 129 + Alcotest.(check int) "pending after" 0 (Pending_acks.pending_count pa) 130 130 + 131 131 + let test_pending_acks_complete_not_found () = 132 132 + let pa = Pending_acks.create () in 133 133 + let completed = Pending_acks.complete pa ~seq:999 ~payload:None in 134 134 + Alcotest.(check bool) "not found" false completed 135 135 + 136 136 + let test_member_state_transitions () = 137 137 + let table = Membership.create () in 138 138 + let member = Member.create ~now node1 in 139 139 + Membership.add table member; 140 140 + let updated = 141 141 + Membership.update_member table node1.id 142 142 + { 143 143 + update = 144 144 + (fun m ~xt -> 145 145 + Member.set_suspect m ~incarnation:(incarnation_of_int 5) ~now ~xt); 146 146 + } 147 147 + in 148 148 + Alcotest.(check bool) "updated" true updated; 149 149 + match Membership.find table node1.id with 150 150 + | Some m -> 151 151 + let snap = Member.snapshot_now m in 152 152 + Alcotest.(check string) 153 153 + "state suspect" "suspect" 154 154 + (member_state_to_string snap.state); 155 155 + Alcotest.(check int) "incarnation" 5 (incarnation_to_int snap.incarnation) 156 156 + | None -> Alcotest.fail "member not found" 157 157 + 158 158 + let test_member_set_alive () = 159 159 + let table = Membership.create () in 160 160 + let member = Member.create ~now node1 in 161 161 + Membership.add table member; 162 162 + let _ = 163 163 + Membership.update_member table node1.id 164 164 + { 165 165 + update = 166 166 + (fun m ~xt -> 167 167 + Member.set_suspect m ~incarnation:(incarnation_of_int 1) ~now ~xt); 168 168 + } 169 169 + in 170 170 + let _ = 171 171 + Membership.update_member table node1.id 172 172 + { 173 173 + update = 174 174 + (fun m ~xt -> 175 175 + Member.set_alive m ~incarnation:(incarnation_of_int 2) ~now ~xt); 176 176 + } 177 177 + in 178 178 + match Membership.find table node1.id with 179 179 + | Some m -> 180 180 + let snap = Member.snapshot_now m in 181 181 + Alcotest.(check string) 182 182 + "state alive" "alive" 183 183 + (member_state_to_string snap.state) 184 184 + | None -> Alcotest.fail "member not found" 185 185 + 186 186 + let test_member_set_dead () = 187 187 + let table = Membership.create () in 188 188 + let member = Member.create ~now node1 in 189 189 + Membership.add table member; 190 190 + let _ = 191 191 + Membership.update_member table node1.id 192 192 + { 193 193 + update = 194 194 + (fun m ~xt -> 195 195 + Member.set_dead m ~incarnation:(incarnation_of_int 10) ~now ~xt); 196 196 + } 197 197 + in 198 198 + match Membership.find table node1.id with 199 199 + | Some m -> 200 200 + let snap = Member.snapshot_now m in 201 201 + Alcotest.(check string) 202 202 + "state dead" "dead" 203 203 + (member_state_to_string snap.state) 204 204 + | None -> Alcotest.fail "member not found" 205 205 + 206 206 + let () = 207 207 + Eio_main.run @@ fun _env -> 208 208 + Alcotest.run "kcas" 209 209 + [ 210 210 + ( "buffer_pool", 211 211 + [ 212 212 + ("acquire_release", `Quick, test_buffer_pool_acquire_release); 213 213 + ("with_buffer", `Quick, test_buffer_pool_with_buffer); 214 214 + ("exception_safe", `Quick, test_buffer_pool_exception_safe); 215 215 + ("all_buffers", `Quick, test_buffer_pool_all_buffers); 216 216 + ] ); 217 217 + ( "membership", 218 218 + [ 219 219 + ("add_find", `Quick, test_membership_add_find); 220 220 + ("remove", `Quick, test_membership_remove); 221 221 + ("to_list", `Quick, test_membership_to_list); 222 222 + ("snapshot_consistency", `Quick, test_membership_snapshot_consistency); 223 223 + ("count_accurate", `Quick, test_membership_count_accurate); 224 224 + ("no_duplicates", `Quick, test_membership_no_duplicates); 225 225 + ] ); 226 226 + ( "pending_acks", 227 227 + [ 228 228 + ("register_cancel", `Quick, test_pending_acks_register_cancel); 229 229 + ("complete_not_found", `Quick, test_pending_acks_complete_not_found); 230 230 + ] ); 231 231 + ( "member_transitions", 232 232 + [ 233 233 + ("state_transitions", `Quick, test_member_state_transitions); 234 234 + ("set_alive", `Quick, test_member_set_alive); 235 235 + ("set_dead", `Quick, test_member_set_dead); 236 236 + ] ); 237 237 + ]

+27

test/test_lzw.ml

··· 1 1 + open Alcotest 2 2 + 3 3 + let hex_to_string hex = 4 4 + let len = String.length hex / 2 in 5 5 + let buf = Bytes.create len in 6 6 + for i = 0 to len - 1 do 7 7 + let c = int_of_string ("0x" ^ String.sub hex (i * 2) 2) in 8 8 + Bytes.set buf i (Char.chr c) 9 9 + done; 10 10 + Bytes.to_string buf 11 11 + 12 12 + let test_decompress_go_data () = 13 13 + let compressed = 14 14 + hex_to_string 15 15 + "00919461c3e60d0b1057dec861432604082a68d2cc01211144181074cacca103e28d19104cb45c0131e64d1b387234ce49f3c68d8b80" 16 16 + in 17 17 + match Swim.Lzw.decompress_lsb8 compressed with 18 18 + | Ok result -> 19 19 + check string "decompressed matches" 20 20 + "Hello, World! This is a test of LZW compression." result 21 21 + | Error e -> 22 22 + fail 23 23 + (Printf.sprintf "decompression failed: %s" (Swim.Lzw.error_to_string e)) 24 24 + 25 25 + let () = 26 26 + run "lzw" 27 27 + [ ("decompress", [ test_case "go_data" `Quick test_decompress_go_data ]) ]